GIF en Mensaje de Espera

pgranados · #1 18-11-2022

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

aposi · #2 18-11-2022

Has mirado si Formaprincipal esta creado y te retorna la ruta de gif?

pgranados · #3 18-11-2022

Cita:

Empezado por aposi

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 · #4 18-11-2022

¿Qué componente usas para el gif?

pgranados · #5 18-11-2022

Cita:

Empezado por Casimiro Notevi

¿Qué componente usas para el gif?

TImage, saludos.

Casimiro Notevi · #6 18-11-2022

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] · #7 18-11-2022

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] · #8 19-11-2022

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] · #9 21-11-2022

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] · #10 21-11-2022

Cita:

Empezado por Neftali [Germán.Estévez]

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] · #11 21-11-2022

Cita:

Empezado por escafandra

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 · #12 21-11-2022

Gracias por la UNIT.

pgranados · #13 20-01-2023

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] · #14 21-01-2023

¿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] · #15 22-01-2023

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 · #16 23-01-2023

Cita:

Empezado por escafandra

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

Saludos.

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Mensaje de Espera mientras ejecuta algo	mantraxer21	Varios	3	12-05-2015 13:13:31
Mensaje/Ventana de espera mientras se ejecuta un proceso	Adrian Murua	PHP	1	07-03-2012 18:51:23
Ventana de Espera	totote	Varios	6	20-05-2008 15:30:47
Crear mensaje de espera	juanmdq	Varios	2	23-04-2008 15:01:14
Evento que no espera	Juditia	OOP	2	14-10-2004 17:43:23