Code: Select all

*+--------------------------------------------------------------------
*+
*+ Source Module => x:\hmg.3.4.4\0\PULS\STACK.PRG
*+
*+    Copyright(C) 1983-2026 by Auge & Ohr
*+
*+    Functions: Function SP_INIT()
*+               Function SP_DFROM()
*+               Function SP_DTO()
*+
*+    Reformatted by Click! 2.05.42 on Dec-25-2025 at  6:51 am
*+
*+--------------------------------------------------------------------

#include "hmg.ch"

#xtranslate F_DFROM       => Stack\[SP, 1]
#xtranslate F_DTO         => Stack\[SP, 2]

STATIC Stack := {}
STATIC SP    := 0

*+--------------------------------------------------------------------
*+
*+    Function SP_INIT()
*+
*+    Called from ( blpress.prg )   1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
FUNCTION SP_INIT()                                                    // init STACK

   AADD( Stack, ARRAY( 2 ) )
   SP ++
   F_DFROM := CTOD( " / / " )
   F_DTO := CTOD( " / / " )
RETURN NIL

*+--------------------------------------------------------------------
*+
*+    Function SP_DFROM()
*+
*+    Called from ( blpress.prg )   1 - static procedure dosetrange()
*+                                   4 - static procedure dosetfilterrange()
*+
*+--------------------------------------------------------------------
*+
FUNCTION SP_DFROM( Value )

   IF PCOUNT() > 0
      F_DFROM := Value
   ENDIF
RETURN F_DFROM

*+--------------------------------------------------------------------
*+
*+    Function SP_DTO()
*+
*+    Called from ( blpress.prg )   1 - static procedure dosetrange()
*+                                   4 - static procedure dosetfilterrange()
*+
*+--------------------------------------------------------------------
*+
FUNCTION SP_DTO( Value )

   IF PCOUNT() > 0
      F_DTO := Value
   ENDIF
RETURN F_DTO

*+ EOF: STACK.PRG

Code: Select all

PROCEDURE MAIN()
...
// on TOP
   SP_INIT()
...

Code: Select all

STATIC PROCEDURE DoSetRange()
...
         ACTION { || nZEIT := DateFilter.RadioGroup_1.VALUE, ;
                  SP_DFROM( DateFilter.DatePicker_FROM.VALUE ), ;
                  SP_DTO( DateFilter.DatePicker_TO.VALUE ), ;
                  DoSetFilterRange( nZEIT ) }
  

Code: Select all

STATIC PROCEDURE DoSetFilterRange( nZEIT )

LOCAL lUse   := USED()
LOCAL bError := ERRORBLOCK( { | oErr | BREAK( oErr ) } )
LOCAL oError

   BEGIN SEQUENCE
      SET FILTER TO
      BLPRESS.Text_Min.ReadOnly := .F.
      BLPRESS.Text_Max.ReadOnly := .F.

      IF SP_DTO() >= SP_DFROM()

         DO CASE
            CASE nZEIT = 3
               SET FILTER TO BLPRESS->PDATE >= SP_DFROM() .AND. ;
                             BLPRESS->PDATE <= SP_DTO()

            CASE nZEIT = 2

Code: Select all

#include "hmg.ch"

FUNCTION Main
local a:= 'ax'
private b := 'bx'
checkvar()

RETURN

PROCEDURE checkvar()
msgbox(b)
msgbox(a)
RETURN

Code: Select all

  cDir := GetFolder( cTitle, TRIM( cInitPath ),, lNewFolderButton )
   IF !EMPTY( cDir )
       IF RAT( "\", cDir ) <> LEN(cDir)
                 cDir += "\"
       ENDIF
      ExportDbf.Text_Path.value := cDir                                //+ "\"  // add "\"
   ENDIF

Code: Select all

#include "hmg.ch"

Function Main()
SELECT HPDFDOC "sample.pdf" PAPERLENGTH 300 PAPERWIDTH 300 LOG
START HPDFDOC
    START HPDFPAGE
	
	SET HPDFDOC ENCODING TO "WinAnsiEncoding"
	    
		@ 10,20  HPDFPRINT "I want Euro sign here: "+CHR(128)
		
        @ 20,20  HPDFPRINT "I want this STRIKEOUT (not working)" STRIKEOUT

		@ 18,67  HPDFPRINT "_________" // COLOR { 51, 255, 255 }
		@ 20,92  HPDFPRINT "<----  This line was drawing to simulate a baseline (made manually)" SIZE 9 COLOR { 0, 0, 255 }
		
        @ 30,20  HPDFPRINT "I want this italic" ITALIC
        @ 40,20  HPDFPRINT "I want this bold" BOLD
        @ 50,20  HPDFPRINT "I want this UNDERLINE (not working)" UNDERLINE
		
		@ 50,67  HPDFPRINT "_________" // COLOR { 255, 0, 0 }
		@ 52,92  HPDFPRINT "<----  This line was drawing to simulate a baseline (made manually)" SIZE 9 COLOR { 0, 0, 255 }
        
		@ 60,20 HPDFPRINT "I have HMG 3.2.1 (stable) in Courier-Bold" FONT "Courier-Bold"
        
        @ 80, 10 HPDFPRINT "This is a sample Text in default font in ITALIC." ITALIC
        @ 90, 10 HPDFPRINT "This is a sample Text in default font in BOLD." BOLD
        
        @ 100, 10 HPDFPRINT "This is a sample Text in Arial or Helvetica font in ITALIC." FONT "aRIAL" SIZE 14 ITALIC
        @ 110, 10 HPDFPRINT "This is a sample Text in Arial or Helvetica font in BOLD and ITALIC." FONT "aRIAL" SIZE 14 BOLD ITALIC


*@ 120, 10 hpdfprint image 'img.jpg'  TYPE JPG width 40 height 40' size 10     // (((YOU CAN USE IF YOU HAVE A .JPG PICTURE.)))

        
  *      @ 120, 10 HPDFPRINT "This is a sample Text in Times-Roman font in ITALIC with size 8" font "TIMES-ROMAN" SIZE 8 ITALIC
        
        @ 135, 200 HPDFPRINT "This is right aligned text" SIZE 14 RIGHT
        
        @ 150, 105 HPDFPRINT "This is center aligned text" COLOR { 255, 0, 0 } CENTER
        
        @ 170, 100 HPDFPRINT "This is text in bigger font size" SIZE 30 COLOR { 255, 0, 0 }
        
        @ 190, 10 HPDFPRINT "The font is Tscparan.TTF" size 12

    END HPDFPAGE
END HPDFDOC
Execute File 'sample.pdf'
Return Nil

Code: Select all

// whatsapp app must be installed and opened before running this code

#include "FiveWin.ch"

#define ORANGES "https://www.jesmondfruitbarn.com.au/wp-content/uploads/2016/10/Jesmond-Fruit-Barn-Oranges.jpg"

function Main()

   local cPhone   := ""
   local cMsg     := "Hello"

   if EDITVARS cPhone, cMsg
      SendToWhatsApp( AllTrim( cPhone ), AllTrim( cMsg ), ;
         { "tutor01.prg", "..\bitmaps\007.bmp", ORANGES, ;
            "https://www.google.co.in/" } )
   endif

return nil

function SendToWhatsApp( cPhone, cMsg, aAttach )

   local oShell
   local aFiles   := {}
   local aOthers  := {}

   if Empty( cPhone ); return .f.; endif

   DEFAULT cMsg := "Hello"

   if !Empty( aAttach )
      if !HB_ISARRAY( aAttach ); aAttach := { aAttach }; endif
      AEval( aAttach, {|c| if( HB_ISSTRING( c ) .and. File( c ), ;
            AAdd( aFiles, c ), AAdd( aOthers, c ) ) } )
   endif

   cMsg  := StrTran( cMsg, CRLF, "%0D%0A" )

   oShell := CreateObject( "WScript.Shell" )
   ShellExecute( 0, "Open", "whatsapp://send?phone="+cPhone+"&text="+cMsg )
   SysWait( 0.5 )

   if !Empty( aFiles )
      if FW_CopyToClipBoard( aFiles, 15 )
         SysWait( 2 ); oShell:SendKeys( "^v" ); SysWait( 1 )
      endif
   endif

   AEval( aOthers, <|u|
      if FW_CopyToClipBoard( u, 2 ) .or. FW_CopyToClipBoard( u )
         SysWait( 1 ); oShell:SendKeys( "^v" ); SysWait( 1 )
      endif
      return nil
      > )

   oShell:SendKeys("~")

return nil

Code: Select all

#include "hmg.ch"
// whatsapp app must be installed and opened before running this code



#define ORANGES "https://www.jesmondfruitbarn.com.au/wp-content/uploads/2016/10/Jesmond-Fruit-Barn-Oranges.jpg"

FUNCTION Main()

   LOCAL cPhone := ""
   LOCAL cMsg   := "Hello"

   cPhone := InputBox( "Telefoonnummer", "WhatsApp", "" )
   IF Empty( cPhone )
      RETURN NIL
   ENDIF

   cMsg := InputBox( "Bericht", "WhatsApp", "Hello" )

   SendToWhatsApp( AllTrim( cPhone ), AllTrim( cMsg ), ;
      { "C:\bols\bols.dbf", ;
        "C:\bols\confirmQR.jpg"} )
        //ORANGES, ;
        //"https://www.google.com/" } )

RETURN NIL






FUNCTION SendToWhatsApp( cPhone, cMsg, aAttach )

   LOCAL oShell
   LOCAL aFiles  := {}
   LOCAL aOthers := {}
   LOCAL cItem

   IF Empty( cPhone )
      RETURN .F.
   ENDIF

   DEFAULT cMsg := "Hello"

   IF HB_ISARRAY( aAttach )
      FOR EACH cItem IN aAttach
         IF HB_ISSTRING( cItem ) .AND. File( cItem )
            AAdd( aFiles, cItem )
         ELSE
            AAdd( aOthers, cItem )
         ENDIF
      NEXT
   ENDIF

   cMsg := StrTran( cMsg, CRLF, "%0D%0A" )

   // WhatsApp openen
   ShellExecute( 0, "open", ;
      "whatsapp://send?phone=" + cPhone + "&text=" + cMsg, ;
      NIL, NIL, 1 )

   hb_idleSleep( 0.5 )

   oShell := CreateObject( "WScript.Shell" )

   // Bestanden plakken
   IF Len( aFiles ) > 0
      CopyFilesToClipboard( aFiles )
      hb_idleSleep( 2 )
      oShell:SendKeys( "^v" )
      hb_idleSleep( 1 )
   ENDIF

   // URL's / tekst
   FOR EACH cItem IN aOthers
      System.Clipboard := cItem
      hb_idleSleep( 1 )
      oShell:SendKeys( "^v" )
      hb_idleSleep( 1 )
   NEXT

   // Enter = verzenden
   oShell:SendKeys( "~" )

RETURN .T.





FUNCTION CopyFilesToClipboard( aFiles )

   LOCAL cList := ""

   AEval( aFiles, {|c| cList += '"' + c + '"' + CRLF } )
   System.Clipboard := cList
RETURN NIL