Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   GIF en Mensaje de Espera (https://www.clubdelphi.com/foros/showthread.php?t=95976)

pgranados 18-11-2022 15:53:18
GIF en Mensaje de Espera
 
Buen día colegas, en mi proyecto, al dar clic en un botón tengo una forma que ''actúa'' como mensaje de espera, en esa forma tengo un .GIF tipo ''loading'' y un label con caption ''Un momento por favor, no cancele el proceso''.

El tema es que al dar clic en el botón, aparece el mensaje de espera, hace las operaciones correspondientes de mi proyecto sin problemas, pero al mostrar un mensaje de finalización 

Código Delphi [-]
showMessage ('La tarea fue terminada con éxito');

se empieza a reproducir el .gif por así decirlo, no antes de finalizar las tareas.

Código Delphi [-]
procedure TFormaMensaje.FormCreate(Sender: TObject);
begin
   if FileExists(FormaPrincipal.psRutaRaizServer+'clock.gif') then
      begin
          Image1.Picture.LoadFromFile(FormaPrincipal.psRutaRaizServer+'clock.gif');
          Image1.Center:= true;
         (Image1.Picture.Graphic as TGifImage).Animate:= true;
         (Image1.Picture.Graphic as TGifImage).AnimationSpeed:= 1000;
      end
end;

¿Alguien puede apoyarme con esta pequeña duda? Saludos :D

aposi 18-11-2022 18:29:20
Has mirado si Formaprincipal esta creado y te retorna la ruta de gif?

pgranados 18-11-2022 18:51:25
Cita:
Empezado por aposi (Mensaje 549320)
Has mirado si Formaprincipal esta creado y te retorna la ruta de gif?
Sí, de hecho si se muestra en la forma y todo, pero se visualiza como si fuera un JPG o PNG, sin movimiento, pero al terminar la función del clic y mostrar el mensaje de procedimiento terminado, empieza la animación del gif por así decirlo.

Casimiro Notevi 18-11-2022 18:58:56
¿Qué componente usas para el gif?

pgranados 18-11-2022 19:00:37
Cita:
Empezado por Casimiro Notevi (Mensaje 549322)
¿Qué componente usas para el gif?
TImage, saludos. :D

Casimiro Notevi 18-11-2022 21:05:05
Prueba:
Código Delphi [-]
(Image1.Picture.Graphic as TGifImage).AnimationSpeed:= 1000;
Application.ProcessMessages;
¿Y cuánto dura la tarea que se procesa? a ver si es que dura tan poco que no da tiempo a mostrar el gif.
Yo suelo usar TRxGIFAnimator de las RXlib.

escafandra 18-11-2022 21:46:54
Quizás tengas que usar un thread separado para mostrar tu gif animado. Si se está ejecutando una tarea el control del programa no pasa al gif hasta que termine. Es por eso que debes usar un hilo separado.

Saludos

escafandra 18-11-2022 23:40:49
Ya hace unos años que escribí una clase para visualizar un GIF en cualquier ventana, sin componentes y usando un thread. Usa GDI plus , puede cargar el gif desde un archivo o desde un recurso del ejecutable y la diseñé precisamente para independizar el movimiento del gif a las tareas de la aplicación. La publiqué aquí: New GifViewer, versión GDI+ polivalente


Posteriormente hice algún cambio el la versión para C++ para incorporarla a una aplicación precisamente mostrando un "gif de espera" mientras realizaba una tarea. Nunca publiqué los últimos cambios y acabo de adaptarlo a la versión delphi tras la lectura de este hilo. Supongo que puede servir como respuesta, así que publico la última versión de la clase.


Código Delphi [-]
unit _GifViewer;

//------------------------------------------------------------------------------
// GifViewer V 3.2
// escafandra 2018 - 2022
// Clase para representar un gif estático o animado sobre cualquier ventana.
// Usa GDI+
//
// V 3.0:
//   Se añade la carga de GIF desde Resources incrustados como RT_RCDATA
//   Se añade la posibilidad de centrar la imagen
//------------------------------------------------------------------------------


interface

uses Windows, Messages, ActiveX;

//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 GdipLoadImageFromStream(pStream: IStream; 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';

function SHCreateMemStream(pInit: PBYTE; cbInit: DWORD): Pointer; stdcall external 'shlwapi';

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
    Center:   boolean;
    Left:     integer;
    Top:      integer;
    function  GifView(Handle: HWND; FileName: PWCHAR; VCenter: boolean = false): boolean;
    function  GifViewFromResource(Handle: HWND; ID_GIF: PWCHAR; VCenter: boolean = false): boolean;
    function  SetHandle(Handle: THANDLE): boolean;
    function  LoadFile(FileName: PWCHAR): boolean;
    function  LoadFromResource(ID_GIF: 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;
  EvResult: DWORD;
  hGdipGraphics: THANDLE;
  nBytes, Frames, Index: UINT;
  FrameDimensionTime: TGUID;
  Left, Top: integer;
  CR: TRect;
begin
  Left:= GV.Left;
  Top:= GV.Top;

  // Esperamos a que se pinte una ventana WM_PAINT
  if hEvent <> 0 then EvResult:= WaitForSingleObject(hEvent, INFINITE);

  if (GV.hGdipImage <> 0) and (GV.Wnd <> 0) AND (EvResult = WAIT_OBJECT_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
      if GV.Center then
      begin
        GetClientRect(GV.Wnd, CR);
        Left:= (CR.right  - GV.Width) div 2;
        Top:= (CR.bottom - GV.Height) div 2;
      end;
      DC:= GetDC(GV.Wnd);
      GdipCreateFromHDC(DC, hGdipGraphics);
      GdipImageSelectActiveFrame(GV.hGdipImage, @FrameDimensionTime, Index);
      GdipDrawImageRectI(hGdipGraphics, GV.hGdipImage, Left, 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
  begin
    // Pemitimos que arranque el Thread si la ventana va a ser visible
    if ((Msg = WM_PAINT) or (Msg = WM_SHOWWINDOW)) and (hEvent <> 0) then
      SetEvent(hEvent);
    Result:= pGifViewer.WndProc(Handle, Msg, WParam, LParam)
  end
  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
  R.Left:= Left; R.Top:= Top; R.Right:= Left+Width; R.Bottom:= Top+Height;
  if (Msg = WM_PAINT) and (hGdipImage <> 0) then
    ValidateRect(Wnd, @R)
  else if (Msg = WM_SIZE) and (hGdipImage <> 0) and Center then
  begin
    InvalidateRect(Wnd, @R, true);
    CallWindowProc(OldWndProc, Wnd, WM_PAINT, 0, 0);
  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.LoadFromResource(ID_GIF: PWCHAR): boolean;
const
  RT_RCDATAW: PWCHAR = MakeIntResourceW(10);
var
  FrameDimensionTime: TGUID;
  Res: HRSRC;
  ResSize: DWORD;
  ResData: HGLOBAL;
  Stream: IStream;
begin
  Finish;
  Res:= FindResourceW(0, ID_GIF, RT_RCDATAW);
  if Res <> 0 then
  begin
    ResSize:= SizeofResource(0, Res);
    ResData:= LoadResource(0, Res);
    Stream:= IStream(SHCreateMemStream(PBYTE(LockResource(ResData)), ResSize));
    if GdipLoadImageFromStream(Stream, hGdipImage) = 0 then
    begin
         GdipGetImageWidth(hGdipImage, UINT(Width));
      GdipGetImageHeight(hGdipImage, UINT(Height));
        GdipImageGetFrameCount(hGdipImage, @FrameDimensionTime, UINT(Frames));
    end
    else hGdipImage:= 0;
    Stream._Release;
  end;
  Result:= hGdipImage <> 0;
end;

function TGifViewer.GifView(Handle: HWND; FileName: PWCHAR; VCenter: boolean): boolean;
begin
  Finish;
  LoadFile(FileName);
  SetHandle(Handle);
  Center:= VCenter;
  Result:= Start;
end;

function TGifViewer.GifViewFromResource(Handle: HWND; ID_GIF: PWCHAR; VCenter: boolean): boolean;
begin
  Finish;
  LoadFromResource(ID_GIF);
  SetHandle(Handle);
  Center:= VCenter;
  Result:= Start;
end;

procedure TGifViewer.Finish;
begin
  SetEvent(hEvent); // Si el thread estaba esperando, se le abre el semáforo
  if hGdipImage <> 0 then
  begin
    GdipDisposeImage(hGdipImage);
    hGdipImage:= 0;
    WaitForSingleObject(hThread, INFINITE); // El thread podrá terminar
    CloseHandle(hThread);
    hThread:= 0;
  end;
  Left:= 0;
  Top:= 0;
  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
  FillChar(GdiPlusStartupInput, sizeof(GdiPlusStartupInput), 0);
  GdiPlusStartupInput[0]:= 1;
  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;
  CloseHandle(hEvent);
  SetHandle(0);
  if GDI = 0 then GdiplusShutdown(gdiplusToken);
  inherited Destroy;
end;

end.


Forma de uso desde un archivo:
Código Delphi [-]
var
  GV: TGifViewer;
begin
  GV:= TGifViewer.Create;
  GV.GifView(Panel1.Handle, PWCHAR(WideString(OpenDialog1.FileName)));
end;


Desde un recurso:
Código Delphi [-]
  GV.GifViewFromResource(Panel1.Handle, 'ID_WAIT', true);


Saludos.

Neftali [Germán.Estévez] 21-11-2022 11:11:44
Yo creo que es problema de que el proceso que ejecutas "no deja tiempo", por decirlo así, a que se ejecute la animación del GIF, porque justo después de crerlo debes lanzar la tarea. Como están ambos procesos en el Thread principal de la aplicación tiene más prioridad el proceso. De ahí que al acabar el proceso empiece la animación.

Las 2 soluciones típicas son:
  • Añadir uno o varios ProcessMessages al proceso que estás ejecutando. Por ejemplo, si es un bucle, en el interior hacer la llamada.
  • Lanzar el proceso en un thread secundario diferente al principal (más complejo).

escafandra 21-11-2022 14:37:32
Cita:
Empezado por Neftali [Germán.Estévez] (Mensaje 549340)
Yo creo que es problema de que el proceso que ejecutas "no deja tiempo", por decirlo así, a que se ejecute la animación del GIF, porque justo después de crerlo debes lanzar la tarea. Como están ambos procesos en el Thread principal de la aplicación tiene más prioridad el proceso. De ahí que al acabar el proceso empiece la animación.

Las 2 soluciones típicas son:
  • Añadir uno o varios ProcessMessages al proceso que estás ejecutando. Por ejemplo, si es un bucle, en el interior hacer la llamada.
  • Lanzar el proceso en un thread secundario diferente al principal (más complejo).
Justo el lo que comenté en la respuesta 7 y la solución con código que di en la respuesta 8 donde expongo un visor completo de imagenes gif en un htread propio.

Estoy de acuerdo en que la solución mejor es un thread para el GIF. Es la forma de que el movimiento sea contínuo, carezca de saltos y pueda comenzar / terminar cuando deseemos.


Saludos.

Neftali [Germán.Estévez] 21-11-2022 15:36:14
Cita:
Empezado por escafandra (Mensaje 549347)
Justo el lo que comenté en la respuesta 7 y la solución con código que di en la respuesta 8 donde expongo un visor completo de imagenes gif en un htread propio.

Estoy de acuerdo en que la solución mejor es un thread para el GIF. Es la forma de que el movimiento sea contínuo, carezca de saltos y pueda comenzar / terminar cuando deseemos.
^\||/^\||/^\||/
He ido "a piñón" y no lo había visto.

MAXIUM 21-11-2022 21:35:32
Gracias por la UNIT.

pgranados 20-01-2023 18:13:07
Hola escafandra, con tu Unit pude lograr mi objetivo, pero tengo un problema a veces y no logo identificar a que se deba, pero a veces al cerrar mi aplicación salta un error en la función 
Código Delphi [-]
function ThGif(GV: TGifViewer): DWORD; stdcall;
específicamente en 

Código Delphi [-]
if Pi._type = sizeof(DWORD) then
    repeat
      if GV.Center then
      begin
        GetClientRect(GV.Wnd, CR);
        Left:= (CR.right  - GV.Width) div 2;
        Top:= (CR.bottom - GV.Height) div 2;
      end;
      DC:= GetDC(GV.Wnd);
      GdipCreateFromHDC(DC, hGdipGraphics);
      GdipImageSelectActiveFrame(GV.hGdipImage, @FrameDimensionTime, Index);
      GdipDrawImageRectI(hGdipGraphics, GV.hGdipImage, Left, 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);

el stop se queda en 
Código Delphi [-]
 until (GV.Wnd = 0) or (GV.hGdipImage = 0);

¿Sabrás que pueda ser? por lo que observe, 
Código Delphi [-]
GV.Wnd
& 
Código Delphi [-]
GV.hGdipImage

tienen valores inaccesibles, saludos.

pd: estoy usando Delphi 10.4.2

escafandra 21-01-2023 02:25:20
¿Cuantos objetos TGifViewer creas? ¿Los destruyes?


Prueba con este cambio en el destructor:
Código Delphi [-]
destructor TGifViewer.Destroy;
begin
  dec(GDI);
  Finish;
  SetHandle(0);
  if GDI = 0 then
  begin
    CloseHandle(hEvent);
    GdiplusShutdown(gdiplusToken);
  end;
  inherited Destroy;
end;


Saludos.

escafandra 22-01-2023 02:08:59
Mejor prueba esta revisión. Es prácticamente idéntica a la anteror pero incopora hEvent como miembro de la clase.



Código Delphi [-]
unit _GifViewer;

//------------------------------------------------------------------------------
// GifViewer V 3.21
// escafandra 2018 - 2023
// Clase para representar un gif estático o animado sobre cualquier ventana.
// Usa GDI+
//
// V 3.0:
//   Se añade la carga de GIF desde Resources incrustados como RT_RCDATA
//   Se añade la posibilidad de centrar la imagen
//------------------------------------------------------------------------------


interface

uses Windows, Messages, ActiveX;

function GdiplusStartup(var GdiToken: DWORD; Startup, Output: PBYTE): DWORD; stdcall external 'gdiplus';
function GdipLoadImageFromFile(lpFileName: PWideChar; var hImage: THANDLE): DWORD; stdcall external 'gdiplus';
function GdipLoadImageFromStream(pStream: IStream; 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';

function SHCreateMemStream(pInit: PBYTE; cbInit: DWORD): Pointer; stdcall external 'shlwapi';

type
TGifViewer = class
  private
    Wnd: HWND;
    OldWndProc:   Pointer;
    OldUserData:  DWORD;
    gdiplusToken: DWORD;
    hThread:      THANDLE;
    hEvent:       THandle;
    hGdipImage:   THANDLE;
    Width:        integer;
    Height:       integer;
    Frames:       UINT;

    function WndProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;

  public
    Center:   boolean;
    Left:     integer;
    Top:      integer;
    function  GifView(Handle: HWND; FileName: PWCHAR; VCenter: boolean = false): boolean;
    function  GifViewFromResource(Handle: HWND; ID_GIF: PWCHAR; VCenter: boolean = false): boolean;
    function  SetHandle(Handle: THANDLE): boolean;
    function  LoadFile(FileName: PWCHAR): boolean;
    function  LoadFromResource(ID_GIF: 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;

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;
  EvResult: DWORD;
  hGdipGraphics: THANDLE;
  nBytes, Frames, Index: UINT;
  FrameDimensionTime: TGUID;
  Left, Top: integer;
  CR: TRect;
begin
  Left:= GV.Left;
  Top:= GV.Top;

  // Esperamos a que se pinte una ventana WM_PAINT
  if GV.hEvent <> 0 then EvResult:= WaitForSingleObject(GV.hEvent, INFINITE);

  if (GV.hGdipImage <> 0) and (GV.Wnd <> 0) AND (EvResult = WAIT_OBJECT_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
      if GV.Center then
      begin
        GetClientRect(GV.Wnd, CR);
        Left:= (CR.right  - GV.Width) div 2;
        Top:= (CR.bottom - GV.Height) div 2;
      end;
      DC:= GetDC(GV.Wnd);
      GdipCreateFromHDC(DC, hGdipGraphics);
      GdipImageSelectActiveFrame(GV.hGdipImage, @FrameDimensionTime, Index);
      GdipDrawImageRectI(hGdipGraphics, GV.hGdipImage, Left, 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
  pGifViewer:= TGifViewer(GetWindowLong(Handle, GWL_USERDATA));
  if pGifViewer <> nil then
  begin
    // Pemitimos que arranque el Thread si la ventana va a ser visible
    if ((Msg = WM_PAINT) or (Msg = WM_SHOWWINDOW)) and (pGifViewer.hEvent <> 0) then
      SetEvent(pGifViewer.hEvent);
    Result:= pGifViewer.WndProc(Handle, Msg, WParam, LParam)
  end
  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
  R.Left:= Left; R.Top:= Top; R.Right:= Left+Width; R.Bottom:= Top+Height;
  if (Msg = WM_PAINT) and (hGdipImage <> 0) then
    ValidateRect(Wnd, @R)
  else if (Msg = WM_SIZE) and (hGdipImage <> 0) and Center then
  begin
    InvalidateRect(Wnd, @R, true);
    CallWindowProc(OldWndProc, Wnd, WM_PAINT, 0, 0);
  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.LoadFromResource(ID_GIF: PWCHAR): boolean;
const
  RT_RCDATAW: PWCHAR = MakeIntResourceW(10);
var
  FrameDimensionTime: TGUID;
  Res: HRSRC;
  ResSize: DWORD;
  ResData: HGLOBAL;
  Stream: IStream;
begin
  Finish;
  Res:= FindResourceW(0, ID_GIF, RT_RCDATAW);
  if Res <> 0 then
  begin
    ResSize:= SizeofResource(0, Res);
    ResData:= LoadResource(0, Res);
    Stream:= IStream(SHCreateMemStream(PBYTE(LockResource(ResData)), ResSize));
    if GdipLoadImageFromStream(Stream, hGdipImage) = 0 then
    begin
      GdipGetImageWidth(hGdipImage, UINT(Width));
      GdipGetImageHeight(hGdipImage, UINT(Height));
      GdipImageGetFrameCount(hGdipImage, @FrameDimensionTime, UINT(Frames));
    end
    else hGdipImage:= 0;
    Stream._Release;
  end;
  Result:= hGdipImage <> 0;
end;

function TGifViewer.GifView(Handle: HWND; FileName: PWCHAR; VCenter: boolean): boolean;
begin
  Finish;
  LoadFile(FileName);
  SetHandle(Handle);
  Center:= VCenter;
  Result:= Start;
end;

function TGifViewer.GifViewFromResource(Handle: HWND; ID_GIF: PWCHAR; VCenter: boolean): boolean;
begin
  Finish;
  LoadFromResource(ID_GIF);
  SetHandle(Handle);
  Center:= VCenter;
  Result:= Start;
end;

procedure TGifViewer.Finish;
begin
  SetEvent(hEvent); // Si el thread estaba esperando, se le abre el semáforo
  if hGdipImage <> 0 then
  begin
    GdipDisposeImage(hGdipImage);
    hGdipImage:= 0;
    WaitForSingleObject(hThread, INFINITE); // El thread podrá terminar
    CloseHandle(hThread);
    hThread:= 0;
  end;
  Left:= 0;
  Top:= 0;
  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
  FillChar(GdiPlusStartupInput, sizeof(GdiPlusStartupInput), 0);
  GdiPlusStartupInput[0]:= 1;
  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;
  CloseHandle(hEvent);
  SetHandle(0);
  if GDI = 0 then GdiplusShutdown(gdiplusToken);
  inherited Destroy;
end;

end.


Saludos.

pgranados 23-01-2023 15:58:57
Cita:
Empezado por escafandra (Mensaje 550125)
Mejor prueba esta revisión. Es prácticamente idéntica a la anteror pero incopora hEvent como miembro de la clase.
Saludos.

Buen día, la pruebo el día de hoy y comparto los resultados :rolleyes:

Saludos.


La franja horaria es GMT +2. Ahora son las 14:50:55.

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