GIF animados para FWH sin usar DLLs externas!

[Antonio Linares]

Aida,

Quita la claúsula TRANSPARENT y ya funciona. Vamos a ver que pueda estar pasando

> en lugar de ajustar el gif al tamaño del cuadro del recurso TGif el gif se desborda

Si, aún faltan unos retoques

Muchas gracias por tu muy valioso feedback

[Antonio Linares]

solucionado el error al usar TRANSPARENT. Este ejemplo ya funciona bien

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

   local oDlg, oGif, oBrush
   
   DEFINE BRUSH oBrush FILE "..\bitmaps\backgrnd\beach.bmp"

   DEFINE DIALOG oDlg RESOURCE "test" TITLE "A modal dialog" BRUSH oBrush TRANSPARENT
   
   REDEFINE GIF oGif OF oDlg RESOURCE "..\gifs\halo.gif"

   ACTIVATE DIALOG oDlg CENTERED
   
return nil  

Aqui la clase TGif modificada:

Code: Select all  Expand view  RUN

#include "fivewin.ch"
#include "gif.ch"


CLASS TGif FROM TControl

   DATA  hGif
   DATA  cFilename
   DATA  lAdjust
   DATA  nSizingType
   
   CLASSDATA lRegistered
   
   METHOD New( oWnd, cGifFile, nRow, nCol,;
            nHeight, nWidth, oCursor, lAdjust, bAction )

   METHOD Redefine( nId, oWnd, cGifFile, lAdjust )        
   
   METHOD GetData() INLINE If( ! Empty( ::hGif ), GetGifInfo( ::hGif ),)
   
   METHOD Play() INLINE FWGifPlay( ::hGif )
   METHOD Stop() INLINE FWGifStop( ::hGif )
   
   METHOD Restart() INLINE FWGifRestart( ::hGif )
   
   METHOD IsRunning() INLINE FWGifIsRunning( ::hGif )
   
   METHOD Destroy() INLINE FWGifEnd()
   
   METHOD SetFile( cFile ) INLINE ::cFileName := cFile, SetWindowText( ::hGif, cFile )
   
   METHOD SetSizing( nType ) INLINE FWSetGIFSizing( ::hGif, nType )
   
   METHOD Refresh()  
   
   METHOD ReSize( nSizeType, nWidth, nHeight ) INLINE ::SetSize( nWidth, nHeight, .T. ),;
                                                      WndSetSize( ::hGif, nWidth, nHeight, .T. )
   METHOD Initiate( hDlg ) INLINE  ::Super:Initiate( hDlg ), ::Default()

   METHOD Default()

ENDCLASS

//----------------------------------------------------------------//

METHOD New( oWnd, cGifFile, nRow, nCol,;
            nHeight, nWidth, oCursor, lAdjust, bAction ) CLASS TGif

    local aData, nNewWidth, nNewHeight, nSizingType
    local hRes
    local cDir, cTempfile

    DEFAULT oWnd    := GetWndDefault(),;
            nRow    := 0,;
            nCol    := 0,;
            lAdjust := .F.
   
   ::nTop    = nRow
   ::nLeft   = nCol
   ::nStyle  = nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )

   ::bLClicked = bAction
   
   ::nSizingType = FWGIF_SIZING_FILE
   
   if nHeight == nil .or. nWidth == nil
      ::nBottom = 100
      ::nRight  = 100
   else
      ::nBottom = nHeight + nRow
      ::nRight = nWidth + nCol
      ::nSizingType = FWGIF_SIZING_CLIP
   endif
       
   ::oWnd    = oWnd
   ::oCursor = oCursor

   ::cFileName = cGifFile
   ::oBrush    = oWnd:oBrush
   ::lAdjust   = lAdjust

   ::Register( )

   if ! Empty( oWnd:hWnd )
      ::Create()
      ::lVisible = .t.
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
      ::lVisible  = .f.
   endif

   ::Default()

return self

//----------------------------------------------------------//

METHOD Redefine( nId, oWnd, cGifFile, lAdjust )        

   DEFAULT lAdjust := .T.

   ::cFileName = cGifFile
   ::lAdjust   = lAdjust

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if oWnd != nil
      ::oWnd = oWnd
      oWnd:DefControl( Self )
   endif

return Self

//----------------------------------------------------------//

METHOD Default() CLASS TGif

   local hRes, cDir, cTempFile
   local cGifFile := ::cFileName
   local aData, nNewWidth := 100, nNewHeight := 100, nSizingType

   if ! Empty( cGifFile ) .and. ! File( cGifFile )
      hRes  = FindResource( GetResources(), cGifFile, 10 )
      If Empty( hres )
         return nil
      else
         cDir   = GetEnv( "TEMP" )
         if Empty( cDir )
            cDir = GetEnv( "TMP" )
         endif
         cTempfile = cDir + cTempFile( "\", "gif" )
         RCDataToFile( 0, cGifFile, cTempfile )
      endif
   endif  

   If ! Empty( cTempfile )
      ::hGif = FWGifWindow( cTempFile, 0, 0, ::nWidth, ::nHeight, ::hWnd )
   else
      ::hGif = FWGifWindow( cGifFile, 0, 0, ::nWidth, ::nHeight, ::hWnd )
   endif  

   aData = ::GetData()
   
   if ! ::lAdjust
      if ! Empty( aData )
         nNewWidth  = aData[ FWGIF_WIDTH ]
         nNewHeight = aData[ FWGIF_HEIGHT ]
      endif        
   else
      nNewWidth  = ::nWidth
      nNewHeight = ::nHeight
   endif

   ::ReSize( , nNewWidth, nNewHeight )

   if ::lAdjust
      ::nSizingType = FWGIF_SIZING_STRETCH
   endif      
   ::SetSizing( ::nSizingType )

   If ! Empty( cTempfile )
      FErase( cTempfile )
   endif

return nil

//----------------------------------------------------------//

METHOD Refresh() CLASS TGif

   local nSizingType := ::nSizingType
   local aData := ::GetData()
   local nNewWidth, nNewHeight
   
   if ! Empty( aData )
      nNewWidth  = aData[ FWGIF_WIDTH ]
      nNewHeight = aData[ FWGIF_HEIGHT ]
   endif

   if ::lAdjust  
      if nSizingType != FWGIF_SIZING_STRETCH
         nSizingType = FWGIF_SIZING_STRETCH
      endif
   else
      if nSizingType = FWGIF_SIZING_CLIP
         nNewWidth   = ::nWidth
         nNewHeight  = ::nHeight
      else
         nSizingType = FWGIF_SIZING_FILE
         if ! Empty( aData )
            nNewWidth   = aData[ FWGIF_WIDTH ]
            nNewHeight  = aData[ FWGIF_HEIGHT ]
         endif  
      endif
   endif      
   
   ::SetSizing( nSizingType )

   ::ReSize( , nNewWidth, nNewHeight )
   
   ::nSizingType = nSizingType
   
return ::Super:Refresh()  
   
   

[karinha]

Bello, má che bello. Gracias.

https://i.imgur.com/8cEn4Jp.png



Regards, saludos.

[AIDA]

Hola funciona muy bien el ejemplo con los cambios nuevos
en mi recurso ya funciona si lo ejecuto directamente, PERO cuando lo ejecuto desde el menu
o desde un TASKITEM se truena y manda un error
no comprendo por que pasa esto? a si lo tengo se llama TABLAS()

AQUI DESDE UN ASKITEM

Code: Select all  Expand view  RUN

TASKITEM (FWString("Color Equivalence"))   BITMAP "GREEN"  ACTION Equivalencia(lVar1)
           TASKITEM (FWString("Scales Converter"))    BITMAP "RED"    ACTION ESCALA(lVar1)
           TASKITEM (FWString("&Data tables") )       BITMAP "GREEN"ACTION  TABLAS()

AQUI DESDE UN MENU

Code: Select all  Expand view  RUN

MENUITEM   FILE "PLUS2"    FWString("&Close all")      ACTION oTaskPanel:CollapseAll()
         MENUITEM   FILE "PLUS"     FWString("&Expand all")     ACTION oTaskPanel:ExpandAll()
         SEPARATOR
         MENUITEM   FILE "COLORES"  FWString("&Data tables")    ACTION  TABLAS()

AQUI EL ERROR DE CADA UNO

ERROR USANDO TASKITEM

Code: Select all  Expand view  RUN

Error occurred at: 21/04/2021, 19:49:37
   Error description: Error FiveWin/1  Non defined Id: No:    177

Stack Calls
===========
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:INITIATE( 452 )
   Called from: NGIF.prg => (b)TGIF:TGIF( 45 )
   Called from:  => TGIF:INITIATE( 0 )
   Called from:  => __OBJSENDMSG( 0 )
   Called from:  => HB_EXECFROMARRAY( 0 )
   Called from: .\source\function\HARBOUR.PRG => OSEND( 300 )
   Called from:  => HB_EXECFROMARRAY( 0 )
   Called from: .\source\function\HARBOUR.PRG => ASEND( 278 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:INITIATE( 805 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT( 1124 )
   Called from:  => DIALOGBOX( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 304 )
   Called from: tablitas.prg => TABLAS( 1221 )
   Called from: model.prg => (b)MAIN( 750 )
   Called from: source\h_ttaskitem.prg => TTASKITEM:LBUTTONUP( 317 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1817 )
   Called from: source\h_ttaskitem.prg => TTASKITEM:HANDLEEVENT( 258 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3559 )
   Called from:  => WINRUN( 0 )
   Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE( 1097 )
   Called from: model.prg => MAIN( 769 )

ERROR USANDO BUILDMENU

Code: Select all  Expand view  RUN

Error occurred at: 21/04/2021, 19:44:10
   Error description: Error FiveWin/1  Non defined Id: No:    176

Stack Calls
===========
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:INITIATE( 452 )
   Called from: NGIF.prg => (b)TGIF:TGIF( 45 )
   Called from:  => TGIF:INITIATE( 0 )
   Called from:  => __OBJSENDMSG( 0 )
   Called from:  => HB_EXECFROMARRAY( 0 )
   Called from: .\source\function\HARBOUR.PRG => OSEND( 300 )
   Called from:  => HB_EXECFROMARRAY( 0 )
   Called from: .\source\function\HARBOUR.PRG => ASEND( 278 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:INITIATE( 805 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT( 1124 )
   Called from:  => DIALOGBOX( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 304 )
   Called from: tablitas.prg => ESTO( 1330 )
   Called from: model.prg => (b)BUILDMENU( 17171 )
   Called from: .\source\classes\MENU.PRG => TMENU:COMMAND( 1563 )
   Called from: .\source\classes\WINDOW.PRG => TWINDOW:COMMAND( 1141 )
   Called from:  => TWINDOW:HANDLEEVENT( 0 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3559 )
   Called from:  => WINRUN( 0 )
   Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE( 1097 )
   Called from: model.prg => MAIN( 768 )
 

SI LO EJECUTO DIRECTAMENTE FUNCIONA DE MARAVILLA

TABLAS()



AQUI MI CODIGO

Code: Select all  Expand view  RUN

Function TABLAS()
LOCAL oSof,oBrush,oGif, oAni,coloRi,mArc,coloRi2,coloRi3,coloRi4,coloRi5,coloRi6,coloRi7,coloRi8,oBtnOkKMm,oSay,oBold,oBtnOkKM
local cfile := "FOND\Video-02.gif"
local tipo:=  {FWString("Please select ..."),"Citadel Base","Citadel Dry","Citadel Edge","Citadel Glaze","Citadel Layer","Citadel Shade","Citadel Technical","Citadel Texture" }
local tipo2:= {FWString("Please select ..."),"MR.COLOR","AQUEOUS HOBBY COLOR" }
local tipo3:= {FWString("Please select ..."),"Matt Colours","Metalcote Colours","Satin Colours","Gloss Colours","Metallic Colours"}
local tipo4:= {FWString("Please select ..."),"Linea General","Linea Fantasy"}
local tipo5:= {FWString("Please select ..."),"Acrylic Mini Gloss 10ml","Acrylic Mini Flat 10ml","Acrylic Paint Gloss 23ml","Acrylic Paint Flat 23ml","Spray Paints for Polycarbonate","Lacquer Paint","Spray Paints TS"}
local tipo6:= {FWString("Please select ..."),"MODEL MASTER® Acrylic Paints","MODEL MASTER® Enamel Paints"}
local tipo7:= {FWString("Please select ..."),"Model Color","Model Air","Game Color","Game Air","Panzer Aces","Pigmentos"}
local tipo8:= {FWString("Please select ..."),"Real Color"}

SetCbxColorFocus( RGB( 255, 255, 00) )

DEFINE FONT oBold NAME "TAHOMA" SIZE 0,-11 BOLD

DEFINE BRUSH oBrush FILE "FOND\fondito.BMP"

DEFINE DIALOG oSof RESOURCE "TABLAS" TITLE FWString("MODIFICATION AND UPDATING OF COLORS BY BRAND") BRUSH oBrush TRANSPARENT

oAni  = TAnimate():REDEFINE( 100, oSof )
oSof:lHelpIcon    := .F.
oSof:lTransparent := .t.

REDEFINE GIF oGif ID 101 OF oSof RESOURCE "FOND\Video-02.gif"  ADJUST

coloRi:=tipo[1]
REDEFINE COMBOBOX mArc VAR coloRi   ITEMS tipo   ID 4021 OF oSof on change(cambiacitadel(coloRi))   //UPDATE
mArc:bGotFocus  := { || mArc:SetColor( 0, RGB(255,242,0)) }
mArc:bLostFocus := { || mArc:SetColor( 0, CLR_RED  ) }

coloRi2:=tipo2[1]
REDEFINE COMBOBOX mArc VAR coloRi2   ITEMS tipo2   ID 4008 OF oSof on change(cambiagunze(coloRi2)) UPDATE

coloRi3:=tipo3[1]
REDEFINE COMBOBOX mArc VAR coloRi3   ITEMS tipo3   ID 4010 OF oSof on change(cambiahumbrol(coloRi3)) UPDATE

coloRi4:=tipo4[1]
REDEFINE COMBOBOX mArc VAR coloRi4   ITEMS tipo4   ID 4018 OF oSof on change(cambiaronin(coloRi4)) UPDATE

coloRi5:=tipo5[1]
REDEFINE COMBOBOX mArc VAR coloRi5   ITEMS tipo5   ID 4012 OF oSof on change(cambiatamiya(coloRi5)) UPDATE

coloRi6:=tipo6[1]
REDEFINE COMBOBOX mArc VAR coloRi6   ITEMS tipo6   ID 4013 OF oSof on change(cambiatestor(coloRi6)) UPDATE

coloRi7:=tipo7[1]
REDEFINE COMBOBOX mArc VAR coloRi7   ITEMS tipo7   ID 4007 OF oSof on change(cambiavallejo(coloRi7)) UPDATE

coloRi8:=tipo8[1]
REDEFINE COMBOBOX mArc VAR coloRi8   ITEMS tipo8   ID 600 OF oSof on change(cambiaAK(coloRi8)) UPDATE

REDEFINE SAY oSay  ID 4019 OF oSof transparent COLOR CLR_RED FONT oBold
REDEFINE SAY oSay  ID 4020 OF oSof transparent COLOR CLR_GREEN FONT oBold
REDEFINE SAY oSay  ID 4022 OF oSof transparent COLOR CLR_BLUE FONT oBold

REDEFINE SAY oSay  ID 4023 OF oSof transparent COLOR CLR_RED FONT oBold
REDEFINE SAY oSay  ID 4024 OF oSof transparent COLOR CLR_GREEN FONT oBold
REDEFINE SAY oSay  ID 4025 OF oSof transparent COLOR CLR_BLUE FONT oBold

REDEFINE SAY oSay  ID 4026 OF oSof transparent COLOR CLR_RED  FONT oBold
REDEFINE SAY oSay  ID 4027 OF oSof transparent COLOR CLR_GREEN FONT oBold
REDEFINE SAY oSay  ID 4028 OF oSof transparent COLOR CLR_BLUE FONT oBold

REDEFINE SAY oSay  ID 4029 OF oSof transparent COLOR CLR_RED FONT oBold
REDEFINE SAY oSay  ID 4030 OF oSof transparent COLOR CLR_GREEN FONT oBold
REDEFINE SAY oSay  ID 4031 OF oSof transparent COLOR CLR_BLUE FONT oBold

REDEFINE SAY oSay  ID 4032 OF oSof transparent COLOR CLR_RED FONT oBold
REDEFINE SAY oSay  ID 4033 OF oSof transparent COLOR CLR_GREEN FONT oBold
REDEFINE SAY oSay  ID 4034 OF oSof transparent COLOR CLR_BLUE FONT oBold

REDEFINE SAY oSay  ID 4035 OF oSof transparent COLOR CLR_RED FONT oBold
REDEFINE SAY oSay  ID 4036 OF oSof transparent COLOR CLR_GREEN FONT oBold
REDEFINE SAY oSay  ID 4037 OF oSof transparent COLOR CLR_BLUE FONT oBold



REDEFINE BTNBMP oBtnOkKM ID 4015 OF oSof PROMPT FWString("Multiple Color Marks") FILE "MIX2" 2007 ACTION COLORMIX()

REDEFINE BTNBMP oBtnOkKM ID 4014 OF oSof PROMPT FWString("OPEN RGB COLOR PAGE") FILE "MONITOR2" 2007 LEFT ACTION WinExec("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe http://www.procato.com/rgbfind/")
oBtnOkKM:cTooltip :={ FWString("PAGE TO FIND THE NUMERIC VALUES TO MODIFY AND GIVE HIGH COLORS IN THE RED GREEN AND BLUE FIELDS."), "RGB colors",1,CLR_WHITE,CLR_RED }


REDEFINE BTNBMP oBtnOkKMm ID 4016 OF oSof PROMPT FWString("OPEN RGB COLOR PAGE") FILE "MONITOR2" 2007 LEFT ACTION WinExec("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe https://www.encycolorpedia.es/")
oBtnOkKMm:cTooltip :={ FWString("ENCYCOLORPEDIA PAGE TO FIND THE NUMERIC VALUES TO MODIFY AND GIVE HIGH COLORS IN THE RED GREEN AND BLUE FIELDS."), "RGB colors",1,CLR_WHITE,CLR_RED }

REDEFINE BTNBMP oBtnOkKMm ID 502 OF oSof prompt FWString("EXIT") FILE "EXIT" 2007 Left   ACTION(oSof:End())
oSof:Shadow()
ACTIVATE DIALOG oSof CENTERED ON INIT (oAni:Open("FOND\Video01.avi"),;
                                       oAni:Play())
oAni:Stop()

RETURN Nil

[Antonio Linares]

Aida,

Los errorres hacen referencias a unos controles con IDs 176 y 177 que no están en el RC

Donde están esos controles ?

[AIDA]

no existen no los tengo eso sale cuando ejecuto desde un menu pero si lo ejecuto directamente funciona

siempre salta en la linea 452 del TCONTROL

[Antonio Linares]

Arreglado, muchas gracias Aida por tu ayuda

Faltaba esta línea en el método Redefine():
::nId = nId

De esta forma, este ejemplo funciona correctamente:

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

   local oWnd

   DEFINE WINDOW oWnd MENU BuildMenu()

   ACTIVATE WINDOW oWnd

return nil  

function BuildMenu()

   local oMenu

   MENU oMenu
      MENUITEM "Test" ACTION Test()
   ENDMENU
   
return oMenu  

function Test()

   local oDlg, oGif, oBrush
   
   DEFINE BRUSH oBrush FILE "..\bitmaps\backgrnd\beach.bmp"

   DEFINE DIALOG oDlg RESOURCE "test" TITLE "A modal dialog" BRUSH oBrush TRANSPARENT
   
   REDEFINE GIF oGif ID 101 OF oDlg RESOURCE "..\gifs\halo.gif" // ADJUST

   ACTIVATE DIALOG oDlg CENTERED
   
return nil  

[AIDA]

Super ahora si funciona

Code: Select all  Expand view  RUN

//----------------------------------------------------------//

METHOD Redefine( nId, oWnd, cGifFile, lAdjust )

   DEFAULT lAdjust := .T.
   ::nId = nId
   ::cFileName = cGifFile
   ::lAdjust   = lAdjust

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if oWnd != nil
      ::oWnd = oWnd
      oWnd:DefControl( Self )
   endif

return Self
 

[AIDA]

Hola ya estoy de regreso

apenas me di cuenta que el ACTION no esta implementado en el
REDEFINE GIF yo quería ejecutar desde un gif

Code: Select all  Expand view  RUN

REDEFINE GIF oGif ID 101 OF oSof RESOURCE "FOND\GIF\AMRa.gif"  ADJUST ACTION Alert("HOLA")

Code: Select all  Expand view  RUN

#define FWGIF_LOOPING          1
#define FWGIF_CURRENTLOOP      2
#define FWGIF_IMAGES           3
#define FWGIF_WIDTH            4
#define FWGIF_HEIGHT           5
#define FWGIF_SIZINGTYPE       6

#define FWGIF_SIZING_FILE      0
#define FWGIF_SIZING_CLIP      1
#define FWGIF_SIZING_STRETCH   2



#xcommand REDEFINE GIF [ <oGif> ] ;
             [ ID <nId> ] ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <resource: NAME, RESNAME, RESOURCE> <cResName> ] ;
             [ <adjust: ADJUST> ] ;
       => ;
          [ <oGif> := ] TGif():ReDefine( <nId>, <oWnd>, <cResName>, <.adjust.> )





#xcommand @ <nRow>, <nCol> GIF [<oGif>] ;
             [ <file: FILE, FILENAME, DISK> <cGifFile> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ ACTION <uAction,...> ] ;
             [ <of:OF, WINDOW, DIALOG> <oWnd> ] ;
             [ MESSAGE <cMsg> ] ;
             [ <adjust: ADJUST> ] ;
             [ CURSOR <oCursor> ] ;
      => ;
         [ <oGif> := ] TGif():New( <oWnd>, <cGifFile>, <nRow>, <nCol>,;
                                   <nHeight>, <nWidth>, <oCursor>, <.adjust.>, [{|Self|<uAction>}] )
 

Ya lo incluí y funciona

Code: Select all  Expand view  RUN

/*
 * Proyecto: modelos
 * Fichero: NGIF.prg
 * Descripción:
 * Autor:
 * Fecha: 20/04/2021
 */
#include "fivewin.ch"
#include "gif.ch"


CLASS TGif FROM TControl

   DATA  hGif
   DATA  cFilename
   DATA  lAdjust
   DATA  nSizingType

   CLASSDATA lRegistered

   METHOD New( oWnd, cGifFile, nRow, nCol,;
            nHeight, nWidth, oCursor, lAdjust, bAction )

   METHOD Redefine( nId, oWnd, cGifFile, lAdjust,bAction )

   METHOD GetData() INLINE If( ! Empty( ::hGif ), GetGifInfo( ::hGif ),)

   METHOD Play() INLINE FWGifPlay( ::hGif )
   METHOD Stop() INLINE FWGifStop( ::hGif )

   METHOD Restart() INLINE FWGifRestart( ::hGif )

   METHOD IsRunning() INLINE FWGifIsRunning( ::hGif )

   METHOD Destroy() INLINE FWGifEnd()

   METHOD SetFile( cFile ) INLINE ::cFileName := cFile, SetWindowText( ::hGif, cFile )

   METHOD SetSizing( nType ) INLINE FWSetGIFSizing( ::hGif, nType )

   METHOD Refresh()

   METHOD ReSize( nSizeType, nWidth, nHeight ) INLINE ::SetSize( nWidth, nHeight, .T. ),;
                                                      WndSetSize( ::hGif, nWidth, nHeight, .T. )
   METHOD Initiate( hDlg ) INLINE  ::Super:Initiate( hDlg ), ::Default()

   METHOD Default()

ENDCLASS

//----------------------------------------------------------------//

METHOD New( oWnd, cGifFile, nRow, nCol,;
            nHeight, nWidth, oCursor, lAdjust, bAction ) CLASS TGif

    local aData, nNewWidth, nNewHeight, nSizingType
    local hRes
    local cDir, cTempfile

    DEFAULT oWnd    := GetWndDefault(),;
            nRow    := 0,;
            nCol    := 0,;
            lAdjust := .F.

   ::nTop    = nRow
   ::nLeft   = nCol
   ::nStyle  = nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )

   ::bLClicked = bAction

   ::nSizingType = FWGIF_SIZING_FILE

   if nHeight == nil .or. nWidth == nil
      ::nBottom = 100
      ::nRight  = 100
   else
      ::nBottom = nHeight + nRow
      ::nRight = nWidth + nCol
      ::nSizingType = FWGIF_SIZING_CLIP
   endif

   ::oWnd    = oWnd
   ::oCursor = oCursor

   ::cFileName = cGifFile
   ::oBrush    = oWnd:oBrush
   ::lAdjust   = lAdjust

   ::Register( )

   if ! Empty( oWnd:hWnd )
      ::Create()
      ::lVisible = .t.
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
      ::lVisible  = .f.
   endif

   ::Default()

return self

//----------------------------------------------------------//

METHOD Redefine( nId, oWnd, cGifFile, lAdjust,bAction )

   DEFAULT lAdjust := .T.
   ::nId = nId
   ::cFileName = cGifFile
   ::lAdjust   = lAdjust
   ::bLClicked = bAction

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if oWnd != nil
      ::oWnd = oWnd
      oWnd:DefControl( Self )
   endif

return Self

//----------------------------------------------------------//

METHOD Default() CLASS TGif

   local hRes, cDir, cTempFile
   local cGifFile := ::cFileName
   local aData, nNewWidth := 100, nNewHeight := 100, nSizingType

   if ! Empty( cGifFile ) .and. ! File( cGifFile )
      hRes  = FindResource( GetResources(), cGifFile, 10 )
      If Empty( hres )
         return nil
      else
         cDir   = GetEnv( "TEMP" )
         if Empty( cDir )
            cDir = GetEnv( "TMP" )
         endif
         cTempfile = cDir + cTempFile( "\", "gif" )
         RCDataToFile( 0, cGifFile, cTempfile )
      endif
   endif

   If ! Empty( cTempfile )
      ::hGif = FWGifWindow( cTempFile, 0, 0, ::nWidth, ::nHeight, ::hWnd )
   else
      ::hGif = FWGifWindow( cGifFile, 0, 0, ::nWidth, ::nHeight, ::hWnd )
   endif

   aData = ::GetData()

   if ! ::lAdjust
      if ! Empty( aData )
         nNewWidth  = aData[ FWGIF_WIDTH ]
         nNewHeight = aData[ FWGIF_HEIGHT ]
      endif
   else
      nNewWidth  = ::nWidth
      nNewHeight = ::nHeight
   endif

   ::ReSize( , nNewWidth, nNewHeight )

   if ::lAdjust
      ::nSizingType = FWGIF_SIZING_STRETCH
   endif
   ::SetSizing( ::nSizingType )

   If ! Empty( cTempfile )
      FErase( cTempfile )
   endif

return nil

//----------------------------------------------------------//

METHOD Refresh() CLASS TGif

   local nSizingType := ::nSizingType
   local aData := ::GetData()
   local nNewWidth, nNewHeight

   if ! Empty( aData )
      nNewWidth  = aData[ FWGIF_WIDTH ]
      nNewHeight = aData[ FWGIF_HEIGHT ]
   endif

   if ::lAdjust
      if nSizingType != FWGIF_SIZING_STRETCH
         nSizingType = FWGIF_SIZING_STRETCH
      endif
   else
      if nSizingType = FWGIF_SIZING_CLIP
         nNewWidth   = ::nWidth
         nNewHeight  = ::nHeight
      else
         nSizingType = FWGIF_SIZING_FILE
         if ! Empty( aData )
            nNewWidth   = aData[ FWGIF_WIDTH ]
            nNewHeight  = aData[ FWGIF_HEIGHT ]
         endif
      endif
   endif

   ::SetSizing( nSizingType )

   ::ReSize( , nNewWidth, nNewHeight )

   ::nSizingType = nSizingType

return ::Super:Refresh()

aqui el gif.ch

Code: Select all  Expand view  RUN

#define FWGIF_LOOPING          1
#define FWGIF_CURRENTLOOP      2
#define FWGIF_IMAGES           3
#define FWGIF_WIDTH            4
#define FWGIF_HEIGHT           5
#define FWGIF_SIZINGTYPE       6

#define FWGIF_SIZING_FILE      0
#define FWGIF_SIZING_CLIP      1
#define FWGIF_SIZING_STRETCH   2



#xcommand REDEFINE GIF [ <oGif> ] ;
             [ ID <nId> ] ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <resource: NAME, RESNAME, RESOURCE> <cResName> ] ;
             [ <adjust: ADJUST> ] ;
             [ ACTION <uAction,...> ] ;
       => ;
          [ <oGif> := ] TGif():ReDefine( <nId>, <oWnd>, <cResName>, <.adjust.>, [{|Self|<uAction>}] )





#xcommand @ <nRow>, <nCol> GIF [<oGif>] ;
             [ <file: FILE, FILENAME, DISK> <cGifFile> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ ACTION <uAction,...> ] ;
             [ <of:OF, WINDOW, DIALOG> <oWnd> ] ;
             [ MESSAGE <cMsg> ] ;
             [ <adjust: ADJUST> ] ;
             [ CURSOR <oCursor> ] ;
      => ;
         [ <oGif> := ] TGif():New( <oWnd>, <cGifFile>, <nRow>, <nCol>,;
                                   <nHeight>, <nWidth>, <oCursor>, <.adjust.>, [{|Self|<uAction>}] )

no funcionan los tooltip en el gif

oGif:cTooltip

es la primera ves que meto mano a un método sin dañarlo
Saluditos

[Antonio Linares]

Bravo Aida, muy bien!!!

vamos a mirar lo de los tooltips...