Hace algún tiempo publiqué una clase TGif que mostraba como es el estándar de ese formato y permitía extraer las imágenes, crear archivos gif desde varias imágenes, o crear un visor como el que publiqué aquí. La clase TGif estaba orientada a la VCL usando alguno de sus componentes, el visor TGifViewer pecaba de lo mismo.
Hoy os quiero presentar otro visor gif completamente distinto basado en el uso de GDI+ con lo que la dependencia de Windows es total pero ahorra mucho código. Este visor es totalmente independiente de la VCL y usará cualquier ventana, incluidas las de la VCL, para visualizar en ella nuestro gif. Para ello intercepta la función de tratamiento de mensajes evitando que se procese el mensaje WM_PAINT y controlando un evento que servirá para sincronizar un Thread. Este Thread será el encargado de realizar la visualización del gif.
El visor está implementado como una clase y no como un componente pero es muy intuitivo y fácil de usar, además de su constructor y destructor, tiene los siguientes métodos:
GifView(Handle: HWND; FileName: PWCHAR) Establece el fichero y la ventana donde se representará y comienza la visualización.
Finish: Termina la visualización pero no libera la ventana.
Start: Comienza la visualización si ya tenemos fichero y ventana
SetHandle(Handle: THANDLE): Asocia el visor a una ventana.
LoadFile(FileName: PWCHAR): Abre un fichero gif y obtiene sus características
GetWidth: Nos informa del ancho
GetHeight: Nos informa del alto
GetFrames: Nos informa del número de imágenes del gif
La característica fundamental de este visor es que cualquier ventana puede servir como “pantalla” y también funcionará en aplicaciones que no sean VCL, es decir, aplicaciones Windows API puras.
El código de la clase es el siguiente:
unit _GifViewer; //------------------------------------------------------------------------------ // GifViewer V 2.0 // escafandra 2018 // Clase para representar un gif estático o animado sobre cualquier ventana. // Usa GDI+ interface uses Windows, Messages; //function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: Pointer): Pointer; stdcall external 'user32'; function GdiplusStartup(var GdiToken: DWORD; Startup, Output: PBYTE): DWORD; stdcall external 'gdiplus'; function GdipLoadImageFromFile(lpFileName: PWideChar; var hImage: THANDLE): DWORD; stdcall external 'gdiplus'; function GdipDrawImageRectI(hGraphics, hImage: THANDLE; Left, Top, Width, Height: Integer): DWORD; stdcall external 'gdiplus'; function GdipCreateFromHDC(DC: HDC; var hGraphics: THANDLE): DWORD; stdcall external 'gdiplus'; function GdipImageSelectActiveFrame(hImage: THANDLE; DimensionID: PGUID; frameIndex: Integer): DWORD; stdcall external 'gdiplus'; function GdipImageGetFrameDimensionsList(hImage: THANDLE; dimensionIDs: PGUID; Count: Integer): DWORD; stdcall external 'gdiplus'; function GdipGetPropertyItemSize(hImage: THANDLE; dwPropId: Integer; var Size: UINT): Integer; stdcall external 'gdiplus'; function GdipGetPropertyItem(hImage: THANDLE; dwPropID, Size: Integer; lpBuffer: Pointer): DWORD; stdcall external 'gdiplus'; function GdipImageGetFrameCount(hImage: THANDLE; lpDimensionID: PGUID; out Count: UINT): DWORD; stdcall external 'gdiplus'; function GdipGetImageWidth(hImage: THANDLE; var Width: UINT): DWORD; stdcall external 'gdiplus'; function GdipGetImageHeight(hImage: THANDLE; var Height: UINT): DWORD; stdcall external 'gdiplus'; function GdipDeleteGraphics(hGraphics: THANDLE): DWORD; stdcall external 'gdiplus'; function GdipDisposeImage(hImage: THANDLE): DWORD; stdcall external 'gdiplus'; procedure GdiplusShutdown(GdiToken: DWORD); stdcall external 'gdiplus'; type TGifViewer = class private Wnd: HWND; OldWndProc: Pointer; OldUserData: DWORD; gdiplusToken: DWORD; hThread: THANDLE; hGdipImage: THANDLE; Width: integer; Height: integer; Frames: UINT; function WndProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall; public Left: integer; Top: integer; function GifView(Handle: HWND; FileName: PWCHAR): boolean; function SetHandle(Handle: THANDLE): boolean; function LoadFile(FileName: PWCHAR): boolean; function GetWidth: integer; function GetHeight: integer; function GetFrames: UINT; function Start: boolean; procedure Finish; constructor Create; destructor Destroy; override; end; PGifViewer = ^TGifViewer; TPropertyItem = record id: ULONG; length: ULONG; _type: WORD; value: Pointer; end; PPropertyItem = ^TPropertyItem; const PropertyTagFrameDelay = $5100; var GDI: DWORD = 0; hEvent: THandle = 0; implementation function RePaintWindow(Wnd: HWND): boolean; var Rect: TRect; begin GetClientRect(Wnd, Rect); Result:= RedrawWindow(Wnd, @Rect, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW or RDW_ALLCHILDREN); end; function ThGif(GV: TGifViewer): DWORD; stdcall; var Wait: PIntegerArray; Pi: PPropertyItem; DC: HDC; hGdipGraphics: THANDLE; nBytes, Frames, Index: UINT; FrameDimensionTime: TGUID; begin // Esperamos a que se pinte una ventana WM_PAINT if hEvent <> 0 then WaitForSingleObject(hEvent, INFINITE); if (GV.hGdipImage <> 0) and (GV.Wnd <> 0) then begin GdipGetPropertyItemSize(GV.hGdipImage, PropertyTagFrameDelay, nBytes); Pi:= Pointer(LocalAlloc(LMEM_FIXED, nBytes)); GdipGetPropertyItem(GV.hGdipImage, PropertyTagFrameDelay, nBytes, Pi); GdipImageGetFrameDimensionsList(GV.hGdipImage, @FrameDimensionTime, 1); GdipImageGetFrameCount(GV.hGdipImage, @FrameDimensionTime, Frames); Index:= 0; Wait:= PIntegerArray(Pi.value); if Pi._type = sizeof(DWORD) then repeat DC:= GetDC(GV.Wnd); GdipCreateFromHDC(DC, hGdipGraphics); GdipImageSelectActiveFrame(GV.hGdipImage, @FrameDimensionTime, Index); GdipDrawImageRectI(hGdipGraphics, GV.hGdipImage, GV.Left, GV.Top, GV.Width, GV.Height); GdipDeleteGraphics(hGdipGraphics); ReleaseDC(GV.Wnd, DC); Sleep(Wait[Index] * 10); Index:= (Index + 1) mod Frames; until (GV.Wnd = 0) or (GV.hGdipImage = 0); end; LocalFree(HLOCAL(Pi)); Result:= 0; end; function DefWndProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall; var pGifViewer: TGifViewer; begin if (Msg = WM_PAINT) and (hEvent <> 0) then SetEvent(hEvent); // Pemitimos que arranque el Thread pGifViewer:= TGifViewer(GetWindowLong(Handle, GWL_USERDATA)); if pGifViewer <> nil then Result:= pGifViewer.WndProc(Handle, Msg, WParam, LParam) else Result:= DefWindowProc(Handle, Msg, WParam, LParam); end; function TGifViewer.WndProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall; var R: TRect; begin if (Msg = WM_PAINT) and (hGdipImage <> 0) then begin R.Left:= Left; R.Top:= Top; R.Right:= Left+Width; R.Bottom:= Top+Height; ValidateRect(Wnd, @R); //Result:= DefWindowProc(Handle, Msg, WParam, LParam); //Exit; end; Result:= CallWindowProc(OldWndProc, Handle, Msg, WParam, LParam); end; function TGifViewer.SetHandle(Handle: THANDLE): boolean; begin Result:= false; if(Pointer(GetWindowLong(Handle, GWL_WNDPROC)) <> @DefWndProc) then begin SuspendThread(hThread); if (Wnd <> 0) then begin SetWindowLong(Wnd, GWL_USERDATA, OldUserData); SetWindowLong(Wnd, GWL_WNDPROC, LongInt(OldWndProc)); RePaintWindow(Wnd); Wnd:= 0; end; if (Handle <> 0) and IsWindow(Handle) then begin Wnd:= Handle; OldUserData:= SetWindowLong(Wnd, GWL_USERDATA, LongInt(self)); OldWndProc:= Pointer(SetWindowLong(Wnd, GWL_WNDPROC, LongInt(@DefWndProc))); RePaintWindow(Wnd); end; Result:= true; ResumeThread(hThread); end; end; function TGifViewer.LoadFile(FileName: PWCHAR): boolean; var FrameDimensionTime: TGUID; begin Finish; if GdipLoadImageFromFile(FileName, hGdipImage) = 0 then begin GdipGetImageWidth(hGdipImage, UINT(Width)); GdipGetImageHeight(hGdipImage, UINT(Height)); GdipImageGetFrameDimensionsList(hGdipImage, @FrameDimensionTime, 1); GdipImageGetFrameCount(hGdipImage, @FrameDimensionTime, UINT(Frames)); end else hGdipImage:= 0; Result:= hGdipImage <> 0; end; function TGifViewer.GifView(Handle: HWND; FileName: PWCHAR): boolean; begin Finish; LoadFile(FileName); SetHandle(Handle); Result:= Start; end; procedure TGifViewer.Finish; begin if hGdipImage <> 0 then begin GdipDisposeImage(hGdipImage); hGdipImage:= 0; WaitForSingleObject(hThread, INFINITE); CloseHandle(hThread); hThread:= 0; end; RePaintWindow(Wnd); end; function TGifViewer.Start(): boolean; begin if (Wnd <> 0) and (hGdipImage <> 0) and (hThread = 0) then hThread:= CreateThread(nil, 0, @ThGif, self, 0, PDWORD(0)^); Result:= hThread <> 0; end; function TGifViewer.GetWidth: integer; begin Result:= Width; end; function TGifViewer.GetHeight: integer; begin Result:= Height; end; function TGifViewer.GetFrames: UINT; begin Result:= Frames; end; constructor TGifViewer.Create; var GdiPlusStartupInput: array[0..2] of int64; begin GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0; if GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil) = 0 then inc(GDI); if hEvent = 0 then hEvent:= CreateEvent(nil, true, false, nil); end; destructor TGifViewer.Destroy; begin dec(GDI); Finish; SetHandle(0); if GDI = 0 then GdiplusShutdown(gdiplusToken); inherited Destroy; end; end.
Un ejemplo con VCL:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, _GifViewer, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; Button1: TButton; OpenDialog1: TOpenDialog; Panel2: TPanel; Button2: TButton; Button3: TButton; Button4: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private GV1: TGifViewer; GV2: TGifViewer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin GV1:= TGifViewer.Create; GV2:= TGifViewer.Create; //GV1.GifView(Panel1.Handle, 'Muerte.gif'); if not GV1.GifView(Panel1.Handle, 'Muerte.gif') then GV1.SetHandle(0); end; procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then GV1.GifView(Panel1.Handle, PWCHAR(WideString(OpenDialog1.FileName))); end; procedure TForm1.Button2Click(Sender: TObject); begin if OpenDialog1.Execute then begin if GV2 = nil then GV2:= TGifViewer.Create; GV2.GifView(Panel2.Handle, PWCHAR(WideString(OpenDialog1.FileName))); end; end; procedure TForm1.Button3Click(Sender: TObject); begin GV2.Free; GV2:= nil; end; procedure TForm1.Button4Click(Sender: TObject); begin if Assigned(GV2) then begin GV1.SetHandle(0); // GV2.SetHandle(0); GV2.SetHandle(Panel1.Handle); end; end; end.
Un ejemplo usando sólo API:
program GifTopMost; uses Windows, Messages, _GifViewer; var lpFileName: PWCHAR; GV: TGifViewer; WinClass: WNDCLASS; Rect: TRect; hFrame: HWND; Msg: TMsg; begin if ParamStr(1) = '' then lpFileName := 'muerte.gif' else lpFileName:= PWideChar(WideString(ParamStr(1))); // Abrimos un archivo Gif para saber sus dimnesiones y crear una ventana GV:= TGifViewer.Create; GV.LoadFile(lpFileName); // Creamos una ventana... GetClientRect(GetDesktopWindow, Rect); ZeroMemory(@WinClass, sizeof(WinClass)); WinClass.lpfnWndProc:= @DefWindowProc; WinClass.lpszClassName:= 'GIFFRAME'; WinClass.hCursor:= LoadCursor(0, IDC_ARROW); RegisterClass(WinClass); hFrame:= CreateWindowEx(WS_EX_LAYERED or WS_EX_TOPMOST or WS_EX_TOOLWINDOW, 'GIFFRAME', '', WS_VISIBLE or WS_POPUP, (Rect.right - integer(GV.GetWidth)) div 2, (Rect.bottom - integer(GV.GetHeight)) div 2, GV.GetWidth, GV.GetHeight, HWND_DESKTOP, HMENU(0), 0, nil); SetLayeredWindowAttributes(hFrame, 0, 220, LWA_ALPHA); GV.SetHandle(hFrame); // Asociamos el Handle de nuestra ventana donde pintará el Gif if GV.Start then // Si el Gif arranca iniciamos el bucle de mensajes de la app repeat GetMessage(Msg, 0, 0, 0); TranslateMessage(Msg); DispatchMessage(Msg); until not IsWindow(hFrame); // Alt+F4 Cerrará la ventana y termina la app GV.Free; end.
Está probado en delphi 6, 7, y Berlin.
Por las limitaciones de D6 y 7 he usado la API SetWindowLong para realizar el subclassing. En el caso de querer compilar para 64bits debería usarse SetWindowLongPtr. más abajo publico una versión de la clase adaptada a Lazarus que está preparada para compilar a 32 y 64 bits y puede servir de guía. Aprovechando la adaptación a Lazarus, he incluido alguna pequeña mejora a la clase que publico en las entradas correspondientes a delphi y C++
Saludos.