Please have a look in the code snippet below. Pay attention to this variable "lhWndMainActive". It blocks premature execution and reentry of windows event during definition/initialization. I have also provided a sample code for a modal window shown below (METHOD UserLogin() CLASS UserManager). Also look on the events attached to MainForm ON INIT Method. You can also use the functions included for you to jumpstart.
Code: Select all
REQUEST DBFCDX, DBFFPT
***************
function Main()
PRIVATE TrashFolder := "\trash\"
PRIVATE AppHome := LOWER( GETSTARTUPFOLDER() )
PRIVATE HomeFolder := AppHome + "\data\"
PRIVATE ArchiveHome := AppHome + "\archive\"
PRIVATE DefDrive := HB_CURDRIVE()
PRIVATE oDBsession // Global Window session manager
PRIVATE lPanicState := .f. // Mainform Panic State flag to disable all close database calls to all child windows
// It will ensure clean program termination. All changes on data entry forms will not be saved.
PRIVATE dbDeltaD := HomeFolder + "DELTA.UAF" // Table: User File
PRIVATE dbDeltaI := HomeFolder + "DELTA.UIX" // Index: User File
PRIVATE dbPathTbl := HomeFolder + "pathcase" // Pathology Case Main Table
PRIVATE dbWeight := HomeFolder + "weighthis" // Weight Historical Record
PRIVATE dbBPSummary := HomeFolder + "bpsummary" // Blood Pressure Summary
PRIVATE dbBPHistory := HomeFolder + "bphistory" // Blood Pressure History
PRIVATE dbGlucoSum := HomeFolder + "glucossum" // Glucose Record Summary
PRIVATE dbGlucoHis := HomeFolder + "glucosehis" // Glucose Record Details
PRIVATE dbTblUnit := HomeFolder + "unitTbl" // Unit Table
PRIVATE dbFoodGrp := HomeFolder + "foodGrp" // Food Pyramid Group
PRIVATE dbtblFood := HomeFolder + "foodTbl" // Food Table
PRIVATE dbDSgroups := HomeFolder + "usdaDSgroups" // USDA Dietary Source Food Group
PRIVATE dbDSnutr_1 := HomeFolder + "usdaDSnutr_1" // USDA Nutrients Table per 100 gm
PRIVATE dbFdDescr := HomeFolder + "usdaFdDescr" // USDA Food Descriptions
PRIVATE dbDietkcal := HomeFolder + "dietkcal" // Kilo-Calorie Diet Plan Database
PRIVATE dbDietTmpl := HomeFolder + "diettmpl" // Diet Plan (Template) - Used for Food Exchange
PRIVATE dbDietUnit := HomeFolder + "dietsrvu" // Diet Serving Unit Table
PRIVATE dbDietExch := HomeFolder + "dietexch" // Diet Template Food Exchange
PRIVATE dbDietPlan := HomeFolder + "dietplan" // Diet Plan based in Food Exchange and Diet Template
PRIVATE dbPlanDiet := HomeFolder + "dietplanned" // Diet Plan based in Food Exchange and Diet Template
PRIVATE dbPlanExch := HomeFolder + "dietplanexc" // Diet Plan based in Food Exchange and Diet Template
PRIVATE oUser
PRIVATE acPrivilege_ := {"ZZ","ZY","99","98","97","96","95","94","93","92","91","90","89","87","86","85","84"}
PRIVATE acPrivDesc_ := {"Admin Privilege","Power User Priv.","Regular User","Restricted - 98","Restricted - 97",;
"Restricted - 96","Restricted - 95","Restricted - 94","Restricted - 93",;
"Restricted - 92","Restricted - 91","Restricted - 90","Restricted - 89",;
"Restricted - 87","Restricted - 86","Restricted - 85","Restricted - 84"}
PRIVATE acAdminType_ := {"A","P","R","X"}
PRIVATE acAdminDesc_ := {"Admin Account","Power User Account","Regular User Account","Restricted Account"}
PRIVATE lhWndMainActive := .f.
ANNOUNCE RDDSYS
SET FIXED ON
SET DECIMALS TO 2
SET MULTIPLE OFF WARNING
SET DATE AMERICAN
SET CENTURY ON
SET EPOCH TO 1950
SET WRAP ON
SET SCOREBOARD OFF
SET DELETED ON
SET CONFIRM ON
SET BELL ON
SET FONT TO "Arial" , 9
SET NAVIGATION EXTENDED
SET BROWSESYNC ON
SET TOOLTIPSTYLE BALLOON
SET TOOLTIPBACKCOLOR { 255 , 255, 0 }
**SET TOOLTIPFORECOLOR { 0 , 0 , 0 }
RDDSETDEFAULT("DBFCDX")
IF .NOT. VerifyAppFolders()
RELEASE ALL
DBCLOSEALL()
RELEASE WINDOW ALL
QUIT
ENDIF
oUser := UserManager():New( dbDeltaD, dbDeltaI, AppHome, HomeFolder, .t. ) // Toggle Developer's Test Account
IF .NOT. oUser:lStatusOk
MSGSTOP("The Application cannot create folder or read system files due to insufficient rights.","Critical Error")
DBCLOSEALL()
RELEASE WINDOW ALL
QUIT
ENDIF
oUser:cImageHome := ""
oUser:cImageFile := "LOGINPIC"
oDBsession := dbSession():New( TrashFolder, "SESSION" )
DEFINE WINDOW MainForm;
AT 0,0;
WIDTH 548 HEIGHT 378;
TITLE " " + ProductName() ;
ICON "MAINICON";
MAIN;
FONT "Tahoma" SIZE 10;
ON PAINT checkVGAResolution() ;
ON INIT ( MakeFile(), BeginLogon(), WinAutoAdjust( "MainForm" ) );
ON SIZE WinAutoAdjust( "MainForm" );
ON MAXIMIZE WinAutoAdjust( "MainForm" );
ON RELEASE NIL;
ON INTERACTIVECLOSE DestroyWindow()
DEFINE STATUSBAR OF MainForm FONT "Verdana" Size 8
STATUSITEM "Blood Glucose and Blood Pressure Information Systems Version 1.0 - Freeware, " + LegPub();
ICON "EUNICE" RAISED;
TOOLTIP ""
END STATUSBAR
DEFINE SPLITBOX
DEFINE TOOLBAR tbrMain OF MainForm BUTTONSIZE 32, 32 FONT "Arial" SIZE 8
BUTTON btnExit CAPTION "E&xit" PICTURE "IMGEXIT24" ACTION DestroyWindow()
BUTTON btnLogOff CAPTION "Lo&g-off" PICTURE "IMGTBLOG" ACTION ( oUser:Destroy(), BeginLogon() )
END TOOLBAR
DEFINE TOOLBAR tbrMaint OF MainForm BUTTONSIZE 32, 32 FONT "Arial" SIZE 8
BUTTON btnPath CAPTION "Pathology" PICTURE "IMGPATH32" ACTION PathologyCase( "PATHCASE" )
BUTTON btnHealth CAPTION "Health State" PICTURE "HEALTH24" ACTION treeGraphView()
END TOOLBAR
DEFINE TOOLBAR tbrArchive OF MainForm BUTTONSIZE 32, 32 FONT "Arial" SIZE 8 BORDER
BUTTON btnBackup CAPTION "Backup" PICTURE "IMGCOMP32";
ACTION StartBackup();
TOOLTIP "Backup database."
BUTTON btnRestore CAPTION "Restore" PICTURE "IMGRBRES32";
ACTION ( StartRestore(), DbfMakeTableCommon() ) ;
TOOLTIP "Restore database."
BUTTON btnExplore CAPTION "Open Folder" PICTURE "HP_FOLDER";
ACTION ArchiveExplore();
TOOLTIP "Explore archive folder."
END TOOLBAR
END SPLITBOX
DEFINE MAINMENU OF MainForm
DEFINE POPUP "&File"
ITEM FILLER + "Pathology Case Registry" ACTION PathologyCase( "PATHCASE" ) NAME mnPathCase IMAGE "IMGPATH16"
ITEM FILLER + "Health State" ACTION treeGraphView() NAME mnTrGrView IMAGE "HEALTH16"
SEPARATOR
ITEM FILLER + "&User Manager" ACTION oUser:UserProfile() NAME mnUser IMAGE "IMGPEOPLE"
SEPARATOR
ITEM FILLER + "E&xit" ACTION MainForm.Release IMAGE "IMGEXIT16"
END POPUP
DEFINE POPUP "&Help"
ITEM FILLER + "&Contents" ACTION MSGDEBUG( "Active", countActiveForms(),GetDesktopWidth(), GetDesktopHeight(), AppHome + "\ErrVGA.txt", hb_memowrit( "test.txt", "haha" ) )
SEPARATOR
ITEM FILLER + "&About" ACTION AboutBGP()
END POPUP
END MENU
@ 52, 0 IMAGE imgMainBK OF MainForm PICTURE "MAINIMGBK" WIDTH MainForm.ClientAreaWidth HEIGHT ( MainForm.ClientAreaHeight - 25 ) ADJUSTIMAGE //STRETCH
END WINDOW
MainForm.Center()
MainForm.Minimize()
DEFINE WINDOW frmSplash;
AT 0,0;
WIDTH 400 HEIGHT 260;
TITLE "";
TOPMOST NOCAPTION;
ON INIT NIL ;
ON RELEASE MainForm.Maximize()
@ 0,0 IMAGE imgSplash OF frmSplash PICTURE "BGPBANNER" WIDTH 400 HEIGHT 260 STRETCH
END WINDOW
frmSplash.Center()
lhWndMainActive := .t.
ACTIVATE WINDOW frmSplash, MainForm
oDBsession:Destroy()
DestroyWindow()
RETURN NIL
*******************************
static procedure SplashDelay()
LOCAL nTimeDelay := 0
nTimeDelay := SECONDS()
DO WHILE SECONDS() - nTimeDelay < 2
ENDDO
frmSplash.Release
RETURN NIL
****************************
static function BeginLogon()
LOCAL LoginCancelled
MainForm.tbrMain.btnExit.Enabled := .f.
MainForm.tbrMain.btnLogOff.Enabled := .f.
MainForm.tbrMaint.btnPath.Enabled := .f.
MainForm.tbrArchive.btnBackup.Enabled := .f.
MainForm.tbrArchive.btnRestore.Enabled := .f.
MainForm.tbrArchive.btnExplore.Enabled := .f.
MainForm.imgMainBK.Hide()
LoginCancelled := oUser:UserLogin()
IF oUser:AccessDenied
MSGSTOP( "Excessive log-on tries is not allowed. Program will be terminated.","Access Denied")
DestroyWindow()
ENDIF
MainForm.Title := IIF( EMPTY( oUser:currentUser() ), MainForm.Title, " " + ProductName() + " - [User: " + PROPERCASE( oUser:currentUser() ) + ;
" on " + GETENV( "COMPUTERNAME" ) + " as " + UPPER( GETENV( "USERNAME" ) ) + " ]" )
IF LoginCancelled = FALSE
DestroyWindow()
ENDIF
IF alltrim( oUser:aUserInfo_[ 1 ] ) == "ADMIN"
MainForm.mnUser.Enabled := TRUE
ELSE
MainForm.mnUser.Enabled := FALSE
ENDIF
MainForm.tbrMain.btnExit.Enabled := .t.
MainForm.tbrMain.btnLogOff.Enabled := .t.
MainForm.tbrMaint.btnPath.Enabled := .t.
MainForm.tbrArchive.btnBackup.Enabled := .t.
MainForm.tbrArchive.btnRestore.Enabled := .t.
MainForm.tbrArchive.btnExplore.Enabled := .t.
MainForm.imgMainBK.Show()
RETURN NIL
*******************************
static function DestroyWindow()
DBCLOSEALL()
DaleAid_DelTempFile( "*.*", TrashFolder )
IF countActiveForms() > 2 // It must be 2 instead of one maybe because of the splash window and or perhaps HMG Lib is using a hidden window.
// However it seems that _HMG_SYSDATA [68] is related to windows release and interactive close event.
lPanicState := .t. // toggle panic state ON
ENDIF
RELEASE ALL
RELEASE WINDOW ALL
QUIT
********************************************************************************
** Function: countActiveForms() **
** Purpose: Count how many forms are active. **
** **
** Syntax: **
** **
** Arguments: **
** **
** Returns: Returns the number of active forms, including those that are **
** minimized and those behind the visible windows. **
** **
** Notes: Document source, see <hmg>\source\h_init.prg **
** _HMG_SYSDATA [ 65 ] -> _HMG_aFormDeleted **
** _HMG_SYSDATA [ 66 ] -> _HMG_aFormNames **
** _HMG_SYSDATA [ 67 ] -> _HMG_aFormHandles **
** _HMG_SYSDATA [ 68 ] -> _HMG_aFormActive **
** _HMG_SYSDATA [ 69 ] -> _HMG_aFormType **
** _HMG_SYSDATA [ 70 ] -> _HMG_aFormParentHandle **
** **
********************************************************************************
function countActiveForms()
LOCAL ii := 0
LOCAL nCount := 0
FOR ii := 1 TO LEN( _HMG_SYSDATA [ 68 ] )
IF _HMG_SYSDATA [ 68, ii ] == .t.
nCount++
ENDIF
NEXT
RETURN nCount
************************
Function ISAPPXPTHEMED()
RETURN ( OS_ISWINXP_OR_LATER() .AND. IsAppThemed() )
******************************************
function WinAutoAdjust( cForm, lMaxEvent )
LOCAL hWnd := GetFormHandle( cForm )
LOCAL i // Form Number
LOCAL k // Control Number
LOCAL ParentForm
LOCAL ControlCount
LOCAL ControlName
LOCAL ControlType
LOCAL nWidth
LOCAL nHeight
LOCAL lvisible:= .T.
LOCAL nDivw
LOCAL nDivh
DEFAULT lMaxEvent TO .f.
IF .NOT. lhWndMainActive
RETURN NIL
ENDIF
IF GetDesktopWidth() < GetWindowWidth ( hWnd )
nWidth := GetDesktopWidth()
ELSE
nWidth := GetWindowWidth ( hWnd )
ENDIF
IF GetDesktopHeight() < GetWindowHeight ( hWnd )
nHeight := GetDesktopHeight()
ELSE
nHeight := GetWindowHeight ( hWnd )
ENDIF
IF IsWindowVisible ( hWnd ) .And. ! IsAppXPThemed()
HideWindow ( hWnd )
ELSE
lvisible := .F.
ENDIF
i := ASCAN ( _HMG_SYSDATA[ 67 ] , hWnd )
ParentForm := _HMG_SYSDATA[ 66, i ]
IF _HMG_SYSDATA[ 92, i ] > 0 .and. _HMG_SYSDATA[ 91, i ] > 0
nDivw := nWidth / _HMG_SYSDATA[ 92, i ]
nDivh := nHeight / _HMG_SYSDATA[ 91, i ]
ELSE
nDivw := 1
nDivh := 1
ENDIF
ControlCount := LEN ( _HMG_SYSDATA[ 3 ] )
FOR k := 1 To ControlCount
ControlName := _HMG_SYSDATA[ 2, k ]
IF _IsControlDefined ( ControlName, ParentForm )
ControlType := _HMG_SYSDATA[ 1, k ]
IF !EMPTY( ControlName ) .AND. ;
!( ControlType $ "MENU,HOTKEY,TOOLBAR,MESSAGEBAR,ITEMMESSAGE,TIMER" )
DO CASE
//CASE ControlType == "RADIOGROUP"
// _HMG_aControlSpacing := _HMG_SYSDATA[ 22 ]
// _HMG_aControlMiscData1 := _HMG_SYSDATA[ 8 ]
// _HMG_aControlSpacing [k] := _HMG_aControlSpacing [k] * IIF(_HMG_aControlMiscData1 [k], nDivw, nDivh)
CASE ControlType == "SLIDER" // do nothing
CASE ControlType == "STATUSBAR" // do nothing
CASE ControlType == "LABEL"
_SetControlSizePos( ControlName, ParentForm,;
_GetControlRow( ControlName, ParentForm ) * nDivh, ; // row
_GetControlCol ( ControlName, ParentForm ) * nDivw ,; // column
_GetControlWidth( ControlName, ParentForm ) * nDivw,; // with
_GetControlHeight ( ControlName, ParentForm ) ) // height
CASE ControlType $ "TEXT,RADIOGROUP"
_SetControlSizePos( ControlName, ParentForm,;
_GetControlRow( ControlName, ParentForm ) * nDivh, ; // row
_GetControlCol ( ControlName, ParentForm ) * nDivw ,; // column
_GetControlWidth( ControlName, ParentForm ) * nDivw,; // with
_GetControlHeight ( ControlName, ParentForm ) ) // height
CASE ControlType == "BUTTON"
IF !_GetControlRow( ControlName, ParentForm ) == NIL .AND. ;
!_GetControlCol ( ControlName, ParentForm ) == NIL
_SetFontSize ( ControlName, ParentForm , 9 )
_SetControlSizePos( ControlName, ParentForm,;
_GetControlRow( ControlName, ParentForm ) * nDivh, ;
_GetControlCol ( ControlName, ParentForm ) * nDivw ,;
_GetControlWidth( ControlName, ParentForm ) * nDivw,;
_GetControlHeight ( ControlName, ParentForm ) ) // _GetControlHeight ( ControlName, ParentForm ) * nDivh )
ENDIF
CASE !ControlType $ "TOOLBUTTON"
_SetControlSizePos ( ControlName, ParentForm,;
_GetControlRow ( ControlName, ParentForm ) * nDivh, _GetControlCol ( ControlName, ParentForm ) * nDivw,;
_GetControlWidth ( ControlName, ParentForm ) * nDivw, _GetControlHeight ( ControlName, ParentForm ) * nDivh )
OTHERWISE
IF EMPTY( _HMG_SYSDATA[ 28, k ] )
_SetFontSize ( ControlName, ParentForm , 8 * nDivh )
ELSE
//_SetFontSize ( ControlName, ParentForm , _HMG_SYSDATA[28] [k] * nDivh )
ENDIF
ENDCASE
ENDIF
ENDIF
NEXT k
//MSGDEBUG( "Widths", GetDesktopWidth(), GetWindowWidth ( hWnd ), "Height",;
// GetDesktopHeight(), GetWindowHeight ( hWnd ),;
// GetDesktopWidth() < GetWindowWidth ( hWnd ),;
// GetDesktopHeight() < GetWindowHeight ( hWnd ),;
// ParentForm, nWidth, nHeight, _HMG_SYSDATA[ 92, i ], _HMG_SYSDATA[ 91, i ])
_HMG_SYSDATA[ 92, i ] := nWidth
_HMG_SYSDATA[ 91, i ] := nHeight
MainForm.imgMainBK.Hide()
MainForm.imgMainBK.Row := 52
MainForm.imgMainBK.Width := MainForm.ClientAreaWidth
MainForm.imgMainBK.Height := MainForm.ClientAreaHeight - 75
MainForm.imgMainBK.Show()
IF lvisible
ShowWindow ( hWnd )
ENDIF
RETURN NIL
********************************
static function ArchiveExplore()
EXECUTE FILE "explorer" PARAMETERS ArchiveHome
RETURN NIL
Here's my beginlogon() windows definition.