Funcionando sin necesidad de ninguna DLL externa
Aqui teneis un primer ejemplo:
http://rapidshare.com/files/105699956/test.zip.html
Haciendo click sobre el GIF lo detienes, y otro click lo anima
ACTIVATE DIALOG oDlg ON INIT BuildGif( oDlg )
...
function BuildGif( oDlg )
TGif():New( oDlg, "test.gif", 10, 10 )
return nil
#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 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, nNewHeight, 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
nNewWidth = aData[ FWGIF_WIDTH ]
nNewHeight = aData[ FWGIF_HEIGHT ]
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 := aData[ FWGIF_WIDTH ],;
nNewHeight := aData[ FWGIF_HEIGHT ]
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
nNewWidth = aData[ FWGIF_WIDTH ]
nNewHeight = aData[ FWGIF_HEIGHT ]
endif
endif
::SetSizing( nSizingType )
::ReSize( , nNewWidth, nNewHeight )
::nSizingType = nSizingType
return ::Super:Refresh()
// Animated GIFs support for FWH
#include "FiveWin.ch"
function Main()
local oDlg, oGif
DEFINE DIALOG oDlg RESOURCE "test" TITLE "A modal dialog"
REDEFINE GIF oGif ID 101 OF oDlg RESOURCE "..\gifs\halo.gif"
ACTIVATE DIALOG oDlg CENTERED
return nil
TEST DIALOG 61, 39, 294, 219
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TGif Redefine support"
FONT 8, "MS Sans Serif"
{
CONTROL "", 101, "TGif", 0 | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 10, 10, 140, 170
DEFPUSHBUTTON "OK", IDOK, 82, 200, 50, 14
PUSHBUTTON "Cancel", IDCANCEL, 142, 200, 50, 14
}
#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.> )
Antonio Linares wrote:Aida,
Aqui tienes una primera versión funcionando. La incluiremos en FWH 21.03
tgif.prg
- 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 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, nNewHeight, 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
nNewWidth = aData[ FWGIF_WIDTH ]
nNewHeight = aData[ FWGIF_HEIGHT ]
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 := aData[ FWGIF_WIDTH ],;
nNewHeight := aData[ FWGIF_HEIGHT ]
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
nNewWidth = aData[ FWGIF_WIDTH ]
nNewHeight = aData[ FWGIF_HEIGHT ]
endif
endif
::SetSizing( nSizingType )
::ReSize( , nNewWidth, nNewHeight )
::nSizingType = nSizingType
return ::Super:Refresh()
Aqui un ejemplo de uso:
testgifr.prg
- Code: Select all Expand view RUN
// Animated GIFs support for FWH
#include "FiveWin.ch"
function Main()
local oDlg, oGif
DEFINE DIALOG oDlg RESOURCE "test" TITLE "A modal dialog"
REDEFINE GIF oGif ID 101 OF oDlg RESOURCE "..\gifs\halo.gif"
ACTIVATE DIALOG oDlg CENTERED
return nil
testgifr.rc
- Code: Select all Expand view RUN
TEST DIALOG 61, 39, 294, 219
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "TGif Redefine support"
FONT 8, "MS Sans Serif"
{
CONTROL "", 101, "TGif", 0 | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 10, 10, 140, 170
DEFPUSHBUTTON "OK", IDOK, 82, 200, 50, 14
PUSHBUTTON "Cancel", IDCANCEL, 142, 200, 50, 14
}
Y finalmente el nuevo comando:
- Code: Select all Expand view RUN
#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.> )
AIDA wrote:ya aplique todo correctamente
compila sin errores
pero al ejecutar
Time from start: 0 hours 0 mins 9 secs
Error occurred at: 20/04/2021, 19:12:38
Error description: Error FiveWin/1 Non defined Id: No: 175
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: model.prg => TABLAS( 6791 )
Called from: model.prg => (b)BUILDMENU( 17055 )
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( 765 )
ESE RECURSO 175 NO LO USO PERO EN EL RECURSO COLOQUE UNO CON EL 175 PARA PROBAR Y AL EJECUTAR TRUENA EL PROGRAMA
function ESTO()
local oDlg, oGif
DEFINE DIALOG oDlg RESOURCE "test" TITLE "A modal dialog"
REDEFINE GIF oGif ID 101 OF oDlg RESOURCE "..\gifs\halo.gif"
ACTIVATE DIALOG oDlg CENTERED
return nil
function ESTO()
local oDlg, oGif,oBrush
DEFINE BRUSH oBrush FILE "FOND\fondito.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
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Antonio Linares and 43 guests