/* 
  * MINIGUI - Harbour Win32 GUI library Demo 
  * 
  * ShellExecuteEx() and TerminateProcess() and WaitForSingleObject() for MiniGui 
  * (c) 2014-2023 Artyom Verchenko <artyomskynet@gmail.com> 
  * 
  * Run the program via ShellExecuteEx() 
  * Check for a second copy of the startup process 
  * Watchman of a running program - control of the process launched from its program 
 */ 
  
 ANNOUNCE RDDSYS 
  
 #define _HMG_OUTLOG 
 #define PRG_NAME      "Launching external programs ShellExecuteEx()"  
 #define PRG_BOTTOM    " -> hProcessHandleShellExecuteEx = "  
 #define HELP_MINIGUI  GetEnv( "MG_ROOT" ) + "\Doc\MiniGUI.chm"   
 #define EXE_NOTEPAD  "notepad.exe" 
  
 #include "minigui.ch" 
  
 STATIC hProcessHandleShellExecuteEx := 0 
 //////////////////////////////////////////////////////////////////////////////// 
 PROCEDURE Main 
    LOCAL nW := 540, nH := 400, aBackcolor := { 0,64,80 } 
    LOCAL nWBtn, nHBtn, nG, nRow, cMsg, nHLbl, lQ 
  
    SET OOP ON 
    SET WINDOW MODAL PARENT HANDLE ON  
    SET CENTERWINDOW RELATIVE PARENT         
    SET DEFAULT ICON TO "1MAIN_ICO" 
  
    IF !hb_mtvm() 
       MsgStop("No multithreading support !" + CRLF + ; 
               "Program compilation key -mt !" + CRLF + ; 
               App.ExeName    ) 
       QUIT 
    ENDIF 
    ? ; ? REPL("=",20) + " Start" , HB_DATETIME() 
  
    DEFINE WINDOW wMain            ; 
       AT 50,50 WIDTH nW HEIGHT nH ; 
       TITLE PRG_NAME              ; 
       MAIN                        ; 
       NOMAXIMIZE NOSIZE           ;  
       BACKCOLOR  aBackcolor       ; 
       FONT "Tahona" SIZE 14       ; 
       ON RELEASE {|| _LogFile(.T., REPL("=",20) + " End", ; 
                      HB_DATETIME() ), DoEvents()      }   ;  // executed before destroying the window 
       ON INTERACTIVECLOSE {|lRet| lRet := myQuit() }         // NO exit while there is a window ShellExecuteEx() 
  
       nW    := This.ClientWidth 
       nH    := This.ClientHeight 
       nRow  := nG := 20 
       nWBtn := nW - nG * 2  
       nHLbl := nG*3  
       nHBtn := ( nH - nG * 4 - nHLbl ) / 3  
       nRow  += 20 
       nWBtn -= 50 
       nG += 10 
  
       @ 2, 2 BUTTONEX Button_0 WIDTH 30 HEIGHT 30 ; 
       CAPTION '0' ACTION {||  
          Local y := This.Row + App.Row + GetBorderHeight()/2 + GetTitleHeight() 
          Local x := This.Col + App.Col + GetBorderWidth ()/2 
          Local w := This.Width  + 4 
          Local h := This.Height + 4 
          Local c := ThisWindow.BackColor 
          y -= 2 
          x -= 2 
          my_Modal_Wait(y, x, w, h, c) 
          Return Nil 
          } 
  
       @ nRow, nG BUTTONEX Button_1 WIDTH nWBtn HEIGHT nHBtn ; 
       CAPTION 'ShellExecuteEx()' ACTION RunFileStream()  
       nRow += nHBtn + nG  
  
       @ nRow, nG BUTTONEX Button_2 WIDTH nWBtn HEIGHT nHBtn ; 
       CAPTION 'TerminateProcess()' ACTION CloseProcess()  
       nRow += nHBtn + nG  
  
       @ nRow, nG BUTTONEX Button_Exit WIDTH nWBtn HEIGHT nHBtn ; 
       CAPTION 'EXIT' ACTION IIF( lQ := myQuit() , ThisWindow.Release , wMain.Label_0.Setfocus ) 
       nRow += nHBtn + nG*2 
  
       cMsg := PRG_BOTTOM + HB_NtoS(hProcessHandleShellExecuteEx) 
       @ nRow, 0 LABEL Label_0 WIDTH nW HEIGHT nG*2 VALUE cMsg FONTCOLOR WHITE TRANSPARENT VCENTERALIGN 
  
    END WINDOW 
  
    //CENTER WINDOW wMain 
    ACTIVATE WINDOW wMain 
  
 RETURN 
  
 FUNCTION my_Modal_Wait(y,x,w,h,c) 
    LOCAL cForm := ProcName() 
    DEFAULT y := 0,x := 0,w := 100,h := 70 
      
    DEFINE WINDOW &cForm AT y, x WIDTH w HEIGHT h TITLE " " ; 
       MODAL NOCAPTION NOSIZE BACKCOLOR c ; 
       ON INIT {|| DoEvents(), _wPost(0) }  
       (This.Object):Event(0, {|ow| wApi_ShellExecute_Wait(, 'open', EXE_NOTEPAD,,, SW_SHOWNORMAL), ; 
                                    ow:Release() }) 
    END WINDOW 
    IF Empty(y + x) 
      CENTER WINDOW &cForm 
    ENDIF 
    ACTIVATE WINDOW &cForm 
  
 RETURN Nil 
  
 /////////////////////////////////////////////////////////////////////////////// 
 FUNCTION myQuit()        // NO exit while there is a window ShellExecuteEx() 
    LOCAL cMsg, nWin, lRet, lQuit := .T. 
  
    nWin := hProcessHandleShellExecuteEx 
    cMsg := "You need to close the program window!" + CRLF 
    cMsg += HELP_MINIGUI + CRLF + CRLF 
    cMsg += "hProcessHandleShellExecuteEx > 0" 
  
    IF lQuit 
       lRet := IIF( nWin == 0, .T., ( MsgExclamation(cMsg, "Attention"), .F. ) ) 
    ELSE 
       lRet := .T.  // always exit is for debugging 
    ENDIF 
  
 RETURN lRet 
  
 //////////////////////////////////////////////////////////////////////////////// 
 #include "hbthread.ch" 
  
 FUNCTION RunFileStream()         
    // Start in a separate thread  
    hb_threadDetach( hb_threadStart( HB_THREAD_INHERIT_MEMVARS, @RunFileInternal(), Nil ) ) 
 RETURN NIL 
  
 //////////////////////////////////////////////////////////////////////////////// 
 FUNCTION RunFileInternal() 
       LOCAL cFileRun, nWaitCode, cMsg 
  
       cFileRun := HELP_MINIGUI         // where is the MiniGui 
       IF FILE( cFileRun )  
          IF hProcessHandleShellExecuteEx == 0 
             // handle process (launched HELP MiniGUI.chm) 
             // It is very convenient to get handle its public document .doc or .xls 
             // Then to close it independently from the program.  
             hProcessHandleShellExecuteEx := ShellExecuteEx( , 'open', cFileRun, , , SW_SHOWNORMAL) 
             cMsg := PRG_BOTTOM + HB_NtoS(hProcessHandleShellExecuteEx) 
             ? "Run ->", cFileRun, cMsg 
             wMain.Label_0.Value := cMsg 
  
             // Watchman of a running program - control of the process launched from its program 
             // Waits until the specified object is in the signaled state or the time-out interval elapses 
             nWaitCode := WaitForSingleObject(hProcessHandleShellExecuteEx) //, 2000) // ms. waiting time 
             // nWaitCode = 258 - timeout process not completed 
             // nWaitCode =  -1 - incorrect process 
             // nWaitCode =   0 - process completed 
             cMsg := cFileRun + CRLF 
             cMsg += "STOP ShellExecuteEx() ! RunFileInternal: " + ALLTRIM(STR(nWaitCode)) 
             IF nWaitCode == 0 
                cMsg += CRLF + "Process completed !" 
                MsgInfo(cMsg)  
             ELSE 
                cMsg += CRLF + "Process termination error !" 
                MsgStop(cMsg) 
             ENDIF 
             // end process, close window 
             hProcessHandleShellExecuteEx := 0  // STOP ShellExecuteEx() - NECESSARILY !!! 
             cMsg := PRG_BOTTOM + HB_NtoS(hProcessHandleShellExecuteEx) 
             wMain.Label_0.Value := cMsg 
          ELSE 
             cMsg := PRG_BOTTOM + HB_NtoS(hProcessHandleShellExecuteEx) 
             ? "The program is already running ...", cMsg 
          ENDIF 
       ELSE 
          MsgStop("Not file: " + cFileRun) 
       ENDIF 
  
 RETURN NIL 
  
 //////////////////////////////////////////////////////////////////////////////// 
 // Close the handle to open the process of program 
 FUNCTION CloseProcess()  
    LOCAL nRet, cMsg 
  
    IF hProcessHandleShellExecuteEx > 0 
       nRet := TerminateProcess( hProcessHandleShellExecuteEx ) 
       cMsg := "CloseProcess ShellExecuteEx(...): " + HB_NtoS(nRet) + CRLF 
       cMsg += "Returns a non-zero number if the process completed successfully and zero if an error occurred" 
       MsgInfo(cMsg) 
       ? cMsg  
    ELSE 
       cMsg := "Process not started by ShellExecuteEx(...) !"  
       MsgStop(cMsg) 
       ? cMsg  
    ENDIF 
  
 RETURN NIL 
  
 //////////////////////////////////////////////////////////////////////////////// 
 // (c) 2023 Artyom Verchenko <artyomskynet@gmail.com> 
 #pragma BEGINDUMP 
  
 #include <windows.h> 
 #include <hbapi.h> 
 #include <shlobj.h> 
  
 HB_FUNC( SHELLEXECUTEEX ) 
 { 
    SHELLEXECUTEINFO  SHExecInfo; 
    ZeroMemory( &SHExecInfo, sizeof( SHExecInfo ) ); 
  
    SHExecInfo.cbSize = sizeof( SHExecInfo ); 
    SHExecInfo.fMask = SEE_MASK_NOCLOSEPROCESS; 
    SHExecInfo.lpVerb = ( LPCSTR ) hb_parcx( 2 ); 
    SHExecInfo.lpFile = ( LPCSTR ) hb_parcx( 3 ); 
    SHExecInfo.lpParameters = ( LPCSTR ) hb_parcx( 4 ); 
    SHExecInfo.lpDirectory = ( LPCSTR ) hb_parcx( 5 ); 
    SHExecInfo.nShow = hb_parni( 6 ); 
  
    if( !ShellExecuteEx( &SHExecInfo ) ) 
    { 
       hb_retnl( NULL ); 
    } 
    else 
    { 
       hb_retnl( ( LONG ) SHExecInfo.hProcess ); 
    } 
 } 
  
 HB_FUNC( TERMINATEPROCESS ) 
 { 
    hb_retnl( ( BOOL ) TerminateProcess( ( HANDLE ) hb_parni( 1 ), 0 ) ); 
 } 
  
 // Waits until the specified object is in the signaled state or the time-out interval elapses 
 HB_FUNC( WAITFORSINGLEOBJECT ) 
 { 
    DWORD waitTime = hb_parnl( 2 ); 
    if( waitTime == 0 ) 
    { 
       waitTime = INFINITE; 
    } 
  
    hb_retnl( WaitForSingleObject( ( HANDLE ) hb_parnl( 1 ), waitTime ) ); 
 } 
  
 #pragma ENDDUMP 
 

/* 
  * MINIGUI - Harbour Win32 GUI library Demo 
  * 
 */ 
  
 #include "hmg.ch" 
 #include "TSBrowse.ch" 
  
 PROCEDURE Main 
    LOCAL oBrw, aArray //, aFontHF, aHead, aWSize, aFoot, aPict, aAlign, aName 
    aArray := DIRECTORY( GetStartUpFolder() + "\*.*" ) 
    ASORT(aArray,,, { |x, y| x[1] < y[1] }) 
  
 DEFINE WINDOW Form_1 ; 
    AT 0, 0 ; 
    WIDTH 450 ; 
    HEIGHT 470 ; 
    TITLE 'Transparency Color Sample' ; 
    MAIN 
  
    DEFINE LISTBOX ListBox_1 
       ROW 0 
       COL 5 
       WIDTH 420 
       HEIGHT 160 
       ITEMS { ' - 01 -' , ' - 02 -' , ' - 03 -' } 
       BACKCOLOR BLACK 
       FONTCOLOR GREEN 
       FONTBOLD .T. 
       VALUE 2 
    END LISTBOX 
  
    DEFINE TBROWSE Tsb_1 OBJ oBrw AT 170, 5 WIDTH 420 HEIGHT 170 CELL ; 
       ALIAS  aArray                 ;      // массив - это ТСБ по массиву  
       COLNUMBER { 1, 30 }  // колонка NN 
  
    END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:SetFocus() } 
  
    DEFINE BUTTONEX Button_1  
       ROW 170*2 + 10  
       COL 170  
       WIDTH 250  
       HEIGHT 28  
       CAPTION "Set Black Color Transparency ON"  
       ACTION Form_1.BackColorTransparent := BLACK 
       FONTCOLOR BLUE 
       FLAT .T.  
    END BUTTONEX 
  
    DEFINE BUTTONEX Button_2  
       ROW 170*2 + 10*2 + 28   
       COL 170  
       WIDTH 250  
       HEIGHT 28  
       CAPTION "Set Black Color Transparency OFF"  
       ACTION SetTransparencyOff()  
       FONTCOLOR BLUE 
       FLAT .T.  
    END BUTTONEX 
  
 END WINDOW  
  
 CENTER WINDOW Form_1  
 ACTIVATE WINDOW Form_1  
  
 RETURN 
  
 /*  
 */  
 PROCEDURE SetTransparencyOff()  
  
    SET WINDOW Form_1 TRANSPARENT TO OPAQUE 
  
 RETURN

 
 /*  
  * MINIGUI - Harbour Win32 GUI library Demo  
  *  
 */  
   
 #include "hmg.ch"  
 #include "TSBrowse.ch"  
   
 PROCEDURE Main  
    LOCAL oBrw, aArray //, aFontHF, aHead, aWSize, aFoot, aPict, aAlign, aName  
    LOCAL nTra := 255, y, x 
  
    aArray := DIRECTORY( GetStartUpFolder() + "\*.*" )  
    ASORT(aArray,,, { |x, y| x[1] < y[1] })  
   
  DEFINE WINDOW Form_1 ;  
    AT 0, 0 ;  
    WIDTH 450 ;  
    HEIGHT 550 ;  
    TITLE 'Transparency Color Sample' ;  
    MAIN ; 
    ON INIT ( ThisWindow.AlphaBlendTransparent := nTra ) 
   
    DEFINE LISTBOX ListBox_1  
       ROW 0  
       COL 5  
       WIDTH 420  
       HEIGHT 160  
       ITEMS { ' - 01 -' , ' - 02 -' , ' - 03 -' }  
       BACKCOLOR BLACK  
       FONTCOLOR GREEN  
       FONTBOLD .T.  
       VALUE 2  
    END LISTBOX  
   
    DEFINE TBROWSE Tsb_1 OBJ oBrw AT 170, 5 WIDTH 420 HEIGHT 170 CELL ;  
       ALIAS  aArray                 ;      // массив - это ТСБ по массиву   
       COLNUMBER { 1, 30 }  // колонка NN  
   
    END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:SetFocus() }  
   
    DEFINE BUTTONEX Button_1   
       ROW 170*2 + 10   
       COL 170   
       WIDTH 250   
       HEIGHT 28   
       CAPTION "Set Black Color Transparency ON"   
       ACTION SetTransparencyOff(.F.) 
       FONTCOLOR BLUE  
       FLAT .T.   
    END BUTTONEX  
   
    DEFINE BUTTONEX Button_2   
       ROW 170*2 + 10*2 + 28    
       COL 170   
       WIDTH 250   
       HEIGHT 28   
       CAPTION "Set Black Color Transparency OFF"   
       ACTION SetTransparencyOff(.T.)   
       FONTCOLOR BLUE  
       FLAT .T.   
    END BUTTONEX  
  
    y := This.Button_2.Row + This.Button_2.Height + 10 
    x := This.Button_2.Col 
    @ y, x BUTTON But1 CAPTION "Click Me" HEIGHT 35 WIDTH 100 ; 
       ACTION ( nTra := iif(nTra == 190, 255, 190), ThisWindow.AlphaBlendTransparent := nTra ) 
   
  END WINDOW   
   
  CENTER WINDOW Form_1   
  ACTIVATE WINDOW Form_1   
   
 RETURN  
   
 /*   
 */   
 PROCEDURE SetTransparencyOff(lOn)   
    lOn := !Empty(lOn) 
    IF lOn 
       SET WINDOW Form_1 TRANSPARENT TO OPAQUE  
    ELSE 
       Form_1.BackColorTransparent := BLACK  
    ENDIF 
  
    Form_1.Tsb_1.Object:Enabled(lOn) 
   
 RETURN 
 

/* 
  * MINIGUI - Harbour Win32 GUI library Demo 
 */ 
 #include "minigui.ch"  
  
 FUNCTION Main()  
  
    DEFINE WINDOW Win_1 ; 
       AT 50,100 ; 
       WIDTH 400 ; 
       HEIGHT 400 ; 
       TITLE 'Replacing the window background' ; 
       MAIN NOSIZE NOMAXIMIZE  
  
       @ 300,100 BUTTON But1 CAPTION "Click Me" ; 
         HEIGHT 65 WIDTH 200 ; 
         ACTION ReplaceWindowBackground() 
  
    END WINDOW 
  
    CENTER WINDOW Win_1 
    ACTIVATE WINDOW Win_1 
  
 RETURN NIL 
  
  
 FUNCTION ReplaceWindowBackground() 
    LOCAL nW, nH, cMsg, cObj, cForm, aBOld, aBack 
  
    cForm := "Win_1" 
    cObj  := "Label_Del1" 
    cMsg  := "Replacing the window background" + CRLF + "Change window background" 
    nW    := GetProperty( cForm, "Width"  ) - 10 - GetBorderWidth()*2  
    nH    := GetProperty( cForm, "Height" ) - 10 - GetBorderHeight() - GetTitleHeight()  
    aBOld := SetProperty( cForm, "BACKCOLOR")   
    aBack := GRAY                              // меняем цвет формы 
  
    SetProperty( cForm, "BACKCOLOR", aBack )   
    DO EVENTS 
  
    @ 5, 5 LABEL &cObj PARENT &cForm WIDTH nW HEIGHT nH VALUE cMsg ; 
      FONT "Arial Black" SIZE 24 FONTCOLOR BLACK BACKCOLOR aBack 
  
    MsgDebug("Background check!") 
  
    DoMethod(cForm, cObj, 'Release') 
  
    SetProperty( cForm, "BACKCOLOR", aBOld )   
  
 RETURN NIL

 
  
 /*  
  * MINIGUI - Harbour Win32 GUI library Demo  
 */  
 #include "minigui.ch"   
   
 FUNCTION Main()   
    LOCAL nW, nH, aBack, aFont 
   
    DEFINE WINDOW Win_1 ;  
       AT 50,100 ;  
       WIDTH 400 ;  
       HEIGHT 400 ;  
       TITLE 'Replacing the window background' ;  
       MAIN NOSIZE NOMAXIMIZE   
  
    nW := This.ClientWidth  - 10 //- GetBorderWidth() * 2   
    nH := This.ClientHeight - 10 //- GetBorderHeight() - GetTitleHeight()   
  
    @ 5, 5 LABEL Label_Del1 WIDTH nW HEIGHT nH VALUE " " INVISIBLE ;  
           FONT "Arial Black" SIZE 24 FONTCOLOR aFont BACKCOLOR aBack 
        
       @ 300,100 BUTTON But1 CAPTION "Click Me" ;  
         HEIGHT 65 WIDTH 200 ;  
         ACTION ReplaceWindowBackground()  
   
    END WINDOW  
   
    CENTER WINDOW Win_1  
    ACTIVATE WINDOW Win_1  
   
 RETURN NIL  
   
   
 FUNCTION ReplaceWindowBackground()  
    LOCAL /*nW, nH,*/ cMsg, cObj, cForm, aBOld, aBack  
   
    cForm := "Win_1"  
    cObj  := "Label_Del1"  
    cMsg  := "Replacing the window background" + CRLF + "Change window background"  
    //nW    := GetProperty( cForm, "Width"  ) - 10 - GetBorderWidth()*2   
    //nH    := GetProperty( cForm, "Height" ) - 10 - GetBorderHeight() - GetTitleHeight()   
    aBOld := SetProperty( cForm, "BACKCOLOR")    
    aBack := GRAY                              // меняем цвет формы  
   
    SetProperty( cForm, cObj, "BACKCOLOR", aBack )    
    SetProperty( cForm, cObj, "FONTCOLOR", RED   )   // BLACK 
    SetProperty( cForm, cObj, "VALUE"    , cMsg  )    
    SetProperty( cForm, cObj, "VISIBLE"  , .T.   )    
     
    DO EVENTS  
   
   // @ 5, 5 LABEL &cObj PARENT &cForm WIDTH nW HEIGHT nH VALUE cMsg ;  
   //   FONT "Arial Black" SIZE 24 FONTCOLOR BLACK BACKCOLOR aBack  
   
    MsgDebug("Background check!")  
   
    SetProperty( cForm, cObj, "VISIBLE"  , .F. )    
    //DoMethod(cForm, cObj, 'Release')  
   
    SetProperty( cForm, "BACKCOLOR", aBOld )    
   
 RETURN NIL 
 

/*  
   * MINIGUI - Harbour Win32 GUI library Demo  
  */  
  #include "minigui.ch"   
    
  FUNCTION Main()   
    
     DEFINE WINDOW Win_1 ;  
        AT 50,100 ;  
        WIDTH 400 ;  
        HEIGHT 400 ;  
        TITLE 'Replacing the window background' ;  
        MAIN NOSIZE NOMAXIMIZE   
    
        @ 300,100 BUTTON But1 CAPTION "Click Me" ;  
          HEIGHT 65 WIDTH 200 ;  
          ACTION ReplaceWindowBackground()  
    
     END WINDOW  
    
     CENTER WINDOW Win_1  
     ACTIVATE WINDOW Win_1  
    
  RETURN NIL  
    
    
  FUNCTION ReplaceWindowBackground()  
     LOCAL nW, nH, cMsg, cObj, cForm, aBOld, aBack  
    
     cForm := "Win_1"  
     cObj  := "Label_Del1"  
     cMsg  := "Replacing the window background" + CRLF + "Change window background"  
     nW    := GetProperty( cForm, "Width"  ) - 10 - GetBorderWidth()*2   
     nH    := GetProperty( cForm, "Height" ) - 80 - GetBorderHeight() - GetTitleHeight()   
     aBOld := SetProperty( cForm, "BACKCOLOR")    
     aBack := GRAY                              // меняем цвет формы  
    
     SetProperty( cForm, "BACKCOLOR", aBack )    
     DO EVENTS  
    
     @ 5, 5 LABEL &cObj PARENT &cForm WIDTH nW HEIGHT nH VALUE cMsg ;  
       FONT "Arial Black" SIZE 24 FONTCOLOR BLACK BACKCOLOR aBack BORDER 
    
 //    MsgDebug("Background check!")  
    
     DoMethod(cForm, cObj, 'ReDraw')  
    
     SetProperty( cForm, "But1", "ENABLED", .F. )    
    
  RETURN NIL