adjustment of the Bar, und changed the 2. oDlg in oDlg1 ( double define )
...
...
The bar now fits exactly the space between top and bottom.
, .f. ) ;
Code: Select all | Expand
#INCLUDE "FIVEWIN.CH"
STATIC oWInd // main mdi window
STATIC oBmap // mdi window .bmp
STATIC lExitPgm := .F.
STATIC xMESSAGE
//----------------------------------
FUNC MAIN()
LOCAL cDEFA,nLEN,cFILE,cRIGHTS,SAYING,mSTART,aDIR,cRDD
LOCAL cREAD,cWRITE,cSUPER,cOLDDEFA,cADMIN
LOCAL nPOS,cLOGIN,dEXE
LOCAL nYEAR,nSCR1,nSCR2,aVER
LOCAL oICO, oRs, cSQL, oErr, cPROG
LOCAL lOK, oDLG, cINIFILE, cERR
LOCAL TEXT_EOF, BYTES_READ,cTEXT,nHANDLE
LOCAL oSAY, cSAY
PUBLIC xVOL := "C:", xREAD,xWRITE,xLOGIN,xSUPER,xADMIN
PUBLIC xPROVIDER, xSOURCE, xCATALOG, xUSERID, xPASSWORD, xPROGID
PUBLIC xTABLE, xHOLD_TABLE, xQUE_TABLE
//--------------
PARAMETERS xTEXT
REQUEST DBFCDX
rddsetdefault ( "DBFCDX" )
xREAD := " "
xWRITE := " "
xLOGIN := " "
xSUPER := " "
xPROGID := " "
xADMIN := " "
xPROVIDER := "SQLOLEDB"
*xSOURCE := "MSSQL01"
xSOURCE := "LWMWEBDB01"
xCATALOG := "PCAS"
xUSERID := "pcasuser"
xPASSWORD := "pcas"
nSCR1 := GetSysMetrics(0)
nSCR2 := GetSysMetrics(1)
//-- get timestamp on .exe //
cFILE := GetModuleFileName( GetInstance() )
aDIR := DIRECTORY( cFILE )
dEXE := aDIR[1] [3]
// where .exe started from is default directory //
mSTART := RAT( "\", cFILE )
cDEFA := SUBSTR(cFILE,1,mSTART-1)
aDIR := NIL
SET DEFA to ( cDEFA )
cOLDDEFA := cDEFA
cRDD := xPROVIDER+" on "+xSOURCE+" 32 bit -b x86"
SET DELETED on
SET CENTURY on
SET 3DLOOK on
nYEAR := ( year( DATE() )-5 )
SET EPOCH to ( nYEAR )
// test for TEXT mode /NL for no logo
IF EMPTY( xTEXT )
xTEXT := " "
ENDIF
xTEXT := ALLTRIM( UPPER(xTEXT))
xLOGIN := WNetGetUser() // FiveWin function
xLOGIN := UPPER( xLOGIN )
xLOGIN := xLOGIN+SPACE(8)
xLOGIN := SUBSTR(xLOGIN,1,8)
xWRITE := 'Y'
xSUPER := 'Y'
xADMIN := 'Y'
cRIGHTS := _Rights()
//----- main menu -------//
xMESSAGE := "User "+xLOGIN+" Rights "+cRIGHTS+ ;
" Default= "+cDEFA+" Rdd= "+cRDD+ ;
" Revision "+DTOC(dEXE)+;
" -r"+str(nSCR1,4)+" x "+STR(nSCR2,4)
*DEFINE ICON oICO RESOURCE "COUPLE"
DEFINE WINDOW oWind ;
FROM 0,2 to 28,78 ;
TITLE "PCAS Time and Data entry Program" ;
MENU BuildMenu(); //cOLDDEFA,dEXE,cRDD,nSCR1,nSCR2,oWind) ;
MDI
DEFINE BITMAP oBMAP FILENAME (cOLDDEFA+"\PCAS.BMP") of oWind
SET MESSAGE OF oWind ;
to xMESSAGE CLOCK
ACTIVATE WINDOW oWind ;
MAXIMIZED ;
ON PAINT ( _BackGround( hDC, oBmap, nSCR1, nSCR2, oWind, xTEXT ) );
ON INIT ( _Bar( oWind ) ) ;
VALID ( IF( !lExitPgm, ExitPgm( .T. ) , .F. ) )
RETURN( NIL )
//--------------------------
Static Func _BackGround( hDC, oBmap, nSCR1, nSCR2, oWind, xTEXT )
IF xTEXT = "/NL"
ELSE
PalBmpDraw( hDC, 0,0, oBMAP:hBitmap, oBMAP:hPalette, nSCR1, nSCR2 )
ENDIF
RETURN(NIL)
//--------------------------
Static Func _Bar( oWnd )
LOCAL aGRAD, oDLG, oBTN_1, oBTN2, oSAY, cSAY
LOCAL nWIDTH, nHEIGHT, nTOP
nWidth := GetSysMetrics(0)
nHeight := GetSysMetrics(1)
nTop := GetSysMetrics(30)
cSAY := "PCAS"+chr(10)
cSAY += "Data Entry"+chr(10)
DEFINE DIALOG oDLG ;
FROM 0,0 to 100,100 of oWnd ;
STYLE nOR( WS_OVERLAPPED | WS_VISIBLE ) PIXEL TRANSPARENT
@ 20, 0 BTNBMP oBTN_1 RESOURCE "STATS" ;
SIZE 32,40 adjust ;
NOBORDER ;
PROMPT cSAY CENTER of oDLG ;
ACTION ( oBTN_1:Hide(), _Utilmenu(oDlg, oBTN_1 ))
* ACTION ( _calendar( DATE(),oWND, oBTN1 ))
oBtn_1:lTransparent = .T.
oBtn_1:cTooltip := "PCAS Data Entry"
cSAY := "PCAS"+chr(10)
cSAY += "Data Entry"+chr(10)
* @ 2.5, 0 SAY cSAY OF oDlg COLOR "N/N"
* oDlg:aControls[ 2 ]:lTransparent = .t.
*aGrad := { { 0.1, 10389063, 16777215 },{ 0.1, 16777215, 10389063 } } // blue
aGRAD := {{ 1.0, 16777215,7518392},{ 1.00, 7518392, 16777215 }} // yellow
* @ 5,0 BUTTON oBTN2 PROMPT "Test" of oDLG ;
* SIZE 32,40 ;
* ACTION MsgInfo( "test" )
ACTIVATE DIALOG oDlg CENTERED NOWAIT ;
ON INIT oDlg:Move( 40, nWidth - 65, 70, nHeight - 95, .f. ) ;
ON PAINT ( GRADBAR( hDC, oDlg ), ;
GradientBrush( oDlg, aGrad, .F. ) )
RETURN( NIL )
// ------- Fills the Buttons with Gradient-Background ----------
// ------ otherwise the Buttons are displayed with a white Color --
Static FUNCTION GradientBrush( oDlg, aColors , lDir)
local hDC, hBmp, hBmpOld , nWidth , nHeight
DEFAULT lDir := .T.
if Empty( oDlg:oBrush:hBitmap )
nHeight := if(lDir,oDlg:nHeight,1)
nWidth := if(lDir,1,oDlg:nWidth)
hDC = CreateCompatibleDC( oDlg:GetDC() )
hBmp = CreateCompatibleBitMap( oDlg:hDC, nWidth, nHeight )
hBmpOld = SelectObject( hDC, hBmp )
GradientFill( hDC, 0, 0, nHeight, nWidth, aColors,lDir )
DeleteObject( oDlg:oBrush:hBrush )
oDlg:oBrush:hBitmap = hBmp
oDlg:oBrush:hBrush = CreatePatternBrush( hBmp )
SelectObject( hDC, hBmpOld )
oDlg:ReleaseDC()
endif
RETURN NIL
// ---------- Fills the Bar with Gradient ---------------------
STATIC FUNCTION GRADBAR( hDC, oDlg )
local aGrad
*aGrad := { { 0.1, 10389063, 16777215 },{ 0.1, 16777215, 10389063 } } // blue
aGRAD := {{ 1.0, 16777215,7518392},{ 1.00, 7518392, 16777215 }}
GradientFill( hDC, 0, 0, oDlg:nHeight + 10, oDlg:nWidth, aGrad, .F. ) // yellow
RETURN NIL
//
ACTIVATE WINDOW oWind ;
MAXIMIZED ;
ON PAINT ( IF( xTEXT = "/NL", ,PalBmpDraw( hDC, 0,0, oBMAP:hBitmap, oBMAP:hPalette, nSCR1, nSCR2 )));
ON INIT ( IF( xTEXT = "/NL", , MSGLOGO( cDEFA+"\SPLASH.BMP",2 )), ;
oWIND:Select(), oWIND:Refresh() ) ;
VALID ( IIF( !lExitPgm, ExitPgm( .T. ) , .F. ))
RETURN( NIL )
//---------------------------
Static Func _Rights()
LOCAL cREAD,cWRITE,cSUPER,cADMIN,cRIGHTS
STORE " " to cWRITE,cSUPER,cADMIN
cREAD := "R"
IF xWRITE = 'Y'
cWRITE := "W"
ENDIF
IF xSUPER = "Y"
cSUPER := "S"
ENDIF
IF xADMIN = "Y"
cADMIN := "A"
ENDIF
IF cWRITE = " " .and. cSUPER = " " .and. cADMIN = " "
cRIGHTS := "(READ)"
ELSE
cRIGHTS := "("+cREAD+cWRITE+cSUPER+cADMIN+")"
ENDIF
RETURN( cRIGHTS )
//--------------------------//
Static FUNC BuildMenu() // cOLDDEFA, dEXE, cRDD,nSCR1,nSCR2,oWnd )
LOCAL oMenu, cRIGHTS, cDEFA
cDEFA := SET(7)
MENU oMenu
MENUITEM " "
/*
MENUITEM "&Pcas Data Entry ..." ;
ACTION Msginfo( "Menu 1") ;
MESSAGE "PCAS Data Entry"
MENUITEM "&Reports ..." ;
ACTION( _Rptmenu( oWnd )) ;
MESSAGE "Report Menu"
MENUITEM "&Utilities..." ;
ACTION( _UTILmenu( oWnd ) ) ;
MESSAGE "Utilities Programs"
MENUITEM "&Coordinator.." ;
ACTION Msginfo( "Menu 4") ;
MESSAGE "Coordinators Menu"
MENUITEM "&Login Diff User .." ;
ACTION Msginfo( "Menu 5") ;
MESSAGE "Login as a different User"
MENUITEM "&Intranet PCAS Manual .." ;
ACTION Msginfo( "Menu 6") ;
MESSAGE "PCAS Help on the DHECNET"
MENUITEM "&Quit" ;
ACTION oWiND:END() ;
MESSAGE "End this Program"
*/
ENDMENU
RETURN( oMenu )
//-----------------------
Static FUNCTION ExitPgm( lCLEAN )
IF lCLEAN = .T.
lExitPgm := .T.
SET RESOURCES to
SysReFresh()
ENDIF
RETURN( lExitPgm )
//----------------------------------
Static FUNC _utilmenu( oDlg, oBtn_1 )
LOCAL oWndChild, oDlg1, oBtn1, oBTN2, oBTN3, oBTN4, oBTN5, oBTN6
LOCAL oBTN7, oBTN8, oICO, aGrad
aGrad := { { 1.0, 16777215, nRGB(4,53,107) },{ 1.0, nRGB(4,53,107), 16777215 } }
DEFINE DIALOG oDlg1 RESOURCE "UTILMENU" ; // OF oWndChild ;
TITLE "Utility Menu"
REDEFINE BUTTON oBtn1 ID 101 OF oDlg1 ;
ACTION ( Msginfo( "Indexing not required for SQL" ))
REDEFINE BUTTON oBtn2 ID 102 OF oDlg1 ;
ACTION ( MsgInfo( "Menu 2" )) // , _UtilBrow( oWnd ) )
REDEFINE BUTTON oBtn3 ID 103 OF oDlg1 ;
ACTION ( MsgInfo( "Menu 3" )) //,_empbrow( oWnd ) )
REDEFINE BUTTON oBtn4 ID 104 OF oDlg1 ;
ACTION ( MsgInfo( "Menu 3" )) //, _grpbrow( oWnd ) )
REDEFINE BUTTON oBtn5 ID 105 OF oDlg1 ;
ACTION ( MsgInfo( "Menu 4" )) //,_FyppBrow( oWnd ) )
REDEFINE BUTTON oBtn6 ID 106 OF oDlg1 ;
ACTION( MsgInfo( "Menu 5" )) //,_Purge() )
REDEFINE BUTTON oBtn7 ID 107 OF oDlg1 ;
ACTION( MsgInfo( "Menu 6" )) //, _HoliBrow(oWnd) )
REDEFINE BUTTON oBtn8 ID 108 OF oDlg1 ;
ACTION( oDlg1:End(), dbCloseAll(), oBtn_1:Show() )
ACTIVATE DIALOG oDlg1 NOWAIT ;
ON PAINT GradientFill( hDC, 0, 0, oDlg1:nHeight, oDlg1:nWidth, aGrad, .T. ) ;
ON INIT oDlg1:Move( 100 , 400, oDlg1:nWidth, oDlg1:nHeight, .f. )
* VALID ( oDlg:End(), .t. )
RETURN(NIL)
//-- END
// end main.prg
