// main.prg
#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, cSAY1
PUBLIC xVOL := "C:", xREAD,xWRITE,xLOGIN,xSUPER,xADMIN
PUBLIC xPROVIDER, xSOURCE, xCATALOG, xUSERID, xPASSWORD, xPROGID
PUBLIC xTABLE, xHOLD_TABLE, xQUE_TABLE
PUBLIC xGRAD1, xGRAD2, xGRAD3, xGRAD4, xGRAD5, xGRAD6
//--------------
PARAMETERS xTEXT
REQUEST DBFCDX
rddsetdefault ( "DBFCDX" )
xREAD := " "
xWRITE := " "
xLOGIN := " "
xSUPER := " "
xPROGID := " "
xADMIN := " "
xPROVIDER := "SQLOLEDB"
*xSOURCE := "MSSQL01"
xSOURCE := "LWMWEBDB01"
xCATALOG := "PCAS"
xUSERID := "pcasuser"
xPASSWORD := "pcas"
// Main gradients here
xGrad1 := {{ 0.80, 14671839, 4144959 },{ 0.1, 4144959, 14671839 }} // grey top down
xGrad2 := {{ 0.80, 4144959, 14671839 },{ 0.1, 14671839, 4144959 }} // grey bottom up
xGrad3 := {{ 0.80, 16777215, 7518392 },{ 0.1, 7518392, 16777215 }} // yellow top down
xGrad4 := {{ 0.80, 7518392, 16777215 },{ 0.1, 16777215, 7518392 }} // yellow bottom up
xGRAD5 := {{ 0.80, 12615680, 8388608 },{ 0.80,8388608, 12615680 }} // blue light top down
xGRAD6 := {{ 0.80, 8388608, 12615680 },{ 0.80,12615680, 12615680 }} // blue light bottom up
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 winapi wrapper
xLOGIN := UPPER( xLOGIN )
//-------------------------
cDEFA := SET(7) // set the local default path
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() ;
ICON oICO ;
MDI
DEFINE BITMAP oBMAP FILENAME (cOLDDEFA+"\PCAS.BMP") of oWind
SET MESSAGE OF oWind ;
to xMESSAGE CLOCK
// key handler to trap key strokes ESC to quit //
// oWind:bKeyDown := {|nKey| IF(nKEY = 27, oWIND:END(), ) }
ACTIVATE WINDOW oWind ;
MAXIMIZED ;
ON PAINT ( _BackGround( hDC, oBmap, nSCR1, nSCR2, oWind, xTEXT ) );
ON INIT ( _Bar( oWind,cOLDDEFA,dEXE,cRDD,nSCR1, nSCR2 ) ) ;
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,cOLDDEFA,dEXE,cRDD,nSCR1, nSCR2 )
LOCAL oDLG, oBtnPcas, oBtnRpt, oBtnUtil, oBtnCoor, oBtnLog, oBtnHlp, oBtnQuit
LOCAL cSAY1, cSAY2, cSAY3, cSAY4, cSAY5, cSAY6, cSAY7
LOCAL nWIDTH, nHEIGHT, nTOP, cDEFA
cDEFA := SET(7)
nWidth := GetSysMetrics(0)
nHeight := GetSysMetrics(1)
nTop := GetSysMetrics(30)
cSAY1 := "PCAS"+chr(10)
cSAY1 += "Data Entry"+chr(10)
cSAY2 := "REPORT"+chr(10)
cSAY2 += "Menu"+chr(10)
cSAY3 := "UTILITY"+chr(10)
cSAY3 += "Menu"+chr(10)
cSAY4 := "Co-"+CHR(10)
cSAY4 += "Ordinator"+chr(10)
cSAY5 := "Login"+CHR(10)
cSAY5 += "Diff User"+chr(10)
cSAY6 := "Intranet"+CHR(10)
cSAY6 += "Help"+chr(10)
cSAY7 := "QUIT"
DEFINE DIALOG oDLG ;
FROM 0,0 to 100,100 of oWnd ;
STYLE nOR( WS_OVERLAPPED | WS_VISIBLE ) PIXEL TRANSPARENT
@ 20, 0 BTNBMP oBtnPcas RESOURCE "PCASADD" ;
SIZE 32,32 ;
PROMPT cSAY1 CENTER of oDLG // ;
* ACTION ( _calendar( DATE(),oWND, oBtnPcas, oBtnRpt,oBtnUtil, oBtnCoor, oBtnLog ))
oBtnPcas:SetColor( "W+/W" )
oBtnPcas:ReFresh()
SysReFresh()
oBtnPcas:lTransparent = .T.
oBtnPcas:cTooltip := "PCAS Data Entry"
@ 60, 0 BTNBMP oBtnRpt RESOURCE "REPORT" ;
SIZE 32,32 ;
PROMPT cSAY2 CENTER of oDLG ;
ACTION ( _Rptmenu( oWND, oBtnPcas, oBtnRpt,oBtnUtil, oBtnCoor, oBtnLog ))
oBtnRpt:SetColor( "W+/W" )
oBtnRpt:ReFresh()
SysReFresh()
oBtnRpt:lTransparent = .T.
oBtnRpt:cTooltip := "REPORT Menu"
@ 100, 0 BTNBMP oBtnUtil RESOURCE "UTILITY" ;
SIZE 32,32 ;
PROMPT cSAY3 CENTER of oDLG // ;
* ACTION ( _Utilmenu( oWND, oBtnPcas, oBtnRpt,oBtnUtil, oBtnCoor, oBtnLog ))
oBtnUtil:SetColor( "W+/W" )
oBtnUtil:ReFresh()
SysReFresh()
oBtnUtil:lTransparent = .T.
oBtnUtil:cTooltip := "UTILITY Menu"
@ 140, 0 BTNBMP oBtnCoor ;
SIZE 32,32 ;
PROMPT cSAY4 CENTER of oDLG RESOURCE "ORGANIZE" // ;
* ACTION ( _CoorMenu( oWND, oBtnPcas, oBtnRpt,oBtnUtil, oBtnCoor, oBtnLog ))
oBtnCoor:SetColor( "W+/W" )
oBtnCoor:ReFresh()
SysReFresh()
oBtnCoor:lTransparent = .T.
oBtnCoor:cTooltip := "COORDINATOR Menu"
@ 180, 0 BTNBMP oBtnLog RESOURCE "LOGIN" ;
SIZE 32,32 ;
PROMPT cSAY5 CENTER of oDLG // ;
* ACTION( _Log_in(), ;
* cRIGHTS := _Rights(), ;
* xMESSAGE := ("User "+xLOGIN+" Rights "+cRIGHTS+ ;
* " Default= "+cDEFA+" Rdd= "+cRDD+ ;
* " Revision "+DTOC(dEXE)+ ;
* " -r"+str(nSCR1,4)+" x "+STR(nSCR2,4) ),;
* oWnd:oMsgBar := TMsgBar():New(oWnd,xMESSAGE,.F.,.T.,.F.,.F.,,,,),;
* oWnd:ReFresh(),;
* MsgInfo( "Current User is now "+xLOGIN ),;
* SysReFresh() ) ;
oBtnLog:SetColor( "W+/W" )
oBtnLog:ReFresh()
SysReFresh()
oBtnLog:lTransparent = .T.
oBtnLog:cTooltip := "Login as a different User"
@ 220, 0 BTNBMP oBtnHlp RESOURCE "INFO" ;
SIZE 32,32 ;
PROMPT cSAY6 CENTER of oDLG // ;
* ACTION ( _Webhelp( cOLDDEFA, dEXE ))
oBtnHlp:SetColor( "W+/W" )
oBtnHlp:ReFresh()
SysReFresh()
oBtnHlp:lTransparent = .T.
oBtnHlp:cTooltip := "Help on the Intranet"
@ 260, 0 BTNBMP oBtnQuit RESOURCE "CLOSE" ;
SIZE 32,32 ;
PROMPT cSAY7 CENTER of oDLG ;
ACTION ( oWND:END() )
oBtnQuit:SetColor( "W+/W" )
oBtnQuit:ReFresh()
SysReFresh()
oBtnQuit:lTransparent = .T.
oBtnQuit:cTooltip := "Close PCAS"
ACTIVATE DIALOG oDlg CENTERED NOWAIT ;
ON INIT oDlg:Move( 20, nWidth - 65, 70, nHeight - 75, .f. ) ;
ON PAINT ( GRADBAR( hDC, oDlg ), GradientBrush( oDlg, xGrad1, .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
// main gradient
GradientFill( hDC, 0, 0, oDlg:nHeight + 10, oDlg:nWidth, xGrad1, .F. )
// Must be painted on top of the main-Gradient !!!
*GradientFill( hDC, 0, 0, oDlg:nHeight, 10, xGradstrip, .F. )
RETURN NIL
//---------------------------
Static Func _Rights()
LOCAL cREAD,cWRITE,cSUPER,cADMIN,cRIGHTS
STORE " " to cREAD,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 " "
ENDMENU
RETURN( oMenu )
//-----------------------
Static FUNCTION ExitPgm( lCLEAN )
IF lCLEAN = .T.
lExitPgm := .T.
SET RESOURCES to
CLOSE DATABASES
ENDIF
RETURN( lExitPgm )
// end main.prg
