Text scroll and time graph

[JoséQuintas]

Image is my MySQL backup from harbour.
I do not think how to do this on fivewin.

Graph routine is simple, I update each second, to do not slow proccess.

Code: Select all | Expand

/*
ZE_GRAFTEMPO - GRAFICOS DE PROCESSAMENTO
1990.05 - José Quintas
*/

#include "inkey.ch"
#include "set.ch"

#define GRAFMODE 1
#define GRAFTIME 2
#define GRAF_SEC_OLD  1
#define GRAF_SEC_INI  2
#define GRAF_TXT_BAR  3
#define GRAF_TXT_TEXT 4

FUNCTION GrafProc( nRow, nCol )

   THREAD STATIC GrafInfo := { 1, "X" }
   LOCAL mSetDevice

   hb_Default( @nRow, MaxRow() - 1 )
   hb_Default( @nCol, MaxCol() - 2 )
   IF GrafInfo[ GRAFTIME ] != Time()
      mSetDevice := Set( _SET_DEVICE, "SCREEN" )
      @ nRow, nCol SAY "(" + Substr( "|/-\", GrafInfo[ GRAFMODE ], 1 ) + ")" COLOR SetColorMensagem()
      GrafInfo[ GRAFMODE ] = iif( GrafInfo[ GRAFMODE ] == 4, 1, GrafInfo[ GRAFMODE ] + 1 )
      Set( _SET_DEVICE, mSetDevice )
      GrafInfo[ GRAFTIME ] := Time()
   ENDIF

   RETURN .T.

FUNCTION GrafTempo( xContNow, xContTotal )

   THREAD STATIC aStatic := { 0, 0, "", "" }
   LOCAL nSecondsNow, nSecondsRemaining, nSecondsElapsed, nCont, nPos, cTxt, cCorAnt
   LOCAL nPercent, cTexto, mSetDevice

   xContNow := iif( xContNow == NIL, "", xContNow )
   IF Empty( aStatic[ GRAF_TXT_BAR ] )
      aStatic[ GRAF_TXT_BAR ] := Replicate( ".", MaxCol() )
      FOR nCont = 1 to 10
         nPos := Int( Len( aStatic[ GRAF_TXT_BAR ] ) / 10 * nCont )
         cTxt := lTrim( Str( nCont, 3 ) ) + "0%" + Chr(30)
         aStatic[ GRAF_TXT_BAR ] := Stuff( aStatic[ GRAF_TXT_BAR ], ( nPos - Len( cTxt ) ) + 1, Len( cTxt ), cTxt )
      NEXT
      aStatic[ GRAF_TXT_BAR ] := Chr(30) + aStatic[ GRAF_TXT_BAR ]
   ENDIF
   mSetDevice := Set( _SET_DEVICE, "SCREEN" )
   DO CASE
   CASE ValType( xContNow ) == "C"
      cTexto                  := xContNow
      aStatic[ GRAF_SEC_INI ] := Int( Seconds() )
   CASE xContTotal == NIL
      nPercent := xContNow
   CASE xContNow >= xContTotal
      nPercent := 100
   CASE xContTotal == 0
      nPercent := 0
   OTHERWISE
      nPercent := xContNow / xContTotal * 100
   ENDCASE
   xContNow   := iif( ValType( xContNow ) != "N", 0, xContNow )
   xContTotal := iif( ValType( xContTotal ) != "N", 0, xContTotal )

   cCorAnt := SetColor()
   SetColor( SetColorMensagem() )
   nSecondsNow := Int( Seconds() )
   IF nPercent == NIL
      aStatic[ GRAF_SEC_OLD ] := nSecondsNow
      Mensagem()
      @ MaxRow(), 0 SAY aStatic[ GRAF_TXT_BAR ]
      aStatic[ GRAF_TXT_TEXT ] := cTexto

   ELSEIF nPercent == 100 .OR. ( nSecondsNow != aStatic[ GRAF_SEC_OLD ] .AND. nPercent != 0 )
      aStatic[ GRAF_SEC_OLD ] := nSecondsNow
      nSecondsElapsed   := nSecondsNow - aStatic[ GRAF_SEC_INI ]
      DO WHILE nSecondsElapsed < 0
         nSecondsElapsed += ( 24 * 3600 ) // Acima de 24 horas
      ENDDO
      nSecondsRemaining := nSecondsElapsed / nPercent * ( 100 - nPercent )
      @ MaxRow()-1, 0 SAY aStatic[ GRAF_TXT_TEXT ] + " " + Ltrim( Transform( xContNow, PicVal(14,0) ) ) + "/" + Ltrim( Transform( xContTotal, PicVal(14,0) ) )
      cTxt := "Gasto:"
      cTxt += " " + Ltrim( Str( Int( nSecondsElapsed / 3600 ), 10 ) ) + "h"
      cTxt += " " + Ltrim( Str( Mod( Int( nSecondsElapsed / 60 ), 60 ), 10, 0 ) ) + "m"
      cTxt += " " + Ltrim( Str( Mod( nSecondsElapsed, 60 ), 10, 0 ) ) + "s"
      cTxt += Space(3)
      cTxt += "Falta:"
      cTxt += " " + Ltrim( Str( Int( nSecondsRemaining / 3600 ), 10 ) ) + "h"
      cTxt += " " + Ltrim( Str( Mod( Int( nSecondsRemaining / 60 ), 60 ), 10, 0 ) ) + "m"
      cTxt += " " + Ltrim( Str( Mod( nSecondsRemaining, 60 ), 10, 0 ) ) + "s"
      @ Row(), Col() SAY Padl( cTxt, MaxCol() - Col() - 4 )
      GrafProc()
      @ MaxRow(), 0 SAY Left( aStatic[ GRAF_TXT_BAR ], Len( aStatic[ GRAF_TXT_BAR ] ) * nPercent / 100 ) COLOR SetColorFocus()
   ENDIF
   SetColor( cCorAnt )
   SET( _SET_DEVICE, mSetDevice )

   RETURN .T.

I can use automatic as example:

Code: Select all | Expand

USE ( file )
GrafTempo( "processing" )
DO WHILE ! Eof()
   GrafTempo( RecNo(), LastRec() )
   SKIP
ENDDO

or

Code: Select all | Expand

USE ( file )
INDEX ON field->x FOR GrafTempo( RecNo(), LastRec() )

or manual

Code: Select all | Expand

USE ( File ) INDEX ( file )
nAtual := 0
nTotal := LastRec()
DO WHILE ! Eof()
   GrafTempo( nAtual++, nTotal )
   SKIP
ENDDO

On minigui I use windows type panel, to me it is like an user control.
It is simple too.

main dialog

Code: Select all | Expand

#include "hmg.ch"
#include "i_altsyntax.ch"

REQUEST HB_CODEPAGE_PTISO

PROCEDURE Main

   LOCAL oControl, aControlList := Array(6), nColor, nRow
   LOCAL nCurrent := 0, nTotal := 100, xDlg := "A"

   DEFINE WINDOW (xDlg) ;
      ROW 0 COL 0 ;
      WIDTH 1024 HEIGHT 768 ;
      TITLE "test" ;
      WINDOWTYPE MAIN ;
      ON INIT SetBackImage( xDlg )

      FOR EACH oControl, nRow, nColor IN aControlList, ;
         { 80, 160, 240, 320, 400, 480 }, ;
         { COLOR_SKYBLUE, COLOR_PERU, COLOR_GOLD, COLOR_VIOLET, COLOR_PEACHPUFF, COLOR_YELLOWGREEN }
         oControl := GraphTime():New( "A", nRow, 10, 500, 50, "working", nColor )
      NEXT

      DEFINE BUTTON BUTTON_1
         ROW      40
         COL      10
         CAPTION      'Click Me!'
         ACTION      AEval( aControlList, { | e | e:SetValues( nCurrent += 2, nTotal ) } )
         DEFAULT      .T.
      END BUTTON

   END WINDOW

   ACTIVATE WINDOW A

   RETURN

FUNCTION SetBackImage( xDlg )

   LOCAL hBrush

   DoMethod( xDlg, "DISABLEUPDATE" )
   DEFINE BKGBRUSH hBrush PATTERN IMAGE "imw10.png" IN ( xDlg )
   DoMethod( xDlg, "ENABLEUPDATE" )
   (hBrush)

   RETURN Nil

The "user control", using window type panel, and textbox over textbox

Code: Select all | Expand

/*
graphtime - graphic with time calculate
*/

#include "hmg.ch"
#include "i_altsyntax.ch"
#include "i_wincolor.ch"
#include "hbclass.ch"

STATIC nWindow := 1

CREATE CLASS GraphTime

   VAR xDlg
   VAR Parent
   VAR cTimeShow   INIT Time()
   VAR nSecondsInit
   VAR nSecondsOld
   VAR cText
   METHOD New( Parent, nRow, nCol, nWidth, nHeight, cTitle, xColor )
   METHOD SetValues( nCurrent, nTotal )

   ENDCLASS

METHOD SetValues( nCurrent, nTotal ) CLASS GraphTime

   LOCAL nSecNow, nSecElapsed, nSecRemaining, nPercent, nNewWidth, cCaption

   nCurrent := Min( nCurrent, nTotal )
   nSecNow := Int( Seconds() )
   IF nSecNow != ::nSecondsOld .AND. nCurrent != 0
      nNewWidth := Int( GetProperty( ::xDlg, "label1", "WIDTH" ) * nCurrent / nTotal )
      SetProperty( ::xDlg, "label3", "WIDTH", nNewWidth )
      ::nSecondsOld := nSecNow

      nSecElapsed   := nSecNow - ::nSecondsInit
      nSecRemaining := nSecElapsed / nCurrent * ( nTotal - nCurrent )
      nPercent := nCurrent * 100 / nTotal
      SetProperty( ::xDlg, "label1", "VALUE", ;
         Ltrim( Str( nCurrent ) ) + "/" + Ltrim( Str( nTotal ) ) + " " + ;
         "Elapsed " + SecToTime( nSecElapsed ) + ;
         " Remain " + SecToTime( nSecRemaining ) )
      cCaption := ::cText + " " + Ltrim( Str( nPercent ) ) + "%"
      SetProperty( ::xDlg, "label2", "VALUE", cCaption )
      SetProperty( ::xDlg, "label3", "VALUE", cCaption )
   ENDIF

   RETURN Nil

METHOD New( Parent, nRow, nCol, nWidth, nHeight, cTitle, xColor ) CLASS GraphTime

   ::cText := cTitle
   ::Parent := Parent
   ::nSecondsInit := Int( Seconds() )
   ::nSecondsOld  := Int( Seconds() )
   ::xDlg := "GTIME" + StrZero( nWindow++, 3 )

   DEFINE WINDOW ( ::xDlg ) ;
      ROW nRow ;
      COL nCol ;
      WIDTH nWidth ;
      HEIGHT nHeight ;
      WINDOWTYPE PANEL

      DEFINE LABEL ( "label1" )
         PARENT ( ::xDlg )
         ROW 10
         COL 10
         VALUE ""
         BORDER .T.
         WIDTH nWidth - 30
         HEIGHT 20
         BORDER .T.
      END LABEL

      DEFINE LABEL ( "label2" )
         PARENT ( ::xDlg )
         ROW 30
         COL 10
         VALUE ::cText
         BORDER .T.
         WIDTH nWidth - 30
         HEIGHT 20
         BORDER .T.
      END LABEL

      DEFINE LABEL ( "label3" )
         PARENT ( ::xDlg )
         ROW 30
         COL 10
         VALUE ::cText
         WIDTH 1
         HEIGHT 20
         BACKCOLOR xColor
         BORDER .T.
      END LABEL
   END WINDOW

   RETURN Self

At momment I do not know what can be used to anything like this on fivewin.
For Graph and for scroll text.

Note: post routines because they can be a reference to new ones.

For MySQL backup I get quantity and record count.

Code: Select all | Expand

   Mensagem( "Fazendo backup da base SQL" )

   WITH OBJECT cnSQL
      :Execute( "SHOW PROCEDURE STATUS WHERE db = DATABASE()" )
      nTotal += :RecordCount()
      :CloseRecordset()
      :Execute( "SHOW FUNCTION STATUS WHERE db = DATABASE()" )
      nTotal += :RecordCount()
      :CloseRecordset()
      :Execute( "SELECT table_name FROM information_schema.TABLES" + ;
         " WHERE table_schema = " + StringSQL( Lower( AppEmpresaApelido() ) ) + ;
         " AND  TABLE_TYPE = 'BASE TABLE'" )
      DO WHILE ! :Eof()
         nTotal += 1
         oTableRec := cnSQL:ExecuteReturnRS( "SELECT COUNT(*) AS QTD FROM " + cnSQL:String( "table_name" ) )
         nTotal += oTableRec:Fields( "QTD" ):Value
         oTableRec:Close()
         :MoveNext()
      ENDDO
      :CloseRecordset()
   ENDWITH

   GrafTempo( "Backup SQL" )
   nAtual := 0

   hFileOutput := fCreate( "backup" + Str( nBackupFileNum, 1 ) + ".sql", FC_NORMAL )
...
GrafTempo( nAtual, nTotal )
...

Note2: at momment I use table, procedure and function, I will add more types when use them.

[Antonio Linares]

Dear Jose,

You may use a Meter to show the progress.

For the text scroll you may use a TScrollPanel or a TXBrowse.

Do you allow the user to move up and down on the scrolled text ?

[wilsongamboa]

Dear Jose thnks for your code, I Try your sample and obtain

hbmk2: Error: Función(es) referenciada, no encontrada, pero desconocida:
SETCOLORMENSAGEM(), MENSAGEM(), PICVAL(), SETCOLORFOCUS()

[JoséQuintas]

Function is from my application.
A workaround:

Code: Select all | Expand

FUNCTION Mensagem( cTexto )
   LOCAL cColorOld
   cColorOld := SetColor()
   hb_Default( @cTexto, "" )
   SetColor( SetColorMensagem() )
   Scroll( MaxRow() - 1, 0, MaxRow(), MaxCol(), 0 )
   @ MaxRow() - 1, 0 SAY cTexto
   SetColor( cColorOld )
   RETURN Nil

FUNCTION SetColorMensagem()
   RETURN "W/N"

FUNCTION SetColorFocus()
   RETURN "W/GR+"

FUNCTION PicVal( nLen, nDec )
   LOCAL cPicture
   hb_Default( @nDec, 0 )
   cPicture := Replicate( "9", nLen )
   cPicture := Ltrim( Transform( Val( cPicture ), "999,999,999,999,999" ) )
   IF nDec != 0
      cPicture += "." + Replicate( "9", nDec )
   ENDIF
   cPicture := "@E " + cPicture
   RETURN cPicture
   

[JoséQuintas]

Do you allow the user to move up and down on the scrolled text ?

On most cases no.
- my server send eletronic factura mail, check new post codes, and others
- application update structures (dbf or mySQL)
- applicatin makes backup/zip of DBF and MySQL
- On application using dbf, I show each file pack/index
- application Import from XMLs - here is interesting up/down, because I inform about changed codes and others
At momment I remember about these ones.

[JoséQuintas]

I know about INIT, but I made on this way.

Note: using gtwvg with no display

Code: Select all | Expand

#include "fivewin.ch"

PROCEDURE ze_fwTextMsg

   LOCAL oVar, nCont 

   hb_ThreadStart( { || oVar := DlgTextMsgClass():New(), oVar:Execute() } )
   Inkey(2)
   FOR nCont = 1 TO 50
      oVar:ShowText( "Test " + Ltrim( Str( nCont ) ) )
      Inkey(2)
   NEXT
   oVar:End()

   RETURN

CREATE CLASS DlgTextMsgClass

   VAR xDlg
   VAR xControl
   VAR cText
   VAR aText    INIT {}
   VAR nMaxRow  INIT 10
   VAR nStyle   INIT 1

   METHOD Execute()
   METHOD ShowText( cText )
   METHOD End() INLINE ::xDlg:End()

   ENDCLASS

METHOD Execute() CLASS DlgTextMsgClass

   LOCAL nDlgWidth, nDlgHeight, oFont // xStatusbar,
   LOCAL nFontSize

   nDlgWidth  := AppWindowInfo()[1]
   nDlgHeight := AppWindowInfo()[2]
   nFontSize  := Int( AppWindowInfo()[ 3 ] * 0.8 )
   ::nMaxRow  := Int( nDlgHeight / ( nFontSize + 2 ) - 2 )

   DEFINE FONT oFont NAME "ARIAL" SIZE 0, -nFontSize
   DEFINE DIALOG ::xDlg FROM 0, 0 TO nDlgHeight, nDlgWidth PIXEL ;
      FONT oFont ;
      TITLE "TextScroll" // COLOR COLOR_WHITE, CLR_JPA
   ::xDlg:SetIcon( TIcon():New(,,"APPICON" ) )
   ::xDlg:bValid := .F.

   IF ::nStyle == 1
      @ 10, 10 GET ::xControl VAR ::cText MEMO OF ::xDlg PIXEL ;
         SIZE nDlgWidth  - nFontSize, nDlgHeight - nFontSize FONT oFont 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)

   ACTIVATE DIALOG ::xDlg CENTERED
      //ON INIT ( (Self), guistatusBarCreate( ::xDlg, @xStatusbar, "" ) )

   RETURN Nil

METHOD ShowText( cText ) CLASS DlgTextMsgClass

   LOCAL cItem

   IF ::nStyle == 1
      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
      ::xControl:VarPut( ::cText )
      ::xControl:Refresh()
   ENDIF

   RETURN Nil

//STATIC FUNCTION guiStatusBarCreate( xDlg, xStatusbar, cText )

   //DEFINE STATUSBAR xStatusBar PROMPT cText OF xDlg
   //xDlg:Refresh()

   //RETURN xStatusBar

It is a common situation on my multithread use, and it is expected:
if close dialog and close application, routine continues until the end, but with no display.
I will make tests using xbrowse too.

GET have option to change color when disabled, but it does not works with GET MEMO
How to prevent user do not close dialog ?
how to redisplay dialog if needed (if not minimized)?

Only comment, no problem:

This works using gtwvg

Code: Select all | Expand

oVar := DlgTextMsgClass():New()
hb_ThreadStart( { || oVar:Execute() } )

This works using fivewin

Code: Select all | Expand

hb_ThreadStart( { || oVar := DlgTextMsgClass():New(), oVar:Execute() } )

May be because Windows API is per thread, and it is needed create and use on same thread, or anything else.
But it works with the change.
oVar is a local variable.

[JoséQuintas]

Text scroll using xbrowse.

I know about INIT, but use multithread on test.
And can debug it using harbour debug.

Code: Select all | Expand

#include "fivewin.ch"

PROCEDURE ze_fwTextMsg

   LOCAL oVar, nCont // , oDialog

   hb_ThreadStart( { || oVar := DlgTextMsgClass():New(), oVar:Execute() } )
   Inkey(2)
   FOR nCont = 1 TO 50
      oVar:ShowText( "Test " + Ltrim( Str( nCont ) ) )
      Inkey(1)
   NEXT
   oVar:lCanClose := .T.
   oVar:End()

   RETURN

CREATE CLASS DlgTextMsgClass

   VAR xDlg
   VAR xControl
   VAR cText
   VAR aText     INIT { "." }
   VAR nMaxRow   INIT 10
   VAR nStyle    INIT 2
   VAR lCanClose INIT .F.

   METHOD Execute()
   METHOD ShowText( cText )
   METHOD End() INLINE ::xDlg:End()

   ENDCLASS

METHOD Execute() CLASS DlgTextMsgClass

   LOCAL nDlgWidth, nDlgHeight, oFont // xStatusbar,
   LOCAL nFontSize, xControl, oCol

   nDlgWidth  := AppWindowInfo()[1]
   nDlgHeight := AppWindowInfo()[2]
   nFontSize  := Int( AppWindowInfo()[ 3 ] * 0.8 )
   ::nMaxRow  := Int( nDlgHeight / ( nFontSize + 2 ) - 2 )

   DEFINE FONT oFont NAME "ARIAL" SIZE 0, -nFontSize
   DEFINE DIALOG ::xDlg FROM 0, 0 TO nDlgHeight, nDlgWidth PIXEL ;
      FONT oFont ;
      TITLE "TextScroll" // COLOR COLOR_WHITE, CLR_JPA
   ::xDlg:SetIcon( TIcon():New(,,"APPICON" ) )
   ::xDlg:bValid := { || ::lCanClose }

   IF ::nStyle == 1
      @ 10, 10 GET xControl VAR ::cText MEMO OF ::xDlg PIXEL ;
         SIZE nDlgWidth  - nFontSize, nDlgHeight - nFontSize FONT oFont 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  - nFontSize, nDlgHeight - nFontSize FONT oFont 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()
      ::xControl := 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
      ::xControl:VarPut( ::cText )
      ::xControl:Refresh()
   ENDIF
   IF ::nStyle == 2
      ::xControl:SetArray( ::aText )
      ::xControl:nArrayAt := Len( ::aText )
      ::xControl:Refresh()
   ENDIF

   RETURN Nil

//STATIC FUNCTION guiStatusBarCreate( xDlg, xStatusbar, cText )

   //DEFINE STATUSBAR xStatusBar PROMPT cText OF xDlg
   //xDlg:Refresh()

   //RETURN xStatusBar

Note:
Image is the application, a unique EXE.
menu is a thread.
dialog fivewin is a thread.
Update of dialog/xbrowse is another thread, this is the thread paused by debug.
No other thread is paused, I can use all application without close debug.

[JoséQuintas]

Code: Select all | Expand

#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

This is a proposital error.

Code: Select all | Expand

   ? oDlgMsg / 3 // force error

To test this:

Code: Select all | Expand

   bOldError := ErrorBlock()
   ErrorBlock( { | e |  oDlgMsg:lCanClose := .T., oDlgMsg:End(), iif( bOldError == Nil, Nil, Eval( bOldError, e ) ) } )

(1) module thread
(2) fivewin dialog thread

Error on (1) need to close (2). New errorblock only add commands to current errorblock.
if do not do this, need to close dialog on taskbar manager when error occurs on module.
Any other thread remains open.

At momment are tests only, testing possibilities.

Note: Not sure if xbrowse could use anything like this to test user codeblocks.