Code: Select all | Expand

#include "fivewin.ch"

function Main()

   local o

#ifdef __XHARBOUR__
   EXTEND CLASS TestClass WITH MESSAGE Multiply  METHOD Multiply
#else
   __CLSADDMSG( TestClass():classH, "Multiply", HB_FUNCPTR( "MULTIPLY" ), HB_OO_MSG_METHOD )
#endif


   o  := TestClass():New()
   ? o:Value
   ? o:Multiply( 10 )


return nil

CLASS TestClass

   VAR Value INIT 9

ENDCLASS

function Multiply( n )

   local Self := HB_QSelf()

return ::Value * n

Code: Select all | Expand

//----------------------------------------------------------------------------//
#include "Fivewin.ch"
//----------------------------------------------------------------------------//

Static oFontMnu

Function Main()

   local oWnd

   DEFINE FONT oFontMnu NAME "Segoe UI Symbol" SIZE 0, -14

   DEFINE WINDOW oWnd TITLE "Test Menu MultiColumn: " ; // MENU MenuDatabase() ;
      FROM 20, 40 TO 650, 1200 PIXEL

   oWnd:bRClicked  := { | nR, nC | MyPopMnu( oWnd, nR, nC ) }

   ACTIVATE WINDOW oWnd // ON INIT MenuDatabase( .F., .T., , ) MAXIMIZED

Return nil

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

Function MyPopMnu( oWnd, nR, nC )

   local oPop
   // local fld := { 1, 2 }

   MENU oPop 2013 POPUP FONT oFontMnu ;
         COLORMENU METRO_STEEL, CLR_WHITE ;
         COLORLEFT CLR_WHITE, METRO_STEEL ;
         COLORRIGHT CLR_WHITE, METRO_STEEL ;
         COLORSELECT CLR_WHITE, CLR_WHITE, CLR_BLUE ;
         COLORSEPARATOR CLR_RED ;
         COLORBOX CLR_WHITE

   // MENU oPop POPUP 2015   //;       COLUMNS fld 
      MENUITEM "Array"   // oCl // PROMPT {"one", "two"}
      MENU SELECT { { "one1", "two1" }, { "one2", "two2" } }  COLUMNS 2, 1 HEADERS "Col-1", "Col-2"
      ENDMENU
   ENDMENU
   ACTIVATE MENU oPop  AT nR, nC OF oWnd

Return oPop

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

Code: Select all | Expand

WITH OBJECT xBrowse
   :bGoTop := { || :oRs:MoveFirst() } // internal may fail, not defined main object on codeblock
   :bGoTop := { || xBrowse:oRs:MoveFirst() } // internal ok, main object on codeblock is defined
   :bGoTop := { || oRs:MoveFirst() } // external ok, main object on codeblock is defined
ENDWITH

Code: Select all | Expand

  Function MyColors( oBrw )
        local aColors := { , }

       If (cust->resstatus = "###Cancelled" .and. cust->BOOKINGOK = " ")
           aColors := { CLR_BLACK, CLR_STORNO }
       else
          if ((cust->resstatus = "Waitlisted" .or. cust->resstatus = "Reserved"  ).and. cust->BOOKINGOK = " ")
              aColors := {CLR_BLACK,  CLR_BUCHUNG}    
          else
             aColors  := { CLR_BLACK,CLR_WHITE }
       	  endif
       endif

   Return aColors

//-----------------------
  Function MyColors_Focus( oBrw )
        local aColors := { , }
	
				
       If (cust->resstatus = "###Cancelled" .and. cust->BOOKINGOK = " ")
           aColors := { CLR_WHITE, CLR_STORNO_FOKUS }
       else
          if ((cust->resstatus = "Waitlisted" .or. cust->resstatus = "Reserved"  ).and. cust->BOOKINGOK = " ")
              aColors := {CLR_WHITE,  CLR_BUCHUNG_FOKUS}    
          else
             aColors  := { CLR_BLACK,CLR_WHITE }
        endif
       endif
    Return aColors

Code: Select all | Expand

   WITH OBJECT oBrw
      :MakeTotals()
      :lFooter          := .T.
      :l2007            := .f.
      :lRecordSelector  := .F.
      :nMarqueeStyle    := MARQSTYLE_HIGHLROW
      :bClrStd          :=  { || MyColors( oBrw ) } 			//{ || { CLR_GREEN,  CLR_WHITE } }
      :bClrSelFocus     :=  { || MyColors_Focus( oBrw ) }	//{ CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
      :bClrSel          :=  { || MyColors_Focus( oBrw ) }	//{ CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
      :SetColor( CLR_BLUE, CLR_WHITE)		//@IA 20200819
      :nRowHeight       := 80
     // :oFont						:= oFntFocus
      
    
      :CreateFromCode()
   END
//------------

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

    local oChat := TOLlama():New( "deepseek-r1:32b" )

    oChat:Send( "tell me the meaning of life" )
    ? oChat:GetValue()

    oChat:End()

return nil

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

    local oChat := TOLlama():New( "deepseek-r1:32b" )
    local cPrompt

    TEXT INTO cPrompt
Create journal entries in the format: Account, Counteraccount, Description, Net Amount, VAT Rate

Used accounts (SKR03 as base):

1400 - Accounts receivable from goods and services (Debtor) 8400 - Sales of goods (20%/10% VAT) 4800 - VAT (20%) 2500 - Input VAT (10%) 5000 - Goods receipt (for credit notes) Positions:

Laptop Computer - 1 unit, €1273, 20% VAT Return of book “Advanced Computing” - -1 unit, €3.96, 10% VAT Book “Computing for Dummies” - 2 units, €2.48, 10% VAT Return of IBM 5150 Desktop - -1 unit, €25, 0% VAT Network cables - 250 units, €0.75, 20% VAT
If specific accounts are missing, a list of required additions should be output.'    
   ENDTEXT

    oChat:Send( cPrompt )
    fw_memoEdit( oChat:GetValue() )

    oChat:End()

return nil    

Code: Select all | Expand

#include "FiveWin.ch"

static oChat, oOutput
static nStartTime, nTokenCount

function Main()

   local oDlg, cOutput := "", oBtn, oFont
   local oPrompt, cPrompt := Space( 100 )
   
   oChat = TOLlama():New( "deepseek-r1:32b" )
   FW_SetUnicode( .T. )
   
   DEFINE FONT oFont NAME "system-ui" SIZE 0, -16 BOLD

   DEFINE DIALOG oDlg TITLE "Ollama DeepSeek" SIZE 1200, 600

   @ 5.5, 0.7 GET oOutput VAR cOutput MULTILINE SIZE 590, 200 READONLY FONT oFont

   @ 18.7, 1 SAY "Prompt:" 
   @ 21.5, 4 GET oPrompt VAR cPrompt SIZE 510, 15 
   @ 15.5, 92 BUTTON oBtn PROMPT "Send" SIZE 40, 15 ACTION SendPrompt( cPrompt, oOutput, oBtn, oPrompt ) DEFAULT
   
   ACTIVATE DIALOG oDlg CENTERED

   oChat:End()
   oFont:End()

return nil

function SendPrompt( cPrompt, oOutput, oBtn, oPrompt )

   local cToken

   nStartTime = Seconds()  
   nTokenCount = 0  

   oBtn:Disable()
   oChat:SendStream( AllTrim( cPrompt ), { | cBuffer | ShowTokens( cBuffer ) } )
   ShowTokenStats()
   oBtn:Enable()
   oPrompt:SetFocus()
    
return nil    

function ShowTokens( cBuffer )

    local hResponse := hb_jsonDecode( cBuffer )

    oOutput:Append( hResponse[ "message" ][ "content" ] )
    nTokenCount++
    SysRefresh()

return nil    

function ShowTokenStats()

    local nElapsedTime := Seconds() - nStartTime
    local nTokensPerSecond := iif(nElapsedTime > 0, nTokenCount / nElapsedTime, 0)
 
    oOutput:Append( StrTran( "Tokens por segundo: " + Str( nTokensPerSecond, 10, 2 ), ".", "," ) )
    SysRefresh()
 
 return nil

Code: Select all | Expand

#include "Fivewin.ch"

FUNCTION MAIN()
        LOCAL   oWnd, oBtn1, oBtn2

        DEFINE WINDOW oWnd TITLE "TEST" COLOR "N/W" FROM 10, 10 TO 30, 70 VSCROLL

        @ 8, 10 BUTTON oBtn1 PROMPT "GO ON" SIZE 50, 20 ACTION ShowScrollBar( oWnd:hWnd, .T. ) OF oWnd
        
        @ 8, 20 BUTTON oBtn2 PROMPT "GO OFF" SIZE 50, 20 ACTION ShowScrollBar( oWnd:hWnd, .F. ) OF oWnd

        ACTIVATE WINDOW oWnd
RETURN NIL

#pragma BEGINDUMP

#include <windows.h>
#include <winioctl.h>
#include <stdio.h>
#include <shlobj.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapifs.h"
#include "hbvm.h"
#include "hbstack.h"

HB_FUNC( SHOWSCROLLBAR )

{
        ShowScrollBar( (HWND)hb_parnl( 1 ), SB_VERT, hb_parl( 2 ) ) ;
}

#pragma ENDDUMP

Code: Select all | Expand

   vwirts@ig.com.br

Code: Select all | Expand

mailto:  vwirts@terra.com.br

Code: Select all | Expand

oRs := oBD:Query("SELECT field1,field2,field3,Concat(field1,field2) AS chave FROM tablecust ORDER BY chave
oRs:Seek( vGet1+vGet2 )

Code: Select all | Expand

#include "FiveWin.ch"
#include "Constant.ch"

 #define DLG_nColorDlg     RGB(245,245,235)
 #define DLG_nColortitle1  RGB(219,230,244)
 #define DLG_nColortitle2  RGB(207,221,239)
 #define DLG_nColorBar1    RGB(250,250,245)
 #define DLG_nColorBar2    RGB(245,245,235)
 #define DLG_nColorBtn1    RGB(245,245,235)
 #define DLG_nColorBtn2    RGB(250,250,245)
 #define DLG_nColorBtnB    RGB(195,195,185)


Function test()
 local oDlg
 local aGet:=array(2)
  local oSay:=array(2)
 local oBtnSel:= array(2)
 local cCodEmail:=space(30)
 local cCodEmailPec:=space(30)
 local cMailName:=""

 local nRow:=10,nCol:=10
 local nInterlinea:= 30
 local nSizeHGet:= 24

   local nBottom:= 20
   local nRight := 100
   local nHt    := nBottom * DLG_CHARPIX_H
   local nWd    := Max( nRight * DLG_CHARPIX_W, 180 )
   local oCursorBtn :=TCursor():New(,'HAND')

   local  oFont := TFont():New("Tahoma", 0, 18, , )
   local  oBold := TFont():New("Tahoma", 0, 16, , .t.)


DEFINE DIALOG oDlg SIZE nWd, nHt PIXEL TRUEPIXEL ;
       FONT oFont  TiTle "Account Invio" COLOR CLR_BLACK, DLG_nColorDlg  ;
       STYLE nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, ;
                  WS_MINIMIZEBOX)

    @ nRow, 320 SAY oSay[1] PROMPT  "email" SIZE 100,25  PIXEL OF oDlg TRANSPARENT  FONT oFont
    @ nRow, 420 GET aGet[1] VAR cCodEmail SIZE 160,nSizeHGet PIXEL OF oDlg;
    ON CHANGE ( oDlg:AEvalWhen(), oDlg:Update() )

   @  nRow, oDlg:nWidth-148  BTNBMP oBtnSel[1] ;
      PROMPT "Account Invio" LEFT                 ;
      RESOURCE "SEL_PIE", "", "SEL_VUO", "" ;
      SIZE 130, nSizeHGet PIXEL FLAT NOROUND GDIP  OF oDlg ;
      WHEN ValidaEmail( cCodEmail )  UPDATE  ;
      ACTION  Account_Invio_Email()

                        /*  ACTION (Account_Invio_Email(), ;
                        IIF(  !empty(cMailName),;
                        oBtnSel[2]:SETFILE("SEL_PIE"),;
                        oBtnSel[2]:SETFILE("SEL_VUO") ) ) ; */

    nRow+=nInterlinea
   @ nRow, 320 SAY oSay[2] PROMPT  "email PEC" SIZE 100,25  PIXEL OF oDlg TRANSPARENT  FONT oFont
   @ nRow, 420 GET aGet[2] VAR cCodEmailPec SIZE 160,nSizeHGet PIXEL OF oDlg;
                     ON CHANGE ( oDlg:AEvalWhen(), oDlg:Update() )



   @  nRow, oDlg:nWidth-148  BTNBMP oBtnSel[2] ;
      PROMPT "Account Invio" LEFT                 ;
      RESOURCE "SEL_PIE", "", "SEL_VUO", "" ;
      SIZE 130, nSizeHGet PIXEL FLAT NOROUND GDIP  OF oDlg ;
      WHEN ValidaEmail( cCodEmailPec )  UPDATE  ;
      ACTION Account_Invio_Email()




            /*  ACTION (Account_Invio_Email(), ;
                        IIF(  !empty(cMailName),;
                        oBtnSel[2]:SETFILE("SEL_PIE"),;
                        oBtnSel[2]:SETFILE("SEL_VUO") ) ) ; */





                For n= 1 to 2
             oBtnSel[n]:bClrGrad := { | lPressed | If( ! lPressed,;
                 { { 1, DLG_nColorBar1, DLG_nColorBar1} },;
                 { { 1, DLG_nColorBar2, DLG_nColorBar2} } ) }
             oBtnSel[n]:nClrBorder := DLG_nColorBtnB
             oBtnSel[n]:oCursor:=   oCursorBtn
             oBtnSel[n]:nClrFocusRect := DLG_nColorBar2
             oBtnSel[n]:nDeepFocusRect := 0
             next

             ACTIVATE DIALOG oDlg CENTERED


RETURN NIL

function validaEmail(cEmail) //Nageswarao
   static preCompiled
   DEFAULT preCompiled := hb_regexComp("^[_a-z0-9-]+(\.[_a-z0-9-]+)*@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,4})$")
      return !Empty( hb_regex( preCompiled, alltrim( cEmail ) ) )

function  Account_Invio_Email ()
            Msginfo("Email")
   return nil

Code: Select all | Expand

FUNCTION Marc_SETFILTER( oBrw ) 

   LOCAL cFilter := ""
   LOCAL n, oCol, uVal, cType, cVal1, cVal2, nGevonden
   LOCAL nZoekKnop, cExprt
   LOCAL cAlias:= alias()
   FOR n := 1 TO Len( oBrw:aCols )
      oCol  := oBrw:aCols[ n ]
      IF ! Empty( uVal := oCol:uBarGetVal )
         IF !Empty( cFilter )
            cFilter  += " .AND. "
         ENDIF
         cType    := ValType( uVal )
         if cType = "C"
           nGevonden = at("++",uVal)  //  I do this for multiple search in 1 go
         endif
         if cType = "C"
           nZoekKnop = at("²",uVal)  //  To force a extra key to activated the search in browse
         endif

         DO CASE
          CASE cType == 'C' .and. nZoekKnop > 0  
            uVal     := Upper( AllTrim( uVal ) )
            cVal1 = substr(uVal,1,nZoekknop-2)
            cFilter += '"' + cVal1 + '" $ UPPER( ' + oCol:CExpr + " )"
          CASE cType == 'C' .and. nGevonden > 0
            uVal     := Upper( AllTrim( uVal ) )
            cVal1 = substr(uVal,1,nGevonden-1)
            cVal2 = substr(uVal,nGevonden+2)

            cFilter += '"' + cVal1 + '" $ UPPER( ' + oCol:CExpr + " )"
            cFilter += " .AND. "
            cFilter += '"' + cVal2 + '" $ UPPER( ' + oCol:CExpr + " )"
         CASE cType == 'C'
            uVal     := Upper( AllTrim( uVal ) )
            cFilter += '"' + uVal + '" $ UPPER( ' + oCol:CExpr + " )"
         CASE cType == 'D'
            cFilter  += oCol:cExpr + " = " + ( uVal )
         OTHERWISE
            cFilter  += oCol:cExpr + " == " + cValToChar( uVal )
         ENDCASE
      ENDIF
   NEXT
   IF Empty( cFilter )
      IF ! Empty( dbFilter() )
         dbClearFilter()
         oBrw:Refresh()
      ENDIF
   ELSE

      IF !( dbFilter() == cFilter )
         oClp:SetText(cFilter)  // For personel creating of Indexes to use more times
         if !empty(cAlias)
           SET FILTER TO &cFilter
           oClp:SetText(cFilter)
           GO TOP
         else
           msginfo("Error.... Geen Alias beschikbaar")
         endif

         oBrw:Refresh()
      ENDIF

   ENDIF
   oBrw:maketotals() 
   oBrw:SetFocus()
RETURN NIL

Code: Select all | Expand

PROCEDURE CreateURLShortcut(cFileName, cURL)
   LOCAL hFile

   // Ensure the filename ends with .url
   IF AT(".url", LOWER(cFileName)) == 0
      cFileName += ".url"
   ENDIF

   // Create and write to the file
   hFile := FCreate(cFileName)
   IF hFile != -1
      FWrite(hFile, "[InternetShortcut]" + Chr(13) + Chr(10))
      FWrite(hFile, "URL=" + cURL + Chr(13) + Chr(10))
      FClose(hFile)
   ELSE
      ? "Error creating file:", cFileName
   ENDIF
RETURN

// Usage:
CreateURLShortcut("MyWebShortcut.url", "https://www.example.com")

Code: Select all | Expand

PROCEDURE CreateLNKShortcut(cLnkPath, cURL)
   LOCAL oShell, oShortcut

   // Initialize COM (if not already done)
   IF !Empty(GetActiveObject("WScript.Shell"))
      oShell := CreateObject("WScript.Shell")
   ELSE
      ? "COM initialization failed."
      RETURN
   ENDIF

   // Create the shortcut
   oShortcut := oShell:CreateShortcut(cLnkPath)
   oShortcut:TargetPath := "rundll32.exe"
   oShortcut:Arguments := "url.dll,FileProtocolHandler " + cURL
   oShortcut:Save()
RETURN

// Usage:
CreateLNKShortcut("MyWebShortcut.lnk", "https://www.example.com")

Code: Select all | Expand

 
#include "FiveWin.ch"



request dbfcdx
request dbffpt

request hb_lang_it
request hb_codepage_itwin



 function Main()
    local nRow:= 10,nCol:= 2
    local nInterlinea:= 40
    local oWnd

       RddSetDefault( "DBFCDX" )
       HB_LANGSELECT( "IT" )
       HB_SETCODEPAGE( "ITWIN" )
       SetHandleCount( 100 )
       FWNumFormat( "E", .t. )

       SET DATE FORMAT "dd-mm-yyyy"
       SET DELETED     ON
       SET CENTURY     ON
       SET EPOCH TO    year( date() ) - 20
       SET MULTIPLE    OFF
       SetGetColorFocus(nRGB( 203, 225, 252 ))
       SetMGetColorFocus(nRGB( 203, 225, 252 ))

         test()

         return nil


Function test()
local cUser

cUser:="silvio"

? Calcola_TempoAccesso(cUser)

return nil


Function Calcola_TempoAccesso(cUser)
   Local oUtenti, oTabAct, cString := ""
   Local cStatus, dAccessDate, nTotalTime := 0
   Local tEntrata, tUscita
   Local nMinutes, nSeconds, nHours
   Local nArea := Select()

   tEntrata := ""
   tUscita  := ""
   nMinutes := 0
   nSeconds := 0
   nHours   := 0

   // Apri l'archivio oUtenti e controlla lo stato dell'utente
   oUtenti := TDatabase():Open( , "Utenti", "DBFCDX", .T. )
   oUtenti:SetOrder(1) // username
   oUtenti:GoTop()

   Do While !oUtenti:Eof()
      If AllTrim(oUtenti:UserName) == AllTrim(cUser)  
         cStatus := AllTrim(oUtenti:Status)
         dAccessDate := oUtenti:Fecha
         Exit
      EndIf
      oUtenti:Skip()
   EndDo

   // Se l'utente è ancora connesso, restituisci "Attualmente connesso"
   IF cStatus == "Ã"
      oUtenti:Close()
      Select (nArea)
      Return "Attualmente connesso"
   ELSE
      // Se l'utente non è connesso, calcola il tempo di accesso per quella data
      oTabAct := TDatabase():Open( , "tabact", "DBFCDX", .T. )
      oTabAct:SetOrder(2)
      oTabAct:GoTop()

      Do While !oTabAct:Eof()
         If AllTrim(oTabAct:Usuario) == AllTrim(cUser) .And. oTabAct:Fecha == dAccessDate
            If At("Entrata", AllTrim(oTabAct:Accion)) > 0
               tEntrata := AllTrim(oTabAct:Hora)  // Memorizza l'orario di entrata

               // Debug: Mostra l'orario di entrata appena letto
            *   ? "Orario di Entrata letto: ", tEntrata

               // Verifica il formato di tEntrata
               If Len(tEntrata) == 5
                  tEntrata := tEntrata + ":00"  // Aggiungi ":00" se non ci sono i secondi
               EndIf

               // Debug: Mostra l'orario di entrata dopo modifica
               * ? "Orario di Entrata dopo modifica: ", tEntrata
               logfile("silvio.txt", "Orario di Entrata dopo modifica: "+ tEntrata)

            ElseIf At("Uscita", AllTrim(oTabAct:Accion)) > 0
               tUscita := AllTrim(oTabAct:Hora)  // Memorizza l'orario di uscita
               // Debug: Mostra l'orario di uscita
              * ? "Orario di Uscita (tUscita): ", tUscita

               // Verifica il formato di tUscita
               If Len(tUscita) == 5
                  tUscita := tUscita + ":00"  // Aggiungi ":00" se non ci sono i secondi
               EndIf

               // Debug: Mostra l'orario di uscita dopo modifica

               logfile("silvio.txt", "Orario di Uscita dopo modifica: "+ tUscita)

               // Calcola la differenza in secondi
               nTotalTime += TimeDifferenceInSeconds(tEntrata, tUscita)
            EndIf
         EndIf
         oTabAct:Skip()
      EndDo

      If nTotalTime > 0
         // Converto la differenza in secondi nei formati giusti (ore, minuti, secondi)
         nHours   := Int(nTotalTime / 3600)            // Ore intere (3600 secondi in un'ora)
         nMinutes := Int((nTotalTime % 3600) / 60)    // Minuti rimanenti
         nSeconds := nTotalTime % 60                  // Secondi rimanenti

         If nHours > 0
            cString := Str(nHours, 6, 0) + " ore, " + Str(nMinutes, 2, 0) + " minuti e " + Str(nSeconds, 2, 0) + " secondi"
         ElseIf nMinutes > 0
            cString := Str(nMinutes, 6, 0) + " minuti e " + Str(nSeconds, 2, 0) + " secondi"
         Else
            cString := Str(nSeconds, 6, 0) + " secondi"
         EndIf
      Else
         cString := "Nessun dato di accesso trovato per la data " + dtoc(dAccessDate)
      EndIf

      oTabAct:Close()
   EndIf

   Select (nArea)
   oUtenti:Close()

   Return cString

   Function TimeDifferenceInSeconds(cStartTime, cEndTime)
   Local nStartHour, nStartMinute, nStartSecond
   Local nEndHour, nEndMinute, nEndSecond
   Local nStartSeconds, nEndSeconds
   Local nTimeDifference


    logfile("silvio.txt", "*Orario di Entrata : "+ cStartTime)
    logfile("silvio.txt", "*Orario di Uscita : "+ cEndTime)

   // Verifica se i parametri sono in formato stringa "hh:mm:ss"
   If Len(cStartTime) == 8 .And. Len(cEndTime) == 8
      // Estrarre ore, minuti e secondi
      nStartHour   := Val(SubStr(cStartTime, 1, 2)) // ore di inizio
      nStartMinute := Val(SubStr(cStartTime, 4, 2)) // minuti di inizio
      nStartSecond := Val(SubStr(cStartTime, 7, 2)) // secondi di inizio

      nEndHour   := Val(SubStr(cEndTime, 1, 2)) // ore di fine
      nEndMinute := Val(SubStr(cEndTime, 4, 2)) // minuti di fine
      nEndSecond := Val(SubStr(cEndTime, 7, 2)) // secondi di fine

      // Calcola i secondi totali dall'inizio della giornata
      nStartSeconds := (nStartHour * 3600) + (nStartMinute * 60) + nStartSecond
      nEndSeconds   := (nEndHour * 3600) + (nEndMinute * 60) + nEndSecond

      // Calcola la differenza in secondi
      nTimeDifference := nEndSeconds - nStartSeconds

      // Restituisci la differenza in secondi
      Return nTimeDifference
   Else
     * ? "Errore: Gli orari non sono nel formato corretto"
      Return 0
   EndIf

Code: Select all | Expand

// from cmd run: ollama serve

#include "FiveWin.ch"

static oChat, oOutput
static nStartTime, nTokenCount

function Main()

   local oDlg, cOutput := "", oBtn, oFont
   local oPrompt, cPrompt := Space( 100 )
   
   oChat = TOLlama():New( "phi4" ) 
   FW_SetUnicode( .T. )
   
   DEFINE FONT oFont NAME "system-ui" SIZE 0, -16 BOLD

   DEFINE DIALOG oDlg TITLE "Ollama Phi4" SIZE 1200, 600

   @ 5.5, 0.7 GET oOutput VAR cOutput MULTILINE SIZE 590, 200 READONLY FONT oFont

   @ 18.7, 1 SAY "Prompt:" 
   @ 21.5, 4 GET oPrompt VAR cPrompt SIZE 510, 15 
   @ 15.5, 92 BUTTON oBtn PROMPT "Send" SIZE 40, 15 ACTION SendPrompt( cPrompt, oOutput, oBtn, oPrompt ) DEFAULT
   
   ACTIVATE DIALOG oDlg CENTERED

   oChat:End()
   oFont:End()

return nil

function SendPrompt( cPrompt, oOutput, oBtn, oPrompt )

   local cToken

   nStartTime = Seconds()  
   nTokenCount = 0  

   oBtn:Disable()
   oChat:SendStream( AllTrim( cPrompt ), { | cBuffer | ShowTokens( cBuffer ) } )
   ShowTokenStats()
   oBtn:Enable()
   oPrompt:SetFocus()
    
return nil    

function ShowTokens( cBuffer )

    local hResponse 
    
    hb_jsonDecode( cBuffer, @hResponse )

    oOutput:Append( hResponse[ "message" ][ "content" ] )
    nTokenCount++
    SysRefresh()

return nil    

function ShowTokenStats()

    local nElapsedTime := Seconds() - nStartTime
    local nTokensPerSecond := iif(nElapsedTime > 0, nTokenCount / nElapsedTime, 0)
 
    oOutput:Append( StrTran( "Tokens por segundo: " + Str( nTokensPerSecond, 10, 2 ), ".", "," ) )
    SysRefresh()
 
 return nil

Code: Select all | Expand

 DEFINE BUTTONBAR oBar OF oDlg  SIZE 100,70  TOP NOBORDER  2015

Code: Select all | Expand

Btnbar(1,oDlg:oBar,oDlg,oDbf,oBrw,aBtnBrow[4]),;

Code: Select all | Expand

 
 Error description: Error BASE/1004  Metodo non disponibile: ACONTROLS
   Args:
     [   1] = U   

Stack Calls
===========
   Called from: source\PConti.prg => ACONTROLS( 0 )
   Called from: source\PConti.prg => HIDE_RADIO2( 681 )
   
   

Code: Select all | Expand

// developed by Cristobal Navarro

#include 'fivewin.ch'
#include 'xbrowse.ch'
#include "constant.ch"

Function test()

   local oDlg,oDbf,oFont
   local oBar

   local  nBottom   := 27.2
   local  nRight    := 89
   local  nWd       := Max( nRight * DLG_CHARPIX_W, 180 )
   local  nHt       := nBottom * DLG_CHARPIX_H

   DEFINE DIALOG oDlg SIZE nWd, nHt PIXEL TRUEPIXEL;
         TiTle "test"
      oDlg:lHelpIcon := .F.      

   @ 90,  10 Button "Second bar" size 100,18 PIXEL OF oDlg action Btnbar(2,oDlg:oBar,oDlg)
   @ 90, 200 Button "First bar"  size 100,18 PIXEL OF oDlg action Btnbar(1,oDlg:oBar,oDlg)

   @ 90, 400 Button "hide/show button"  size 100,18 PIXEL OF oDlg action Hide_button(oDlg:oBar)

   ACTIVATE DIALOG oDlg  CENTER   ;
          ON INIT ( Btnbar(0,oBar,oDlg), Btnbar(1,oDlg:oBar,oDlg ))
RETURN NIL

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

Function Btnbar(nBar,oBar,oDlg)  // ,aBtnBar

   local aBtnBar
   local x

   if Valtype( oBar ) = "O"
      For x := Len( oBar:aControls ) to 1 step - 1
         oBar:Del( x )
      Next x
   endif

  Do case
  case nbar = 0
     DEFINE BUTTONBAR oBar OF oDlg  SIZE 80,70  TOP NOBORDER  2015

  case nbar = 1
   aBtnBar := array(6)
   DEFINE BUTTON aBtnBar[1] OF oBar PROMPT "New"       action msginfo()
   DEFINE BUTTON aBtnBar[2] OF oBar PROMPT "Modify"    action msginfo()
   DEFINE BUTTON aBtnBar[3] OF oBar PROMPT "Duplicate" action msginfo()
   DEFINE BUTTON aBtnBar[4] OF oBar PROMPT "Del"       action msginfo()
   DEFINE BUTTON aBtnBar[5] OF oBar PROMPT "Print"     action msginfo()
   DEFINE BUTTON aBtnBar[6] OF oBar PROMPT "Help"      action msginfo("Help")
   
              aBtnBar[6]:hide()
              
  case nbar = 2
   aBtnBar := array(2)
   DEFINE BUTTON aBtnBar[1] OF oBar PROMPT "Del"       action msginfo("Del")
   DEFINE BUTTON aBtnBar[2] OF oBar PROMPT "Print"     action msginfo("Print")

  endcase

return oBar

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


Function Hide_button(oBar)
        oBar:arcontrols[6]:show()
   return nil

Code: Select all | Expand

rror description: Error BASE/1071  Argument error: =
   Args:
     [   1] = L   .T.
     [   2] = C   .T.

Stack Calls
===========
   Called from: .\source\classes\database.prg => (b)COMPILE( 1305 )

Code: Select all | Expand

cFilter:= "MARRIED=.T."

Code: Select all | Expand

         static PNG_CONST png_uint_32 row_mask[2/*PACKSWAP*/][3/*depth*/][6] =
         {
            /* Little-endian byte masks for PACKSWAP */
            { S_MASKS(1,0), S_MASKS(2,0), S_MASKS(4,0) },  <--- LINE 3349
            /* Normal (big-endian byte) masks - PNG format */
            { S_MASKS(1,1), S_MASKS(2,1), S_MASKS(4,1) }
         };

Code: Select all | Expand

xLINK: error: Unresolved external symbol '_xCCGetLargestConsoleWindowSize referenced from gtwin.lib(gtwin.obj)'.

Code: Select all | Expand

WITH OBJECT oBrw
                    :SetMultiSelectCol()

Code: Select all | Expand

// C:\FWH\SAMPLES\MULTSEL.PRG by mister Rao.

#include "FiveWin.Ch"
#include "ord.ch"
#include "xbrowse.ch"
#include "hbcompat.ch"

REQUEST DBFCDX

FUNCTION Main()

   LOCAL oDlg, oBrw, oFont

   XbrNumFormat( 'A', .T. )

   USE CUSTOMER NEW ALIAS "CUST" SHARED VIA "DBFCDX"

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0, - 14 BOLD

   DEFINE DIALOG oDlg SIZE 700, 400 PIXEL FONT oFont

   oDlg:lHelpIcon := .F.

   @ 10, 10 XBROWSE oBrw SIZE - 10, - 10 PIXEL OF oDlg ;
      DATASOURCE "CUST"                                ;
      COLUMNS "FIRST", "CITY", "AGE", "SALARY"         ;
      CELL LINES NOBORDER

   WITH OBJECT oBrw:InsCol( 1 )

      :bEditValue    := {|| AScan( oBrw:aSelected, oBrw:BookMark ) > 0 }
      :SetCheck()
      :nHeadBmpNo    := {|| If( Len( oBrw:aSelected ) == oBrw:nLen, 1, 2 ) }

   END

   WITH OBJECT oBrw

      :nMarqueeStyle := MARQSTYLE_HIGHLROWMS // multisel does the job
      // :nMarqueeStyle := MARQSTYLE_HIGHLROW
      :lMultiSelect  := .F.
      :bClrSelFocus  := {|| { CLR_BLACK, CLR_HGRAY } }
      :nStretchCol   := 3

      :aCols[ 1 ]:bClrSelFocus := {|| {  CLR_BLACK, CLR_WHITE } }

      :bLClicked     := {| r, c, f, oBrw | If( oBrw:MouseColPos( c ) == 1, ;
         If( ( f := AScan( oBrw:aSelected, oBrw:BookMark ) ) == 0,         ;
         AAdd( oBrw:aSelected, oBrw:BookMark ),                            ;
         ADel( oBrw:aSelected, f, .T. ) ), NIL ),                          ;
         oBrw:RefreshCurrent() }

   :CreateFromCode()

   END

   ACTIVATE DIALOG oDlg CENTERED

   RELEASE FONT oFont

RETURN NIL

// FIN / END

Code: Select all | Expand

#include "FiveWin.ch"

function TestGetPic

   local oDlg, oGet
   local cGet  := "123456789012345"

   DEFINE DIALOG oDlg SIZE 200,200 PIXEL TRUEPIXEL
   @ 30,30 GET oGet VAR cGet ;
      SIZE 150,20 PIXEL OF oDlg
   @ 80,30 BUTTON "OK" SIZE 80,30 PIXEL OF oDlg ACTION (oDlg:End())

   ACTIVATE DIALOG oDlg CENTERED
   
   ? "cGet = ",cGet

return nil

Code: Select all | Expand

// C:\FWH\SAMPLES\PASTECOP.PRG

#Include "FiveWin.ch"

FUNCTION TestGetPic()

   LOCAL oDlg, oGet
   LOCAL cGet  := "123456789012345"

   DEFINE DIALOG oDlg SIZE 200, 200 PIXEL TRUEPIXEL

   oDlg:lHelpIcon := .F.
                                      // 16 digits
   @ 30, 30 GET oGet VAR cGet PICTURE "@R 999999999999999" SIZE 150, 20 ;
      RIGHT PIXEL OF oDlg

   @ 80, 60 BUTTON "OK" SIZE 80, 30 PIXEL OF oDlg ACTION ( oDlg:End() ) CANCEL

   ACTIVATE DIALOG oDlg CENTERED

   ? "cGet = ", VAL( cGet )

RETURN NIL

// FIN / END

Code: Select all | Expand

   DEFINE CLIPBOARD oClp OF oDlg FORMAT TEXT
  ...
   @ 30, 20 GET oGet VAR cGet BITMAP "..\bitmaps\paste20.bmp" SIZE 120, 22 PIXEL OF oDlg ;
            ACTION (cGet := oClp:GetText(), oGet:Refresh()) 
   ...
   oClp:Close()

Code: Select all | Expand

#!/bin/bash
cUser='admin'
cPass='Max61'
cServer='125.15.13.12'
cQuery="SELECT ut codice_cliente, rag nominativo, cf codice_fiscale, piv partita_iva FROM ute WHERE rag like '%MAX%'"
/opt/mssql-tools18/bin/sqlcmd -S $cServer -U $cUser -P $cPass -d BEG_DATI -p -Q "$cQuery" -C
exit 0

Code: Select all | Expand

#require "hbodbc"
***********************************
Function Main()

LOCAL cConnString, hDbc, hStmt, cQuery, cResult, nFetch 

REQUEST HB_LANG_IT
HB_LANGSELECT("IT")
REQUEST DBFCDX
REQUEST DBFFPT
RddRegister( "DBFCDX", 1 )
RddSetDefault("DBFCDX")
SET(_SET_AUTORDER,1)
SET AUTOPEN ON

SET DATE BRITISH
SET DELETED ON
SET CENTURY ON
SET EPOCH TO YEAR(DATE())

// Define the ODBC connection string (replace with your actual details)
cConnString := "Driver={ODBC Driver 18 for SQL Server};Server=125.15.13.12;Database=SQL_DATI;UID=admin;PWD=Max61;"

// Initialize the connection handle (hDbc) using SQLConnect
hDbc := SQLConnect( cConnString )

// Check if the connection was successful

IF hDbc == NIL
    ? "Connection failed!"
    RETURN
ENDIF
   
Return nil 

Code: Select all | Expand

/opt/mssql-tools18/bin/sqlcmd -S $cServer -U $cUser -P $cPass -d BEG_DATI -p -Q "$cQuery" -C

Code: Select all | Expand

cConnString := "Driver={ODBC Driver 18 for SQL Server};Server=125.15.13.12;Database=SQL_DATI;UID=admin;PWD=Max61;"

Code: Select all | Expand

 oBrw:Report( cTitle, , , ;
         { |oRep, oBrw| MySetUp( oRep, oBrw, oDbf,aGroup,nGroup,lEject,aCampi ) } )

Code: Select all | Expand

 
  function MySetUp( oRep, oBrw, oDbf,aGroup,nGroup,lEject,afields )
 ...
 
 oRep:oShdBrush := TBrush():New(,nRgb(219,229,241))
   oRep:bskip := { || IF(oRep:nCounter % 2 =0 , oRep:lShadow :=.F.,oRep:lShadow :=.T.) }
         AEval( oRep:aColumns, { | o | o:lShadow := ! o:lShadow } )
         
         
         .....
         

Code: Select all | Expand

CLASS MyBrowse  FROM TXBrowse
   CLASSDATA lRegistered AS LOGICAL
    DATA aBtnBrow  AS ARRAY
    METHOD New (nRow, nCol, nWidth, nHeight, oWnd)
ENDCLASS

METHOD New(nRow, nCol, nWidth, nHeight, oWnd)  CLASS MyBrowse
   ::aBtnBrow:= array(5)
   return ::Super:New()

Code: Select all | Expand

#include "fivewin.ch"
#include "constant.ch"

#define TXT_FOLDER1    " 1 folder "          
#define TXT_FOLDER2    " 2 folder "        
#define TXT_FOLDER3    " 3 folder "  
#define TXT_FOLDER4    " 4 folder "                  


Function test()
   local oDlg,oFld,Font,oBold
   local  nBottom   := 29
   local  nRight    := 60
   local  nWidth :=  Max( nRight * DLG_CHARPIX_W, 180 )
   local  nHeight := nBottom * DLG_CHARPIX_H
   local aArray := {}

 DEFINE DIALOG oDlg          ;
         SIZE nWidth, nHeight   PIXEL  ;
         TITLE "test con folder"

 @ 5, 3.5 FOLDER oFld ITEMS TXT_FOLDER1 , TXT_FOLDER2 ,TXT_FOLDER3 ,TXT_FOLDER4 ;
      SIZE oDlg:nWidth-242,oDlg:nbottom-240 PIXEL OF oDlg;
      OPTION 1

 @ 5, 2 XBROWSE  oLbx OF oFld:aDialogs[2] ;
         SIZE 150,105 PIXEL  CLASS MyBrowse()

       oLbx:SetArray(aArray)
       oLbx:CreateFromCode()

ACTIVATE DIALOG oDlg center
RETURN NIL



//-------------------------------------------------//
CLASS MyBrowse  FROM TXBrowse
   CLASSDATA lRegistered AS LOGICAL

    DATA aBtnBrow  AS ARRAY


    METHOD New (nRow, nCol, nWidth, nHeight, oWnd)


ENDCLASS

METHOD New(nRow, nCol, nWidth, nHeight, oWnd)  CLASS MyBrowse
   ::aBtnBrow:= array(5)
   return ::Super:New()

Code: Select all | Expand

@ 5, 2 XBROWSE  oLbx OF oFld:aDialogs[2] ;
         SIZE 150,105 PIXEL  CLASS MyBrowse():New (, , , , oFld:aDialogs[2])

Code: Select all | Expand

 GROUP ON Test->State ;
           FOOTER "Total State "+oReport:aGroups[1]:cValue+ ;
                  " ("+ltrim(str(oReport:aGroups[1]:nCounter))+")" ;
           FONT 2 ;
           EJECT

Code: Select all | Expand

@ 12, 10 COMBOBOX oRag[2] VAR nGroup ITEMS  aGroup  OF oDlgOptions SIZE 300, 30 PIXEL FONT oFont HEIGHTGET 16 

Code: Select all | Expand

  REPORT oReport TITLE  "*** My First Report ***"  ;
          FONT oFont1, oFont2 ;
          PREVIEW

Code: Select all | Expand

#xcommand GROUP [ <oRptGrp> ] ;
                [ ON <bGroup> ] ;
                [ HEADER <bHead> ] ;
                [ FOOTER <bFoot> ] ;
                [ FONT <uFont> ] ;
                [ <lEject:EJECT> ] ;
        => ;
        [ <oRptGrp> := ] RptAddGroup( <{bGroup}>, <{bHead}>, ;
                <{bFoot}>, <{uFont}>, <.lEject.> )

Code: Select all | Expand

     DATA oReport
     DATA aTotal
     DATA bGroup, bHeader, bFooter, bHeadFont, bFootFont
     DATA cValue, cOldValue
     DATA nCounter, nHeaderHeight, nFooterHeight, nOrder
     DATA lEject, lNeedStart, lHeader, lFooter
     DATA Cargo

Code: Select all | Expand

AAdd(oRep:aGroups,trGroup():New( bCampo2( afields, nGroup,oDbf ),; //field
{|| aGroup[nGroup]+" :"+oRep:aGroups[1]:cValue},; //header
{|| "Total "+aGroup[nGroup]+": "+oRep:aGroups[1]:cValue+" ("+ltrim(str(oRep:aGroups[1]:nCounter))+")"},; //footer
{|| 1 },; // Font
.f.,oRep))

Code: Select all | Expand

Static function bCampo2( aCampos, nFor,oDbf ) //tdatabase
return (fieldWBlock(aCampos[nFor],oDbf:nArea ))

Code: Select all | Expand

fieldname:= agroup[nselect][1]
fieldtitle:= agroup[nselect][2]

GROUP ON ::oDbf:&fieldname;
HEADER fieldtitle +"» "+::oReport:aGroups[1]:cValue ;
FOOTER fieldtitle +"» "+::oReport:aGroups[1]:cValue +;
"("+ltrim(str(::oReport:aGroups[1]:nCounter))+")" ;
FONT 1

Code: Select all | Expand

 
    If nGroup>1
         aGroupby  := {nGroup}
      elseif  nGroup==3   //none
         aGroupby  := {}
      Endif

//index the dbf
   IF  oDbf != NIL
      If nGroup >1  .and.  nGroup < 3
        oDbf:setorder(nGroup)
        oDbf:gotop()
        oBrw:oDbf:SetOrder(nGroup)
        oBrw:oDbf:Gotop()
        xbrowser oBrw:odbf
        xbrowser oDbf

     elseif  nGroup==3    //none
        oBrw:SetOrder()
      Endif
  Endif
  
  

Code: Select all | Expand

oReport:oShdBrush  := TBrush():New(,nRgb(219,229,241))
     AEval( oReport:aColumns, { | o | o:lShadow := ! o:lShadow } )
    oReport:bStartLine := { || IF(oReport:nCounter % 2 = 0 , oReport:lShadow :=.F.,oReport:lShadow :=.T.)   }

Code: Select all | Expand

 
    oRep:oShdBrush := TBrush():New(,nRgb(219,229,241))
     AEval( oRep:aColumns, { | o | o:lShadow := ! o:lShadow } )
     oRep:bStartLine := { || IF(oRep:nCounter % 2 = 0 , oRep:lShadow :=.F.,oRep:lShadow :=.T.)   }

Code: Select all | Expand

oCol := RptAddColumn( aHeader, nil ,;
                            { bData }, nSize, nil ,;
                            nil, nil, nil ,;
                            "RIGHT", .F., .F., nil, ;
                            nil, nil, ;
                            nil, nil, nil, nil, nil, ;
                            nil, nil, nil, nil, nil, nil, ;
                            nil, ;
                            XEval( oxCol:nProgTot , oxCol ), aClr )

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.

Code: Select all | Expand

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

Code: Select all | Expand

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

Code: Select all | Expand

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

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

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

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 )
...

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
   

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

Code: Select all | Expand

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

Code: Select all | Expand

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

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

Code: Select all | Expand

#include "fivewin.ch"

static oGmail, hStore

function main()

	local oDlg
	local oName, cName := ""
	local oEmail, cEmail := ""
	local oPhoto, oSend
	local oConnect, oDisconnect

	hStore := readStore( hb_dirBase() + "gmail.json" )

	oGmail := TGmail():new()

	oGmail:setConfig( {;
		"client_id" => "your_client_id",;
		"client_secret" => "your_client_secret",;
		"redirect_uri" => "http://localhost:2025/";
	} )

	if !empty( hStore[ "token" ] )
		oGmail:setToken( hStore[ "token" ] )
	endif

	define dialog oDlg resource "GMAIL"

		redefine image oPhoto id 4002 of oDlg
		redefine say oName var cName id 4003 of oDlg
		redefine say oEmail var cEmail id 4004 of oDlg

		redefine button oDisconnect id 4005 of oDlg action onDisconnect( oDlg, { oPhoto, oName, oEmail, oSend, oDisconnect }, { oConnect } )
		redefine button oSend id 4006 of oDlg action onSendMail()

		redefine button oConnect id 4001 of oDlg action onConnect( oDlg, { oPhoto, oName, oEmail, oSend, oDisconnect }, { oConnect } )

		oDlg:bStart := { || updateControls( oDlg, { oPhoto, oName, oEmail, oSend, oDisconnect }, { oConnect } ) }

		oDlg:lHelpIcon := .f.

	activate dialog oDlg centered

	saveStore( hb_dirBase() + "gmail.json", hStore )

return nil

function onConnect( oDlg, aConnect, aDisconnect )

	local cToken

	if !oGmail:isAuth()
		cToken := oGmail:auth()
		if !empty( cToken )
			hStore[ "token" ] := cToken
		else
			msgStop( "Authentication failed!" )
		endif
	endif

	updateControls( oDlg, aConnect, aDisconnect )

return nil

function onDisconnect( oDlg, aConnect, aDisconnect )

	local cProfile := hb_dirBase() + "profile_gmail.jpg"

	oGmail:revoke()
	updateControls( oDlg, aConnect, aDisconnect )

	if hb_vfExists( cProfile )
		hb_vfErase( cProfile )
	endif

return nil

function onSendMail()

	if oGmail:send( "lailton@paysoft.com.br", "it is a test", "<b>Message from Gmail oAuth2</b>", .t., {} )
		msgInfo( "Mail sent!" )
	else
		msgStop( "Failed to send email. You may not have authorized the required permissions..." )
	endif

return nil

function updateControls( oDlg, aConnect, aDisconnect )

	local hUser
	local cProfile := hb_dirBase() + "profile_gmail.jpg"

	if oGmail:isAuth()
		hUser := oGmail:me()
	endif

	aEval( aConnect, { |o| o:hide() } )
	aEval( aDisconnect, { |o| o:hide() } )

	if hb_isHash( hUser )

		aEval( aConnect, {|o|o:show(),o:refresh()} )

		if !hb_vfExists( cProfile )
			oGmail:downloadUrl( hUser[ "picture" ], cProfile )
		endif

		// Load Profile Photo
		if hb_vfExists( cProfile )
			aConnect[1]:loadImage(, cProfile )
			aConnect[1]:refresh()
		endif

		aConnect[2]:setText( hUser[ "name" ] )
		aConnect[3]:setText( hUser[ "email" ] )

		aConnect[2]:update()
		aConnect[3]:update()

	else

		aEval( aDisconnect, {|o|o:show(),o:refresh()} )

	endif

	oDlg:update()

return nil

function readStore( cFile )

	local hStore

	if hb_vfExists( cFile )
		hStore := hb_jsonDecode( hb_memoRead( cFile ) )
	endif

	if !hb_isHash( hStore )
		hStore := {;
			"token" => "";
		}
	endif

return hStore

function saveStore( cFile, hStore )

	hb_memoWrit( cFile, hb_jsonEncode( hStore ) )

return hb_vfExists( cFile )

Code: Select all | Expand

#include "FiveWin.ch"

FUNCTION SendEmail()
   LOCAL cUrl, cData, cResponse
   LOCAL cAccessToken := "YOUR_ACCESS_TOKEN"  // Get token via OAuth2
   LOCAL cMessage := '{"message": {"subject": "Test Email", "body": {"contentType": "Text", "content": "Hello, this is a test email!"}, "toRecipients": [{"emailAddress": {"address": "example@domain.com"}}]}}'

   cUrl := "https://graph.microsoft.com/v1.0/me/sendMail"
   cData := cMessage

   cResponse := HttpPostRequest(cUrl, cData, "Authorization: Bearer " + cAccessToken)
   
   IF !Empty(cResponse)
      MsgInfo("Email sent successfully!", "Success")
   ELSE
      MsgError("Failed to send email.", "Error")
   ENDIF

RETURN

Code: Select all | Expand

CLASS Tgmail

   DATA cClientId // OAuth2 Client ID
   DATA cClientSecret // OAuth2 Client Secret
   DATA cRedirectUri // Redirect URI
   DATA cAccessToken // OAuth2 Access Token
   DATA cRefreshToken // OAuth2 Refresh Token
   DATA cAuthUrl // Authorization URL

   METHOD Init( cClientId, cClientSecret, cRedirectUri )
   METHOD GetAuthorizationUrl()
   METHOD GetAccessToken( cCode )
   METHOD SendEmail( cSubject, cBody, cRecipient )

ENDCLASS

// Constructor for Tgmail class
METHOD Init( cClientId, cClientSecret, cRedirectUri )
   ::cClientId := cClientId
   ::cClientSecret := cClientSecret
   ::cRedirectUri := cRedirectUri
   ::cAuthUrl := "https://accounts.google.com/o/oauth2/v2/auth?scope=https://www.googleapis.com/auth/gmail.send&response_type=code&redirect_uri=" + SELF:cRedirectUri + "&client_id=" + SELF:cClientId
   RETURN NIL

// Method to get the authorization URL
METHOD GetAuthorizationUrl()
   RETURN ::cAuthUrl

// Method to get access token using authorization code
METHOD GetAccessToken( cCode )
   LOCAL cUrl, cData, cResponse, cTokenUrl
   cTokenUrl := "https://oauth2.googleapis.com/token"
   cData := "code=" + cCode + ;
            "&client_id=" + ::cClientId + ;
            "&client_secret=" + ::cClientSecret + ;
            "&redirect_uri=" + ::cRedirectUri + ;
            "&grant_type=authorization_code"

   // Request to get the token
   cResponse := HttpPostRequest( cTokenUrl, cData, "" )
   IF !Empty(cResponse)
      LOCAL aJson
      aJson := JsonParse( cResponse )
      ::cAccessToken := aJson[ "access_token" ]
      ::cRefreshToken := aJson[ "refresh_token" ]
      RETURN .T.
   ELSE
      RETURN .F.
   ENDIF

// Method to send an email via GMail
METHOD SendEmail( cSubject, cBody, cRecipient )
   LOCAL cUrl, cMessage, cRaw, cResponse

   // Prepare the message in MIME format
   cRaw := "From: 'me'\r\n" + ;
           "To: " + cRecipient + "\r\n" + ;
           "Subject: " + cSubject + "\r\n" + ;
           "Content-Type: text/plain; charset=UTF-8\r\n\r\n" + ;
           cBody

   // Encode the message in base64
   cRaw := Base64Encode( cRaw )

   // Build the request body
   cMessage := '{"raw": "' + cRaw + '"}'

   // URL to send the message
   cUrl := "https://gmail.googleapis.com/upload/gmail/v1/users/me/messages/send?uploadType=multipart"

   // Send HTTP request with access token
   cResponse := HttpPostRequest( cUrl, cMessage, "Authorization: Bearer " + ::cAccessToken )
   IF !Empty(cResponse)
      RETURN .T.
   ELSE
      RETURN .F.
   ENDIF

RETURN NIL

Code: Select all | Expand

LOCAL oGmail
oGmail := Tgmail():New()

Code: Select all | Expand

oGmail:Init( "YOUR_CLIENT_ID", "YOUR_CLIENT_SECRET", "YOUR_REDIRECT_URI" )

Code: Select all | Expand

LOCAL cAuthUrl
cAuthUrl := oGmail:GetAuthorizationUrl()
MsgInfo( "Visita questo URL per autorizzare l'app: " + cAuthUrl, "Autorizzazione OAuth2" )

Code: Select all | Expand

LOCAL cCode, lSuccess
cCode := "AUTHORIZATION_CODE_OBTAINED_FROM_USER"  // Ottieni il codice di autorizzazione
lSuccess := oGmail:GetAccessToken( cCode )
IF lSuccess
   MsgInfo( "Token di accesso ottenuto!", "Successo" )
ELSE
   MsgError( "Errore durante l'ottenimento del token.", "Errore" )
ENDIF

Code: Select all | Expand

LOCAL lSuccess
lSuccess := oGmail:SendEmail( "Test Email", "Ciao, questa è una prova di invio email!", "recipient@example.com" )
IF lSuccess
   MsgInfo( "Email inviata con successo!", "Successo" )
ELSE
   MsgError( "Errore durante l'invio dell'email.", "Errore" )
ENDIF

Code: Select all | Expand

FUNCTION HttpPostRequest( cUrl, cData, cHeaders )
   LOCAL cResponse
   cResponse := HttpPost( cUrl, cData, cHeaders )
   RETURN cResponse

Code: Select all | Expand

FUNCTION Base64Encode( cData )
   RETURN HB_BASE64ENCODE( cData )

Code: Select all | Expand

CLASS Toffice365

   DATA cClientId // OAuth2 Client ID
   DATA cClientSecret // OAuth2 Client Secret
   DATA cRedirectUri // Redirect URI
   DATA cAccessToken // OAuth2 Access Token
   DATA cRefreshToken // OAuth2 Refresh Token
   DATA cAuthUrl // Authorization URL

   METHOD Init( cClientId, cClientSecret, cRedirectUri )
   METHOD GetAuthorizationUrl()
   METHOD GetAccessToken( cCode )
   METHOD SendEmail( cSubject, cBody, cRecipient )

ENDCLASS

// Constructor for Toffice365 class
METHOD Init( cClientId, cClientSecret, cRedirectUri )
   ::cClientId := cClientId
   ::cClientSecret := cClientSecret
   ::cRedirectUri := cRedirectUri
   ::cAuthUrl := "https://login.microsoftonline.com/common/oauth2/v2.0/authorize?" + ;
                    "client_id=" + SELF:cClientId + ;
                    "&response_type=code" + ;
                    "&redirect_uri=" + SELF:cRedirectUri + ;
                    "&scope=Mail.Send"
   RETURN NIL

// Method to get the authorization URL
METHOD GetAuthorizationUrl()
   RETURN ::cAuthUrl

// Method to get access token using authorization code
METHOD GetAccessToken( cCode )
   LOCAL cUrl, cData, cResponse, cTokenUrl
   cTokenUrl := "https://login.microsoftonline.com/common/oauth2/v2.0/token"
   cData := "code=" + cCode + ;
            "&client_id=" + SELF:cClientId + ;
            "&client_secret=" + SELF:cClientSecret + ;
            "&redirect_uri=" + SELF:cRedirectUri + ;
            "&grant_type=authorization_code"

   // Request to get the token
   cResponse := HttpPostRequest( cTokenUrl, cData, "" )
   IF !Empty(cResponse)
      LOCAL aJson
      aJson := JsonParse( cResponse )
      ::cAccessToken := aJson[ "access_token" ]
      SELF:cRefreshToken := aJson[ "refresh_token" ]
      RETURN .T.
   ELSE
      RETURN .F.
   ENDIF

// Method to send an email via Office 365 (Microsoft Graph)
METHOD SendEmail( cSubject, cBody, cRecipient )
   LOCAL cUrl, cMessage, cRaw, cResponse

   // Prepara il messaggio in formato MIME
   cRaw := '{"message": {' + ;
           '"subject": "' + cSubject + '",' + ;
           '"body": {"contentType": "Text", "content": "' + cBody + '"},' + ;
           '"toRecipients": [{"emailAddress": {"address": "' + cRecipient + '"}}]' + ;
           '}}'

   // URL to send message via Microsoft Graph
   cUrl := "https://graph.microsoft.com/v1.0/me/sendMail"

   // Send HTTP request with access token
   cResponse := HttpPostRequest( cUrl, cRaw, "Authorization: Bearer " + SELF:cAccessToken )
   IF !Empty(cResponse)
      RETURN .T.
   ELSE
      RETURN .F.
   ENDIF

RETURN NIL

Code: Select all | Expand

LOCAL oOffice365
oOffice365 := Toffice365():New()

// Initializes with the client_id, client_secret and redirect_uri obtained from Azure Portal
oOffice365:Init( "YOUR_CLIENT_ID", "YOUR_CLIENT_SECRET", "YOUR_REDIRECT_URI" )

Code: Select all | Expand

LOCAL cAuthUrl
cAuthUrl := oOffice365:GetAuthorizationUrl()
MsgInfo( "Visita questo URL per autorizzare l'app: " + cAuthUrl, "Autorizzazione OAuth2" )

Code: Select all | Expand

LOCAL cCode, lSuccess
cCode := "AUTHORIZATION_CODE_OBTAINED_FROM_USER"  // Codice di autorizzazione
lSuccess := oOffice365:GetAccessToken( cCode )
IF lSuccess
   MsgInfo( "Token di accesso ottenuto!", "Successo" )
ELSE
   MsgError( "Errore durante l'ottenimento del token.", "Errore" )
ENDIF

Code: Select all | Expand

LOCAL lSuccess
lSuccess := oOffice365:SendEmail( "Test Email", "Ciao, questa è una prova di invio email!", "recipient@example.com" )
IF lSuccess
   MsgInfo( "Email inviata con successo!", "Successo" )
ELSE
   MsgError( "Errore durante l'invio dell'email.", "Errore" )
ENDIF

Code: Select all | Expand

#include "fivewin.ch"

function Main()
    local oWnd

    // Define the window
    DEFINE WINDOW oWnd TITLE "Rectangle Example" SIZE 640, 480

    // Set the pen color and thickness for the rectangle border
    oWnd: SetPen( RGB(255, 0, 0), 3 )  // Red color, 3 pixels thickness

    // Set the brush color for the rectangle fill (optional)
    oWnd: SetBrush( RGB(0, 255, 0) )   // Green fill (you can also use a transparent fill)

    // Draw the rectangle with specific coordinates
    oWnd: DrawRect( 100, 100, 500, 300 ) // x1, y1, x2, y2

    // Show and activate the window
    ACTIVATE WINDOW oWnd

return

Code: Select all | Expand

   TGet():lClrFocus := (.T.)
   TGet():nClrFocus := nRGB( 213, 219, 255 )

Code: Select all | Expand

   TMultiGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_WHITE, CLR_GREEN },;
                                        If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }