FiveTech Support Forums

function MsgMeter( bAction, cMsg, cTitle )

   local oDlg, oMeter, oText, oBtn, oFont
   local lEnd := .f., lCancel := .f.
   local nVal := 0

   DEFAULT bAction := { || nil },;
           cMsg := "Processing...", cTitle := "Please, wait"

   DEFINE FONT oFont NAME GetSysFont() SIZE 0, -8

   DEFINE DIALOG oDlg FROM 5, 5 TO 13, 45 TITLE cTitle FONT oFont
   oDlg:lTruePixel := .f.

   @ 0.2, 0.5  SAY oText VAR cMsg SIZE 130, 10 OF oDlg

   @ 1,   0.5  METER oMeter VAR nVal TOTAL 10 SIZE 150, 10 OF oDlg

   @  2.2,  10.4  BUTTON oBtn PROMPT "&Cancel" OF oDlg ;
      ACTION ( lEnd:= .t., lCancel:= .t. ) SIZE 32, 11

   // This block gets evaluated only the first time the DialogBox is painted !!!
   oDlg:bStart = { || Eval( bAction, oMeter, oText, oDlg, @lEnd, oBtn ),;
                      lEnd := .t., oDlg:End() }

   ACTIVATE DIALOG oDlg CENTERED ;
      VALID lEnd

   oFont:End()

return lCancel

#Include "FiveWin.ch"

#Define CLR_AMARELO   nRGB( 255, 255, 000 ) //--> Amarelo Para o Fundo
#Define CLR_VERMELHO  nRGB( 255, 000, 000 ) //--> Vermelho Para a Letra

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

Function MsgMeter( bAction, cMsg, cTitle )

   LOCAL oDlg, oMeter, oText, oBtn, oFont
   LOCAL lEnd := .F., lCancel := .F.
   LOCAL nVal := 0
   LOCAL oBrush

   DEFAULT bAction := { || NIL },;
           cMsg := "Processamento Demorado...",                               ;
           cTitle := "Por Favor, Espere! Processamento Demorado..."

   DEFINE FONT oFont NAME GetSysFont() SIZE 0, -9

   DEFINE BRUSH oBrush    RESOURCE "LOGO2" //-> PEGA A BITMAP DO ARQUIVO.RES(LOGO.BMP)

   DEFINE DIALOG oDlg FROM 5, 5 TO 14, 45 TITLE cTitle FONT oFont             ;
          STYLE nOR( DS_MODALFRAME )                                          ;
          BRUSH oBrush TRANSPARENT

   oDlg:lHelpIcon := .F.

   @ 0.1, 0.9  SAY oText VAR cMsg SIZE 150, 10 OF oDlg                        ;
               COLORS CLR_BLACK, CLR_WHITE

   @ 1,   0.5  METER oMeter VAR nVal TOTAL 10 SIZE 150, 10 OF oDlg            ;
               COLORS  CLR_BLACK, CLR_WHITE

   @  2.2, 10.4 BUTTON oBtn PROMPT "&Saida"   OF oDlg                         ;
                ACTION ( lEnd := .T., lCancel := .T., oDlg:End() )            ;
                SIZE 32, 11                                                   ;
                CANCEL UPDATE

   // This block gets evaluated only the first time the DialogBox is painted !!!
   oDlg:bStart = { || Eval( bAction, oMeter, oText, oDlg, @lEnd, oBtn ),;
                      lEnd := .T., oDlg:End() }

   /* // SE EU QUISER COLOCAR UM .GIF no MesgMeter()
   oDlg:bStart = { || oAnimate:=TGif():New( oDlg, ".\Clip1.gif", 1,oDlg:nLeft() ),;     //Ponle el gif que prefieras
                      Eval( bAction, oMeter, oText, oDlg, @lEnd, oBtn ),;
                      lEnd := .t., oDlg:End() }
   */

   ACTIVATE DIALOG oDlg CENTERED ;
            VALID( lEnd )

   oFont:End()
   oBrush:End()

Return( lCancel )

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

Static Function MsgDate( dDate, cPrompt, oGet )

   local oDlg, oFont, oCursor, dSelect
   local nRow, nCol, nMonth
   local cOldMode := Set( _SET_DATEFORMAT,;
                          If( __SetCentury(), "dd/mm/yyyy", "dd/mm/yy" ) )

   DEFAULT dDate := Date(), cPrompt := "Select a date"

   nMonth  = Month( dDate )
   dSelect = dDate

   DEFINE FONT oFont NAME GetSysFont() SIZE 0, -8
   DEFINE CURSOR oCursor HAND

   DEFINE DIALOG oDlg SIZE 200, 190 TITLE cPrompt FONT oFont // -> 6 weeks

   @ 0, 2 SAY dDateToString( dDate ) COLOR CLR_HBLUE

   aTail( oDlg:aControls ):Cargo := "DATE"

   dDate -= Day( dDate ) - 1
   while DoW( dDate ) != 2 // Monday
      dDate --
   enddo

   @ 0.8, 0 SAY "  " + SubStr( CDow( dDate ), 1, 3 ) + "   " + ;
                       SubStr( CDow( dDate + 1 ), 1, 3 ) + "   " + ;
                       SubStr( CDow( dDate + 2 ), 1, 3 ) + "   " + ;
                       SubStr( CDow( dDate + 3 ), 1, 3 ) + "   " + ;
                       SubStr( CDow( dDate + 4 ), 1, 3 ) + "   " + ;
                       SubStr( CDow( dDate + 5 ), 1, 3 ) + "   " + ;
                       SubStr( CDow( dDate + 6 ), 1, 3 ) COLOR CLR_HRED

   for nRow = 2 to 7
      for nCol = 1 to 7

         @ nRow * 10, ( nCol * 14 ) - 12 BTNBMP ;
             PROMPT Str( Day( dDate ), 2 ) SIZE 12, 10 NOBORDER ;
             ACTION ( dDate := ::Cargo, oDlg:End( IDOK ) )

         ATail( oDlg:aControls ):Cargo   = dDate
         ATail( oDlg:aControls ):oCursor = oCursor
         ATail( oDlg:aControls ):nClrText = If( dDate == Date(), CLR_HBLUE,;
                 If( dDate == dSelect, CLR_HBLUE, If( Month( dDate ) == nMonth,;
                 CLR_BLACK, CLR_GRAY ) ) )

         if ATail( oDlg:aControls ):Cargo == dSelect
            ATail( oDlg:aControls ):lPressed = .t.
            ATail( oDlg:aControls ):cToolTip = "Selected"
         endif
         if ATail( oDlg:aControls ):Cargo == Date()
            ATail( oDlg:aControls ):cToolTip = "Today"
         endif

         dDate++
      next
   next

   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT oDlg:SetMenu( BuildMenu( oDlg, { | d | dDate := d } ) )

   if oGet != NIL
      oGet:VarPut( If( oDlg:nResult == IDOK, dDate, dSelect ) )
      oGet:Refresh()
   endif

   Set( _SET_DATEFORMAT, cOldMode )

Return If( oDlg:nResult == IDOK, dDate, dSelect )

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

Static Function MoveCalendar( oDlg, nModo )

   local dSelect := Date()
   local n
   local nFirstButton := 0
   local nLastButton  := 0
   local nDate       := 0
   local nDay, nMonth, nYear, nNewDay
   local dDate
   local nDias := 0

   for n := 1 TO Len( oDlg:aControls )
      if oDlg:aControls[ n ]:ClassName() == "TBTNBMP"
         nFirstButton := If( nFirstButton == 0, n, nFirstButton )
         nLastButton  := n
         if oDlg:aControls[ n ]:lPressed
            dSelect := oDlg:aControls[ n ]:Cargo
            oDlg:aControls[ n ]:lPressed := .F.
         endif
      endif
      if oDlg:aControls[ n ]:Cargo != NIL .AND. ;
         ValType( oDlg:aControls[ n ]:Cargo ) == "C" .AND. ;
         oDlg:aControls[ n ]:Cargo == "DATE"
         nDate := n
      endif
   next n

   if nModo == 5 // Add days
      MsgGet( "Days", "Add: ", @nDias )
      dSelect += nDias
   elseif nModo == 6
      MsgGet( "Days", "Sub: ", @nDias )
      dSelect -= nDias
   endif

   nDay   := Day( dSelect )
   nMonth := Month( dSelect )
   nYear  := Year( dSelect )

   do case
      case nModo == 1 // Prev month
         nMonth := If( nMonth == 1, ( nYear --, 1 ), nMonth - 1 )
      case nModo == 2 // Next month
         nMonth := If( nMonth == 12, ( nYear ++, 1 ), nMonth + 1 )
         if nMonth < 12
             if ( nNewDay := Day( CToD( "01/" + Str( nMonth + 1 ) + "/" + ;
                Str( nYear ) ) - 1 ) ) < nDay
                nDay = nNewDay
            endif
         endif
      case nModo == 3 // prev year
         nYear --
      case nModo == 4 // next year
         nYear ++
   endcase

   dSelect := CToD( Str( nDay ) + "/" + Str( nMonth ) + "/" + Str( nYear ) )

   oDlg:aControls[ nDate ]:bGet := { || dDateToString( dSelect ) }

   dDate := dSelect
   dDate -= Day( dDate ) - 1
   while DoW( dDate ) != 2 // Monday
      dDate --
   enddo

   for n := nFirstButton TO nLastButton
      oDlg:aControls[ n ]:SetText( Str( Day( dDate ), 2 ) )

      oDlg:aControls[ n ]:Cargo   = dDate
      oDlg:aControls[ n ]:nClrText = If( dDate == Date(), CLR_HRED,;
                 If( dDate == dSelect, CLR_HBLUE, If( Month( dDate ) == nMonth,;
                 CLR_BLACK, CLR_GRAY ) ) )

      if oDlg:aControls[ n ]:Cargo == dSelect
         oDlg:aControls[ n ]:lPressed = .t.
         oDlg:aControls[ n ]:cToolTip = "Today"
      endif
      dDate++
   next n

   for n := 1 TO Len( oDlg:aControls )
      oDlg:aControls[ n ]:Refresh()
   next n

Return NIL

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

Static Function dDateToString( dDate )

   local cSay := CDoW( dDate ) + ", " + ;
                   Str( Day( dDate ), 2 ) + " " + ;
                   CMonth( dDate ) + " " + ;
                   Str( Year( dDate ), 4 )

Return cSay

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

Static Function BuildMenu( oDlg, bDate )

   local oMenu

   MENU oMenu
      MENUITEM "&Today"   ACTION Eval( bDate, Date() ), oDlg:End( IDOK )
      MENUITEM "&Prev"
      MENU
         MENUITEM "&Month" ACTION MoveCalendar( oDlg, 1 )
         MENUITEM "&Year"  ACTION MoveCalendar( oDlg, 3 )
      ENDMENU
      MENUITEM "&Next"
      MENU
         MENUITEM "&Month"  ACTION MoveCalendar( oDlg, 2 )
         MENUITEM "&Year"  ACTION MoveCalendar( oDlg, 4 )
      ENDMENU
      MENUITEM "+/-"
      MENU
         MENUITEM "&Add days"  ACTION MoveCalendar( oDlg, 5 )
         MENUITEM "&Sub days" ACTION MoveCalendar( oDlg, 6 )
      ENDMENU
      MENUITEM "&Ok"   ACTION oDlg:End()
   ENDMENU

Return oMenu

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

Static Function MsgGet( cTitle, cText, uVar )

   local oDlg, oFont
   local uTemp := uVar
   local lOk   := .f.

   DEFAULT cText := ""

   DEFINE FONT oFont NAME GetSysFont() SIZE 0, -12

   DEFINE DIALOG oDlg SIZE 112, 52 TITLE cTitle FONT oFont

   oDlg:nStyle := nOr( DS_MODALFRAME, WS_POPUP )

   @  2, 5 SAY cText OF oDlg SIZE 29,  8 PIXEL
   @ 12, 5 GET uTemp OF oDlg SIZE 25, 11 PIXEL RIGHT

   @ 12, 36 BUTTON "&Ok" OF oDlg SIZE 15, 10 ;
            ACTION ( oDlg:End(), lOk := .t. ) DEFAULT PIXEL

   ACTIVATE DIALOG oDlg CENTERED

   if lOk
      uVar := uTemp
   endif

Return lOk

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