Código: Selecionar todos
#include "fivewin.ch"
PROCEDURE ze_fwTextMsg
LOCAL oDlgMsg, nCont, bOldError
hb_ThreadStart( { || oDlgMsg := DlgTextMsgClass():New(), oDlgMsg:Execute() } )
bOldError := ErrorBlock()
ErrorBlock( { | e | oDlgMsg:lCanClose := .T., oDlgMsg:End(), iif( bOldError == Nil, Nil, Eval( bOldError, e ) ) } )
Inkey(2)
FOR nCont = 1 TO 50
oDlgMsg:ShowText( "Test " + Ltrim( Str( nCont ) ) )
oDlgMsg:nGAtual += 2
oDlgMsg:ShowMeter( oDlgMsg:nGAtual )
Inkey(0.5)
NEXT
? oDlgMsg / 3 // force error
oDlgMsg:lCanClose := .T.
oDlgMsg:End()
RETURN
CREATE CLASS DlgTextMsgClass
VAR xDlg
VAR oBrowse
VAR oGet
VAR oSay1
VAR oSay2
VAR oMeter
VAR aText INIT { "." }
VAR cText
VAR cText1 INIT ""
VAR cText2 INIT ""
VAR nMaxRow INIT 10
VAR nStyle INIT 2
VAR lCanClose INIT .F.
VAR lGraph INIT .T.
VAR nGAtual INIT 0
VAR nGTotal INIT 100
VAR nGSecStart INIT 0
VAR nGSecNow INIT 0
METHOD Execute()
METHOD ShowText( cText )
METHOD ShowMeter( nValue )
METHOD End() INLINE ::xDlg:End()
ENDCLASS
METHOD Execute() CLASS DlgTextMsgClass
LOCAL nDlgWidth, nDlgHeight // xStatusbar,
LOCAL xControl, oCol
::nGSecStart := Int( Seconds() )
nDlgWidth := AppWindowInfo()[1]
nDlgHeight := AppWindowInfo()[2]
::nMaxRow := Int( nDlgHeight / ( AppFontSize() + 2 ) - 2 )
DEFINE DIALOG ::xDlg FROM 0, 0 TO nDlgHeight, nDlgWidth PIXEL ;
FONT AppFont() ;
TITLE "TextScroll" // COLOR COLOR_WHITE, CLR_JPA
::xDlg:SetIcon( TIcon():New(,,"APPICON" ) )
::xDlg:bValid := { || ::lCanClose }
IF ::lGraph
@ nDlgHeight - 80, 40 SAY ::oSay1 VAR ::cText1 OF ::xDlg PIXEL ;
SIZE 500, AppFontSize() FONT AppFont() COLOR CLR_BLACK, CLR_WHITE // TRANSPARENT BORDER
@ nDlgHeight - 80, nDlgWidth - 550 SAY ::oSay2 VAR ::cText2 OF ::xDlg PIXEL ;
SIZE 500, AppFontSize() FONT AppFont() RIGHT COLOR CLR_BLACK, CLR_WHITE // TRANSPARENT BORDER
@ nDlgHeight - 60, 40 METER ::oMeter VAR ::nGAtual ;
SIZE nDlgWidth - 80, AppFontSize() * 2 PIXEL OF ::xDlg ;
COLOR CLR_HGRAY, CLR_BLACK ;
BARCOLOR CLR_MAGENTA, CLR_WHITE ;
TOTAL ::nGTotal FONT AppFont() BORDER CLR_BLACK UPDATE
ENDIF
IF ::nStyle == 1
@ 10, 10 GET ::oGet VAR ::cText MEMO OF ::xDlg PIXEL ;
SIZE nDlgWidth - AppFontSize(), nDlgHeight - AppFontSize() - iif( ::lGraph, 100, 0 ) ;
FONT AppFont() COLOR CLR_BLACK, CLR_WHITE // TRANSPARENT BORDER
ENDIF
//::xGet:Disable()
//Don't works for GET MEMO
//::xGet:lDisColors := .F.
//::xGet:nClrTextDis := RGB2N(20,20,20)
IF ::nStyle == 2
@ 10, 10 XBROWSE xControl ;
ARRAY { "" } ;
SIZE nDlgWidth - AppFontSize(), nDlgHeight - AppFontSize() - iif( ::lGraph, 100, 0 ) ;
FONT AppFont() PIXEL
oCol := xControl:AddCol()
oCol:cHeader := "Text"
oCol:bStrData := { || xControl:aArrayData[ xControl:nArrayAt ] }
xControl:lFitGridHeight := .T. // adjust extra space to header/footer
xControl:nStretchCol := STRETCHCOL_WIDEST
xControl:CreateFromCode()
::oBrowse := xControl
ENDIF
ACTIVATE DIALOG ::xDlg CENTERED
//ON INIT ( (Self), guistatusBarCreate( ::xDlg, @xStatusbar, "" ) )
RETURN Nil
METHOD ShowText( cText ) CLASS DlgTextMsgClass
LOCAL cItem
IF Len( ::aText ) = ::nMaxRow
ADel( ::aText, 1 )
::aText[ Len( ::aText ) ] := cText
ELSE
AAdd( ::aText, cText )
ENDIF
::cText := ""
FOR EACH cItem IN ::aText
::cText += cItem + hb_Eol()
NEXT
IF ::nStyle == 1
::oSay:VarPut( ::cText )
::oSay:Refresh()
ENDIF
IF ::nStyle == 2
::oBrowse:SetArray( ::aText )
::oBrowse:nArrayAt := Len( ::aText )
::oBrowse:Refresh()
ENDIF
RETURN Nil
METHOD ShowMeter( nValue ) CLASS DlgTextMsgClass
LOCAL nSecElapsed, nSecRemaining
IF ::nGSecNow != Int( Seconds() )
::nGSecNow := Seconds()
::nGAtual := nValue
nSecElapsed := ::nGSecNow - ::nGSecStart
DO WHILE nSecElapsed < 0
nSecElapsed += ( 24 * 3600 )
ENDDO
nSecRemaining := nSecElapsed / ::nGAtual * ( ::nGTotal - ::nGAtual )
::oSay1:VarPut( "Proc." + Ltrim( Str( ::nGAtual, 15, 0 ) ) + "/" + ;
Ltrim( Str( ::nGTotal, 15, 0 ) ) + ;
" Gasto " + SecText( nSecElapsed ) )
::oSay1:Refresh()
::oSay2:VarPut( "Falta " + SecText( nSecRemaining ) )
::oSay2:Refresh()
::xDlg:Update()
ENDIF
RETURN Nil
STATIC FUNCTION SecText( nS )
LOCAL nH, nM
nM := Int( nS / 60 )
nS -= ( nM * 60 )
nH := Int( nM / 60 )
nM -= ( nH * 60 )
RETURN ;
Ltrim( Str( nH, 2 ) ) + "h " + ;
Ltrim( Str( nM, 2 ) ) + "m " + ;
Ltrim( Str( nS, 2 ) ) + "s"
//STATIC FUNCTION guiStatusBarCreate( xDlg, xStatusbar, cText )
//DEFINE STATUSBAR xStatusBar PROMPT cText OF xDlg
//xDlg:Refresh()
//RETURN xStatusBar
Código: Selecionar todos
? oDlgMsg / 3 // force error
Código: Selecionar todos
bOldError := ErrorBlock()
ErrorBlock( { | e | oDlgMsg:lCanClose := .T., oDlgMsg:End(), iif( bOldError == Nil, Nil, Eval( bOldError, e ) ) } )
Lembram: multithread é igual EXEs separados.
Tem o "EXE" do módulo, e o "EXE" da dialog.
Se dá erro no módulo.... a dialog fica aberta, precisa fechar no gerenciador de tarefas.
Então, criei um errorblock que fecha a dialog.
Um recurso interessante no fivewin é o bloco VALID no fechamento da dialog.
Se retornar .F., a dialog não fecha, tanto faz se é MODAL ou não.
É pra isso que uso o lCanClose.
Até Dlg:End() fica impedido de fechar, por isso primeiro altero lCanClose := .T. pra depois usar oDlg:End()
Fico imaginando que as LIBs GUI poderiam usar errorblocks desse jeito, pra facilitar trabalho do programador.
Não me perguntem aonde, cada situação precisa solução diferente.

