Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 29-07-2008
Avatar de MaMu
MaMu MaMu is offline
Miembro
 
Registrado: abr 2006
Ubicación: Argentina
Posts: 863
Poder: 20
MaMu Va por buen camino
Problema con procedimiento y paso de parametros

En la sección Trucos, me topé con este interesante truco para obtener cualquier thumbnail de la Shell, funciona perfecto, pero no logro adaptar un string a PWideChar, como para pasarle los parametros por variables, siempre me tira error, alguna idea?

Código Delphi [-]
 
uses ActiveX, ShlObj, ComObj;
type
 IExtractImage = interface ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}'] // http://msdn2.microsoft.com/en-us/lib...48(VS.85).aspx
  function GetLocation(pszPathBuffer: LPWSTR; cchMax: DWORD; 
 var pdwPriority: DWORD; const prgSize: SIZE; dwRecClrDepth: DWORD; 
 var pdwFlags: DWORD): HRESULT; stdcall;
  function Extract(var phBmpImage: HBITMAP): HRESULT; stdcall;
 end;
function GetThumbnail(lpPathName, lpFileName: PWideChar; Width, Height: Integer): TBitmap;
var
 Desktop, Folder: IShellFolder;
 ItemIDList: PItemIDList;
 Flags, Priority: Cardinal;
 ExtractImage: IExtractImage;
 Res: HRESULT;
 hBitmap: Windows.HBITMAP;
 Buffer: array[0..MAX_PATH-1] of WideChar;
 Size: TSize;
begin
 Result := nil;
 SHGetDesktopFolder(Desktop);
 if LongBool(Desktop.ParseDisplayName(0, nil, lpPathName, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then Exit;
 Desktop.BindToObject(ItemIDList, nil, IShellFolder, Folder);
 CoTaskMemFree(ItemIDList);
 if LongBool(Folder.ParseDisplayName(0, nil, lpFileName, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then Exit;
 Folder.GetUIObjectOf(0, 1, ItemIDList, IExtractImage, nil, ExtractImage);
 CoTaskMemFree(ItemIDList);
 if not Assigned(ExtractImage) then Exit; // TODO
 Size.cx := Width; Size.cy := Height; Priority := 0;
 Flags := $28{IEIFLAG_SCREEN+IEIFLAG_OFFLINE};
 Res := ExtractImage.GetLocation(Buffer, SizeOf(Buffer), Priority, Size, 24{pf32bit}, Flags);
 if (Res = NOERROR) or (Res = E_PENDING{IEIFLAG_ASYNC}) then
  begin
   if not LongBool(ExtractImage.Extract(hBitmap)) then
    begin
     Result := TBitmap.Create;
     Result.Handle := hBitmap;
    end;
  end;
end;
__________________
Código Delphi [-]
 
try 
ProgramarMicro(80C52,'Intel',MnHex,True);
except
On Exception do
MicroChip.IsPresent(True);
end;

Última edición por dec fecha: 29-07-2008 a las 15:50:07.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Paso de parametros Delphos Varios 4 18-01-2005 15:32:07
paso de parametros empty API de Windows 1 11-05-2004 11:42:13
Paso de parametros senpiterno Varios 1 11-04-2004 03:44:17
Paso de parametros __cadetill PHP 2 12-08-2003 10:15:09
Paso de Parámetros vinny Varios 1 29-05-2003 12:54:07


La franja horaria es GMT +2. Ahora son las 10:08:47.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi