******************************************************************************* * * Module: ClickDate.prg * Category: Program, Calendar * Used By: General: Utility. * * Purpose: To provide a date selection solution satisfying the * return requirements for a date Get field, Sle field * or a date variable. DoubleClick on a Get or Sle * invokes the calendar. * * Author: Greg Doran, Dublin Ireland. GDO@eircom.net * Version: 1.40 * Date: 17th.Oct.2002 * Language: Xbase++ 1.8, 1.7, ? * Compile: Standard. * Link: Standard. * * Versions: All version No.s are as indicated below: * * (In ClickDate.Zip) * Requires: ClickDate.ch v1.40 * ClickDate.arc v1.30 * ClickDate.prg (This program) v1.40 * Resource2.Zip (Resource files) * Usage: ClickDate.txt (See for details.) v1.40 * * Test/Demo: ClickTest.prg (Test Code / Demo only) * ClickDate.xpj (Required to compile as a demo only) * * Compile as Demo: Pbuild ClickDate * EXE: ClickDate.exe * ******************************************************************************* * Find these here.... * Requires: * (Not In XBPGET.PRG (C:\Alaska\Xppw32\SOURCE\samples\solution\xbpget\) * ZipFile) XBPGETC.PRG (C:\Alaska\Xppw32\SOURCE\samples\solution\xbpget\) * ******************************************************************************* * ******************************************************************************* * * Copyright (c) Greg J Doran. 2001-2002 GDO@eircom.net * * This code is released under the GNU General Public Licence * and is governed by the conditions and protocols setout therein. * * The code is provided "as is", without warranty of any kind, * either expressed, or implied, including, but not limited to, * the implied warranties of merchantability and fitness for a * particular purpose. The entire risk as to the quality of this * software, its use or misuse, modified or otherwise, lies with * you, the recipient. * *********************************************************************** * * Revision History: * ================= * Rev 1.20 8th.Sep.2001 * Initial release. * * Rev 1.30 6th.Oct.2002 * Modified general text for release to the Public Domain. * * Rev 1.40 17th.Oct.2002 * Added: accidentally deleted code to Keyhandler. * (+/- 5 years, using keyboard) * * Made: minor changes to general text. * * In FUNCTION CellHilite() * WAS: lTurnOn := .T. (Does not affect calendar) * IS: lTurnOn := xOnOff * * In Clickdate.ch * Added: USENGLISH definitions. * *********************************************************************** * ********************************************************************** #include "xbp.ch" #include "Appevent.ch" #include "Gra.ch" #include "common.ch" #include "Nls.ch" #include "font.ch" #include "dll.ch" //#pragma Library( "XppUi2.lib" ) //Some char. sets require this. * // #define USENGLISH // #define ENGLISH #define GERMAN //04.01.2008 17:47 ak * ****** CLICKDATE.CH MUST FOLLOW LANGUAGE DEFINITION * #include "ClickDate.ch" *********************************************************************** * * FUNCTION ClickDate() * * Returns: Date selected * *********************************************************************** * FUNCTION ClickDate(dDateIn,oOwner,oDateField ) LOCAL aAbsPosXY := {nil,nil} LOCAL bKeyboard := {|| nil } LOCAL i := 0 LOCAL lDateField := .F. LOCAL lError := .F. LOCAL lExit := .F. LOCAL mp1 := 0 LOCAL mp2 := 0 LOCAL nBitmap := 0 LOCAL nEvent := 0 LOCAL o LOCAL oDa LOCAL oDlg LOCAL oLastFocus LOCAL oXbp LOCAL lFlucht := .F. //04.01.2008 17:59 ak //04.01.2008 17:21 ak: geREMt: SET EPOCH TO 1980 ****************************************************** ****** This program uses the british date format to ****** process the date data and it is only necessary ****** that the exit/return formats be defined. ****** Define exit formats in ClickDate.ch ****** Leave this section 'as is' ****** DO NOT CHANGE OR ROUTINE WILL NOT WORK ***** ****************************************************** // 04.01.2008 17:23 ak: bereits in AppName() gesetzt! : //SET DATE FORMAT TO "DD/MM/YYYY" //SET DATE BRITISH //SET CENTURY ON #ifndef MINDATE #define MINDATE CtoD(CMINDATE) #ENDIF * ***** ************************************************************************* * * Was an Owner passed? If not, READ THE WARNING!! THIS IS A MODAL WINDOW. * (Warning is in ClickDate.txt) * DEFAULT oOwner TO setAppWindow() oLastFocus := setAppFocus() ************************************************************************ * * Is it a Date Get/Sle field? * IF !(ValType(oDateField)=="U") .AND. oDateField:currentSize()[2] < 30 //04.01.2008 17:38 ak 25 o:= oDateField // Based on height the Object is a Sle/Get field. lDateField:= .T. ENDIF * ************************************************************************ * ************************************************************************ * * Was Date passed? * DEFAULT dDateIn TO " / / " IF EMPTY(dDateIn) dDateIn := " / / " ENDIF ***** Check Date and if error or invalid change to CtoD(" / / ") ***** No messages, done by stealth.... IF ValType(dDateIn)=="C" Do While .T. IF !(Substr(dDateIn,3,1)== '/' .AND. Substr(dDateIn,6,1)== '/') lError:= .T. EXIT ELSE FOR i:= 1 to Len(dDateIn) IF !(Substr(dDateIn,i,1)$"0123456789 /") lError:= .T. EXIT ENDIF NEXT i ENDIF EXIT ENDDO IF lError dDateIn:= CtoD(" / / ") ELSE dDateIn:= IsDateValid(Val(SubStr(dDateIn,1,2)),; Val(SubStr(dDateIn,4,2)),; Val(SubStr(dDateIn,7,; IIF(Len(dDateIn)==10,4,2)))) ENDIF ENDIF dOrigDate := IIF( ValType( dDateIn ) == 'D',; dDateIn,; CtoD(" / / ") ) dCurrDate := IIF( ValType( dDateIn ) == 'D' .AND.; " "$DtoC(dDateIn ),; Date(),; dDateIn ) * ************************************************************************ ************************************************************************ * * CREATE DIALOG * aSize := { 261,180} IF lDateField ***** Where is the field positioned? ***** o:GetPosition() returns a client reference (parent's 0,0) ***** We need an absolute reference, so using a DLL Call aAbsPosXY:= GetAbsPos(oDateField) *** GetX + Calendar width < Horiz. Resolution IF aAbsPosXY[1] +aSize[1] < appDeskTop():currentSize()[1] aPos[1]:= aAbsPosXY[1] ELSEIF aAbsPosXY[1] > 2000 // Offscreen Left Side aPos[1]:= 0 ELSE aPos[1]:= aAbsPosXY[1]+oDateField:currentSize()[1]-aSize[1] ENDIF **** Check X Co-ord for fields moved partially offscreen to right IF aPos[1] +aSize[1] > appDeskTop():currentSize()[1] aPos[1] := appDeskTop():currentSize()[1]-aSize[1] ENDIF IF aAbsPosXY[2]-aSize[2] > 5 aPos[2]:= aAbsPosXY[2]-aSize[2] ELSE aPos[2]:= aAbsPosXY[2]+20 // could return Height from same DLL??? ENDIF ELSE aPos := CenterDlg( aSize, appDeskTop():currentSize()) ENDIF ****** Bitmap defined? * #ifdef BGBITMAP nBitmap := BGBITMAP #endif oDlg := XbpDialog():new( AppDesktop(),oOwner,aPos,aSize,,.T.) IF ValType(nBitmap)== "N" .AND. nBitmap > 0 oDlg:drawingArea:bitmap := nBitmap ENDIF oDlg:drawingArea:setColorFG( FGC ) oDlg:drawingArea:setColorBG( BGC ) oDlg:drawingArea:setFontCompoundName("8.Arial") oDlg:alwaysontop:= .T. oDlg:maxsize := aSize oDlg:titlebar := .F. oDlg:create() oDlg:setModalState( XBP_DISP_APPMODAL) oDa := oDlg:drawingArea * * END DIALOG CREATE ************************************************************************ ************************************************************************ * * KEYBOARD KEYS TRAP * oKeyTrap:= XbpStatic():new( oDa, , { 1,1}, {50,50}) oKeyTrap:caption := "" oKeyTrap:clipSiblings := .F. oKeyTrap:Create() oKeyTrap:setColorBG(XBPSYSCLR_TRANSPARENT) bKeyBoard := {|nKey| BrKeys( nKey, oKeyTrap, @lExit, oDlg)} * ************************************************************************ ************************************************************************ * * Paint the Calendar Screen * AddButtons(oDa) AddCalendar(oDa) AddHelp(oDa) MakeCal( oCalbox, @oCal ) LoadMonth(oCal ) oTitleBar:cargo:= .F. // Toggle: False = "Year - Month", True = "Help" oCal:ItemMarked := {|MP1| SetDate( oCal, MP1 ) } oCal:ItemSelected := {|MP1| SetDate( oCal, MP1), ; IIF(lExitOk,lExit:= .T.,nil)} * ************************************************************************ ****** SETUP * oDlg:show() oKeyTrap:keyBoard := bKeyboard lKillKeys:= .F. // Allow all keys to be processed. setAppFocus(oKeyTrap) ****** Inhibit Exit on DoubleClick on Blank cell * lExitOk:= .F. * ****** LOOP * lExit := .F. do while !(lExit) nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC lFlucht := .T. ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) enddo ****** Prepare to return * setAppFocus( oLastFocus ) ********* SWITCH TO LOCAL FORMAT ********* DEFINED IN CLICKDATE.CH * ak: wird aber bei AppName() nicht gebraucht (weil schon gesetzt!) //SET DATE FORMAT TO DATE_FORMAT //SET DATE DATE_STATUS //SET CENTURY CENTURY_STAT ********* Determine Valtype * IF lDateField .AND. lFlucht == .F. //04.01.2008 18:01 ak // IF ValType(o:editbuffer())=="C" //04.01.2008 18:10 ak geREMt // o:setData(DtoC(dCurrDate)) // ELSEIF ValType(o:editbuffer())=="D" o:setData(dCurrDate) o:getData() //+24.09.2010 12:46 // ENDIF ENDIF ****** TIDYUP oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() RETURN IIF(lDateField,.T.,dCurrDate) * * END FUNCTION ClickDate() ***************************************************************************** ***************************************************************************** ***************************************************************************** * ***************************************************************************** * * FUNCTION BrKeys * Keyhandler ***************************************************************************** * STATIC FUNCTION BrKeys( nKey,oKeyTrap, lExit,oDlg) LOCAL lReDraw:= .T. LOCAL i DO WHILE .T. **************************************************************** * * EXPAND THE WINDOW * **************************************************************** * IF nKey == 524320 // Ctrl + SpaceBar ***** Hide the 'open up' button ***** Resize as normal window ***** Send keystrokes to the keytrap ***** Allow Other Key interpretations oOpenUp:Hide() oCalBox:Show() oAuxBox:Show() oDlg:configure( , , {aPos[1],aPos[2]} , aSize) //{314,384}) setAppFocus(oKeyTrap) lKillKeys:= .F. **************************************************************** * * IGNORE ALL OTHER KEYS if Minimised * **************************************************************** * ELSEIF lKillKeys lReDraw := .F. EXIT // The calendar is 'minimised' and may have focus, // ignore any other keystrokes for processing **************************************************************** * * COLLAPSE THE WINDOW * **************************************************************** * ELSEIF nKey == 32 // SpaceBar ***** Show the 'open up' button ***** Resize as 'collapsed' window ***** Stop Other Key interpretations (lKillKeys) aPos:= oDlg:currentPos() oCalBox:hide() oAuxBox:Hide() oDlg:configure( , ,{100 ,100}, {40,40}) oOpenUp:Show() Sleep( 10) // Where did it go? For i:= 1 to 7 // Flash to highlite oDlg:hide() Sleep( 3) oDlg:Show() Sleep( 3) Next i lKillKeys:= .T. // The calendar is 'minimised' and may have focus, // ignore any other keystrokes for processing **************************************************************** * * SHOW KEYBOARD HELP KEYS * **************************************************************** * ELSEIF nKey == xbeK_F1 // Help If oTitleBar:cargo == .F. oCal:hide() oHelp1:show() oHelp2:show() oTitleBar:cargo:= .T. oHelp:setCaption( aBtnCaps[11]) ShowDate() // Trickery, using Year/Month static ELse oCal:show() oHelp1:hide() oHelp2:hide() oTitleBar:cargo:= .F. oHelp:setCaption( aBtnCaps[10]) ShowDate() ENDIF **************************************************************** * * ESCAPE - CLOSE * **************************************************************** * ELSEIF nKey == xbeK_ESC dCurrDate := dOrigDate // RETURN Original Date lExit := .T. lReDraw := .F. **************************************************************** * * MONTH & YEAR KEYS * **************************************************************** * ELSEIF nKey == xbeK_PGUP // + Month Forward dCurrDate := DateAdd("m", 1, dCurrDate ) ELSEIF nKey == xbeK_PGDN // - Month Back dCurrDate := DateAdd("m", -1, dCurrDate ) ELSEIF nKey == xbeK_CTRL_PGUP // Increment Year by 1 dCurrDate := DateAdd("y", 1, dCurrDate ) ELSEIF nKey == xbeK_CTRL_PGDN // Decrement Year by 1 dCurrDate := DateAdd("y", -1, dCurrDate ) ELSEIF nKey == xbeK_ALT_PGUP // Increment Year by 5 GiveMe5(xbeK_CTRL_PGUP,oKeyTrap) ELSEIF nKey == xbeK_ALT_PGDN // Decrement Year by 5 GiveMe5(xbeK_CTRL_PGDN,oKeyTrap) **************************************************************** * * WEEK & DAY KEYS * **************************************************************** * ELSEIF nKey == xbeK_RIGHT dCurrDate++ ELSEIF nKey == xbeK_LEFT dCurrDate-- ELSEIF nKey == xbeK_UP dCurrDate -= 7 ELSEIF nKey == xbeK_DOWN dCurrDate += 7 **************************************************************** * * SELECTION KEYS * **************************************************************** * ELSEIF nKey == xbeK_HOME // Goto Today dCurrDate := Date() ELSEIF nKey == xbeK_END // Goto Original Date IF " "$DtoC(dOrigDate) dCurrDate:= Date() Else dCurrDate := dOrigDate ENDIF ELSEIF nKey == xbeK_RETURN // Select this Date. lExit:= .T. lReDraw := .F. ELSE lReDraw := .F. ENDIF EXIT ENDDO IF lReDraw CellHilite( oCal, nCursorRow, nCursorCol, "off") oCal:Hide() // Kill 'ripple' effect on reload. LoadMonth( oCal ) oCal:Show() ENDIF ***** ALWAYS SET FOCUS TO KEYTRAP * setAppFocus(oKeyTrap) RETURN NIL * * END FUNCTION BrKeys() ***************************************************************************** * ***************************************************************************** * * FUNCTION MakeBtns() * ***************************************************************************** * FUNCTION MakeBtns( oDa, xCap, aPos, aSize, bActivate, lHidden ) LOCAL oXbp LOCAL lVisible IF lHidden == NIL lVisible := .T. Else lVisible := !lHidden ENDIF oXbp := XbpPushButton():new( oDa, , aPos, aSize,,lVisible) oXbp:caption := xCap oXbp:tabStop := .T. oXbp:pointerFocus := .F. //no focus oXbp:activate := bActivate oXbp:create() RETURN oXbp * * END FUNCTION MakeBtns() ***************************************************************************** * ***************************************************************************** * * FUNCTION MakeCal() * ***************************************************************************** * FUNCTION MakeCal( oCalBox, oCal ) LOCAL aOfColData := {} LOCAL oDayBar LOCAL i, j LOCAL aRef:= {"000","000","000","000","000","000","000"} aOfColData:={ {" "," "," "," "," "," "," "},; {" "," "," "," "," "," "," "},; {" "," "," "," "," "," "," "},; {" "," "," "," "," "," "," "},; {" "," "," "," "," "," "," "},; {" "," "," "," "," "," "," "}} oCal := XbpMultiCellGroup():new( oCalBox, ,{1,1}, {182,120}) oCal:maxCol := 7 oCal:maxRow := 6 oCal:referenceArray:= aRef oCal:style := XBP_STYLE_3D oCal:create() FOR i := 1 TO 6 // Row FOR j := 1 TO 7 // Col oCal:setAlignment( j,XBPALIGN_RIGHT+XBPALIGN_VCENTER) oCal:setCell( i, j, aOfColData[i,j]) oCal:setCellColor( i, j, GRA_CLR_BLACK, GRA_CLR_WHITE) NEXT j NEXT i oDayBar := XbpMultiCellGroup():new( oCalBox, ,{1,120}, {182,20}) oDayBar:maxCol := 7 oDayBar:maxRow := 1 oDayBar:referenceArray:= aRef oDayBar:style := XBP_STYLE_3D oDayBar:create() FOR i := 1 TO 7 oDayBar:setCell( 1, i, aDayBar[i]) oDayBar:setCellColor( 1, i, GRA_CLR_BLACK, gdPBL ) NEXT i setAppFocus(oKeyTrap) RETURN nil * * END FUNCTION MakeCal() ***************************************************************************** * ***************************************************************************** * * FUNCTION LoadMonth() * ***************************************************************************** * STATIC FUNCTION LoadMonth( oCal ) LOCAL aCalArray := array( 6, 7) LOCAL nFirstWeekDayOfMth LOCAL nLastDayOfMth LOCAL nDayOfMth:= 1 LOCAL nRow := 0 LOCAL nCol := 0 ***** Statics nYear := Year ( dCurrDate) nMonth := Month( dCurrDate) nDay := Day ( dCurrDate) nFirstWeekDayOfMth:= FWdoM(Month(dCurrDate ), Year(dCurrDate ) ) nLastDayOfMth := LdoM( Month(dCurrDate ), Year(dCurrDate ) ) For nRow := 1 to 6 For nCol := 1 to 7 IF nDayOfMth == Day( dCurrDate) // HiLite Field nCursorRow := nRow nCursorCol := nCol ENDIF IF nCol + (nRow-1) * 7 < nFirstWeekDayOfMth .OR. nDayOfMth > nLastDayOfMth aCalArray[ nRow, nCol] := " " ELSE aCalArray[ nRow, nCol] := Alltrim(Str(nDayOfMth)) nDayOfMth++ ENDIF Next nCol Next nRow FOR nRow := 1 TO 6 FOR nCol := 1 TO 7 oCal:setAlignment( nCol,XBPALIGN_RIGHT+XBPALIGN_VCENTER) oCal:setCell( nRow, nCol, aCalArray[nRow,nCol]) oCal:setCellColor( nRow, nCol, GRA_CLR_BLACK, GRA_CLR_WHITE) NEXT nCol NEXT nRow CellHilite( oCal, nCursorRow, nCursorCol, "on") ShowDate() setAppFocus(oKeyTrap) RETURN nil * * END FUNCTION LoadMonth() ***************************************************************************** * ***************************************************************************** * * FUNCTION SetDate() * ***************************************************************************** * STATIC FUNCTION SetDate( oCal, aNewRC ) LOCAL nData:= Val(oCal:getcell(aNewRC[1],aNewRC[2])) CellHilite( oCal, nCursorRow, nCursorCol, "off") IF nData == 0 // Invalid selection lExitOk := .F. // Bar doubleclick exit IF aNewRC[1] == 1 dCurrDate:= YMDtoD(Year(dCurrDate),Month(dCurrDate),; Val(oCal:getcell(aNewRC[1]+1,aNewRC[2]))) PostAppEvent( xbeP_Keyboard,xbeK_UP,,oKeyTrap) ELSE nData:= IIF(Val(oCal:getcell(aNewRC[1]-1,aNewRC[2])) == 0,; Val(oCal:getcell(aNewRC[1]-2,aNewRC[2])),; Val(oCal:getcell(aNewRC[1]-1,aNewRC[2]))) dCurrDate:= YMDtoD(Year(dCurrDate),Month(dCurrDate), nData ) PostAppEvent( xbeP_Keyboard,xbeK_DOWN,,oKeyTrap) ENDIF ELSE nDay := nData dCurrDate := YMDtoD( nYear, nMonth, nDay ) ShowDate() nCursorRow:= aNewRC[1] nCursorCol:= aNewRC[2] CellHilite( oCal, nCursorRow, nCursorCol, "on") lExitOk := .T. ENDIF setAppFocus(oKeyTrap) RETURN dCurrDate * * END FUNCTION SetDate() ***************************************************************************** * ***************************************************************************** * * FUNCTION Num2Pos() * * Argument: Positive Integer * Returns: Nst, Nnd, Nrd, Nth. string as appropriate. * ***************************************************************************** * STATIC FUNCTION Num2Pos( nVal ) LOCAL nX LOCAL cOrd := "Err" LOCAL cStNdRd := FIR_ST+SECO_ND+THI_RD IF ValType(nVal) == "N" .AND. !(nVal <= 0) nX := (nVal%100) -1 cOrd:= Padl(Alltrim(Str( nVal )),2," ") cOrd+= IIF( nX%10 > 2 .OR. ABS( nX - 11 ) < 2, N_TH,; SubStr( cStNdRd, ( nX%10 ) * 2 + 1, 2 )) ENDIF RETURN cOrd * * END FUNCTION Num2Pos() ***************************************************************************** * ***************************************************************************** * * FUNCTION DateAdd() * * cYM: Y= processing a Year * M= processing a Month * nShift is either +1 or -1 * ****************************************************************************** * FUNCTION DateAdd(cYM, nShift, dDateIn ) LOCAL nYear := Year(dDateIn) LOCAL nMonth := Month(dDateIn) LOCAL nDay := Day(dDateIn) LOCAL dDateOut := dDateIn IF Upper( cYM ) == "Y" nYear += nShift dDateOut:= YMDtoD( nYear, nMonth, nDay ) ELSEIF Upper( cYM ) == "M" nMonth += nShift IF nMonth == 13 nMonth := 1 nYear ++ ELSEIF nMonth == 0 nMonth := 12 nYear -- ENDIF dDateOut:= YMDtoD( nYear, nMonth, nDay ) ENDIF **** September 1752 was a 'bad' month for calendars. IF dDateOut < MINDATE dDateOut := MINDATE ENDIF ShowDate() RETURN dDateOut * * END FUNCTION DateAdd() ***************************************************************************** * ***************************************************************************** * * FUNCTION YMDtoD() * nYear, nMonth, nDay to Date * ***************************************************************************** * STATIC FUNCTION YMDtoD( nYear, nMonth, nDay ) LOCAL dDateOut LOCAL nLastDay IF nDay >= 29 nLastDay := LdoM( nMonth, nYear ) IF nLastDay < nDay nDay := nLastDay ENDIF ENDIF dDateOut := CtoD( DValtoStr( nDay)+"/"+DValtoStr( nMonth)+"/"+DValtoStr( nYear) ) RETURN dDateOut * * END FUNCTION YMDtoD() ***************************************************************************** * ***************************************************************************** * * FUNCTION LdoM() * Last Day of the Month * ***************************************************************************** * STATIC FUNCTION LdoM( xMonth, nYear ) LOCAL nLastDay LOCAL nThisMonth LOCAL dDate LOCAL nMonth ***** Let date or Month/Year be passed and processed * If ValType(xMonth) == "D" nYear:= Year(xMonth) nMonth:= Month(xMonth) ELSE nMonth:= xMonth Endif nThisMonth := nMonth dDate := CtoD("28/"+DValtoStr(nMonth)+"/"+DValtoStr(nYear)) DO While nThisMonth == nMonth nThisMonth:= Month(++dDate) ENDDO nLastDay := Day(dDate-1) RETURN nLastDay * * END FUNCTION LdoM() ***************************************************************************** * ***************************************************************************** * * FUNCTION FWdoM() * First Week-Day of the Month * ***************************************************************************** * STATIC FUNCTION FWdoM( xMonth, nYear ) LOCAL nFirstDay LOCAL dDate LOCAL nMonth ***** Let date or month/year be passed and processed * If ValType(xMonth) == "D" nYear:= Year(xMonth) nMonth:= Month(xMonth) //cast change ELSE nMonth:= xMonth Endif dDate := CtoD("01/"+DValtoStr(nMonth)+"/"+DValtoStr(nYear)) nFirstDay := Mon1stDoW(dDate) RETURN nFirstDay * * END FUNCTION FWdoM() ***************************************************************************** * ***************************************************************************** * * FUNCTION DValtoStr() * nDay, nMonth or nYear: Date Value to String * ***************************************************************************** * FUNCTION DValtoStr( nVal ) LOCAL cStr:= "" IF nVal < 32 // 1...12...31 cStr:= PadL(Alltrim(Str(nVal)),2,"0") ELSE cStr:= Str(nVal,4) ENDIF RETURN cStr ***************************************************************************** * ***************************************************************************** * * FUNCTION CenterDlg() * ***************************************************************************** * STATIC FUNCTION CenterDlg( aDlgSize, aAppSize ) RETURN { Int( (aAppSize[1] - aDlgSize[1]) / 2 ) ; , Int( (aAppSize[2] - aDlgSize[2]) / 2 ) } * * END FUNCTION CenterDlg() ***************************************************************************** * ***************************************************************************** * * FUNCTION GiveMe5() * ***************************************************************************** * FUNCTION GiveMe5( nKey, oKeyTrap) LOCAL i FOR i:= 1 to 5 PostAppEvent( xbeP_Keyboard,nKey,,oKeyTrap) Next i RETURN nil * * END FUNCTION GiveMe5() ***************************************************************************** * ***************************************************************************** * * FUNCTION ShowDate() * ***************************************************************************** * STATIC FUNCTION ShowDate() LOCAL cTheDow := aDays[Mon1stDoW( dCurrDate )] LOCAL cTheDay := Num2Pos(Day(dCurrDate)) LOCAL cOffSet := Alltrim(Str(dCurrDate-Date())) LOCAL dDay := Ctod("01/"+Padl(YEAR_BASE,2,"0")+"/"+; Alltrim(Str(Year(dCurrDate)))+'"') LOCAL cDay := PadL(AllTrim(Str( dCurrDate +1 - dDay )),3,"0") LOCAL nWeek := Int((Val(cDay)-1+FWdoM(1,Year(dCurrDate))-1)/7) +1 LOCAL cWeek := TEXT_WEEK+ PadL(IIF(nWeek%53==0 .AND.; !(FWdoM(dCurrDate)==5),"*1",Alltrim(Str(nWeek))),2,"0") cDay := TEXT_DAY+cDay cOffSet:= IIF("-"$cOffset,cOffSet,; IIF(dCurrDate==Date(),"","+"+cOffSet)) ****** Calendar replaced by Help? If oTitleBar:cargo == .T. oTitleBar:setCaption(HELP_TITLE) Else oTitleBar:setCaption(DValtoStr( Year( dCurrDate ))+" "+aMonths[Month(dCurrDate)] ) Endif oDate:setcaption(" "+cTheDoW+" " +cTheDay) oAux:setCaption(" "+cWeek+" "+cDay+" "+TEXT_TODAY+cOffSet ) RETURN nil * * END FUNCTION ShowDate() ***************************************************************************** ***************************************************************************** * * FUNCTION CellHilite() * ***************************************************************************** * FUNCTION CellHilite( oMCell, nRow, nCol, xOnOff, aHiFGBG, aNormFGBG) Local lTurnOn:= .F. aHiFGBG := IIF( aHiFGBG == NIL, {GRA_CLR_WHITE, GRA_CLR_RED}, aHiFGBG) aNormFGBG:= IIF( aNormFGBG == NIL, {GRA_CLR_BLACK, GRA_CLR_WHITE}, aNormFGBG) IF Valtype(xOnOff)== "C" IIF( "ON"$Upper(xOnOff), lTurnOn:= .T.,lTurnOn:= .F.) ElSEIF Valtype(xOnOff)== "L" lTurnOn:= xOnOff ENDIF IF lTurnOn oMCell:setCellColor( nRow, nCol,aHiFGBG[1], aHiFGBG[2] ) ELSE oMCell:setCellColor( nRow, nCol,aNormFGBG[1], aNormFGBG[2] ) ENDIF RETURN nil * * END FUNCTION CellHilite() ***************************************************************************** ***************************************************************************** * * FUNCTION Mon1stDoW() * Monday as First Day, Day of Week ***************************************************************************** * FUNCTION Mon1stDoW(dDate) RETURN IIF(DoW(dDate)==1,7,DoW(dDate)-1) * * END FUNCTION Mon1stDoW() ***************************************************************************** ***************************************************************************** * * FUNCTION AddButtons() * ***************************************************************************** * FUNCTION AddButtons(oDa) ****** BUTTON TRAY (TRANSPARENT BG) * oBtnBar:= XbpStatic():new( oDa, , {190,14}, {63,158}) oBtnBar:options := XBPSTATIC_TEXT_LEFT + XBPSTATIC_TEXT_VCENTER oBtnBar:caption := "" oBtnBar:clipSiblings := .T. oBtnBar:Create() oBtnBar:setColorBG(XBPSYSCLR_TRANSPARENT) ****** BUTTON TRAY TEXT * ****** Year -5+ * oBtnTxt1:= XbpStatic():new( oBtnBar, , { 2,73}, {60,15}) oBtnTxt1:caption := "5" oBtnTxt1:options := XBPSTATIC_TEXT_CENTER + XBPSTATIC_TEXT_VCENTER oBtnTxt1:clipSiblings := .F. oBtnTxt1:Create() oBtnTxt1:setColorBG(XBPSYSCLR_TRANSPARENT) ****** "Year" * oBtnTxt2:= XbpStatic():new( oBtnBar, , { 1,34}, {60,15}) oBtnTxt2:caption := TEXT_YEAR oBtnTxt2:options := XBPSTATIC_TEXT_CENTER + XBPSTATIC_TEXT_VCENTER oBtnTxt2:clipSiblings := .F. oBtnTxt2:Create() oBtnTxt2:setColorBG(XBPSYSCLR_TRANSPARENT) ****** "Month" * oBtnTxt3:= XbpStatic():new( oBtnBar, , { 1, 0}, {60,15}) oBtnTxt3:caption := TEXT_MONTH oBtnTxt3:options := XBPSTATIC_TEXT_CENTER + XBPSTATIC_TEXT_VCENTER oBtnTxt3:clipSiblings := .F. oBtnTxt3:Create() oBtnTxt3:setColorBG(XBPSYSCLR_TRANSPARENT) * ****** END BUTTON TEXT ****** BUTTONS * ***** Minimize "24x12 Gold Minim.bmp" * MakeBtns( oBtnBar, aBtnCaps[9], {1,141}, {28,16}, ; {|| postAppEvent(xbeP_Keyboard,32,,oKeyTrap) }) ***** Close "24x12" Gold Close.bmp" * MakeBtns( oBtnBar, aBtnCaps[2], {34,141}, {28,16}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_ESC,,oKeyTrap)}) ***** Today "24x12" Gold Today.bmp" * MakeBtns( oBtnBar, aBtnCaps[1], {1,118}, {28,21}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_HOME,,oKeyTrap)}) ***** Help "24x17 Gold HelpO.bmp" / HelpC (Toggle) * oHelp:= MakeBtns( oBtnBar, aBtnCaps[10], {34,118}, {28,21}, ; {||PostAppEvent( xbeP_Keyboard,xbeK_F1,,oKeyTrap)}) ***** SELECT "24x17 Select.bmp" * MakeBtns( oBtnBar, aBtnCaps[3], {1, 95}, {28,21}, ; {|| PostAppEvent(xbeP_Keyboard,xbeK_RETURN,,oKeyTrap)}) ***** ORIGINAL DATE "24x17 Original.bmp" * MakeBtns( oBtnBar, aBtnCaps[4], { 34, 95}, {28,21}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_END,,oKeyTrap)}) ***** YEAR -5 "12x17 Gold Left.bmp" * MakeBtns( oBtnBar, aBtnCaps[5], { 7,70}, {16,21}, ; {|| GiveMe5(xbeK_CTRL_PGDN,oKeyTrap)}) ***** YEAR +5 "12x17 Gold Right.bmp" * MakeBtns( oBtnBar, aBtnCaps[6], {40,70}, {16,21}, ; {|| GiveMe5(xbeK_CTRL_PGUP,oKeyTrap)}) ***** YEAR -1 "24x17 Gold Prev.bmp" * MakeBtns( oBtnBar, aBtnCaps[7], { 1,48},{28,21}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_CTRL_PGDN,,oKeyTrap)}) ***** YEAR +1 "24x17 Gold Next.bmp" * MakeBtns( oBtnBar, aBtnCaps[8], { 34,48}, {28,21}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_CTRL_PGUP,,oKeyTrap)}) ***** -MONTH "24x17 Gold Prev.bmp" * MakeBtns( oBtnBar, aBtnCaps[7], { 1,14}, {28,21}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_PGDN,,oKeyTrap)}) ***** +MONTH "24x17 Gold Next.bmp" * MakeBtns( oBtnBar, aBtnCaps[8], { 34, 14}, {28,21}, ; {|| PostAppEvent( xbeP_Keyboard,xbeK_PGUP,,oKeyTrap)}) * ***** END BUTTONS RETURN NIL * * END FUNCTION AddButtons() ***************************************************************************** ***************************************************************************** * * FUNCTION AddCalendar() * ***************************************************************************** * FUNCTION AddCalendar(oDa) oAuxBox := XbpSTATIC():new( oDa,, {1,0}, {252,15},{ { XBP_PP_FGCLR, GRA_CLR_PALEGRAY}}) oAuxBox:type := XBPSTATIC_TYPE_RECESSEDBOX oAuxBox:options := XBPSTATIC_FRAMETHIN oAuxBox:create() oAux := XbpSTATIC():new( oAuxBox,, {98,1}, {152,14},; { { XBP_PP_BGCLR, GRA_CLR_PALEGRAY},; { XBP_PP_FGCLR, gdDTG},; { XBP_PP_COMPOUNDNAME, "8.Arial Narrow" }}) oAux:type := XBPSTATIC_TYPE_TEXT oAux:options := XBPSTATIC_TEXT_LEFT+XBPSTATIC_TEXT_VCENTER oAux:caption :="Text" oAux:create() oDate := XbpSTATIC():new( oAuxBox,, {1,1}, {96,14},; { { XBP_PP_BGCLR, GRA_CLR_PALEGRAY},; { XBP_PP_FGCLR, GRA_CLR_RED},; { XBP_PP_COMPOUNDNAME, "8.Arial" }}) oDate:type := XBPSTATIC_TYPE_TEXT oDate:options := XBPSTATIC_TEXT_LEFT+XBPSTATIC_TEXT_VCENTER oDate:caption :="Text" oDate:create() ***** CALENDAR BOX * oCalbox := XbpSTATIC():new( oDa,, {3,15}, {184,158}) oCalbox:type := XBPSTATIC_TYPE_BGNDRECT oCalbox:options := XBPSTATIC_FRAMETHIN oCalbox:create() ***** Year-Month * oTitleBar := XbpSTATIC():new( oCalbox,, {2,140}, {180,16},; { { XBP_PP_BGCLR, gdDTG},; { XBP_PP_FGCLR, GRA_CLR_WHITE},; { XBP_PP_COMPOUNDNAME, "9.Arial Bold" }}) oTitleBar:type := XBPSTATIC_TYPE_TEXT oTitleBar:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER oTitleBar:caption :="April 2002" oTitleBar:create() * ***** RETURN NIL * * END FUNCTION AddCalendar() ***************************************************************************** ***************************************************************************** * * FUNCTION AddHelp() * ***************************************************************************** * FUNCTION AddHelp(oDa) oHelp1 := XbpStatic():new( oCalBox,, {1,1}, {60,140},; { { XBP_PP_BGCLR, gdPYL},; { XBP_PP_FGCLR, gdDTG},; { XBP_PP_COMPOUNDNAME, "9.Arial" }} ) oHelp1:options := XBPSTATIC_TEXT_LEFT + ; XBPSTATIC_TEXT_WORDBREAK oHelp1:caption := StrTran( HELP_TEXT1, ";", Chr(13) ) oHelp1:visible := .F. oHelp1:create() oHelp2 := XbpStatic():new( oCalBox,, {60,1}, {125,140},; { { XBP_PP_BGCLR, gdPYL},; { XBP_PP_FGCLR, GRA_CLR_RED},; { XBP_PP_COMPOUNDNAME, "9.Arial" }} ) oHelp2:options := XBPSTATIC_TEXT_LEFT + ; XBPSTATIC_TEXT_WORDBREAK oHelp2:caption := StrTran( HELP_TEXT2, ";", Chr(13) ) oHelp2:visible := .F. oHelp2:create() ***** Open - Access * oOpenUp := XbpPushButton():new( oDa, , { 1,1}, {32,32} ) oOpenUp:activate := {|| postAppEvent(xbeP_Keyboard,524320,,oKeyTrap) } oOpenUp:caption := 6000 // OPENUP oOpenUp:visible := .F. // HIDDEN oOpenUp:clipSiblings := .T. oOpenUp:Create() RETURN NIL * * END FUNCTION AddHelp() ***************************************************************************** * *********************************************************************** * * FUNCTION GetAbsPos(obj) --> {nX,nY} * * o:getposition() returns the reference to the client area. * We want a reference to the DeskTop, so we need GetWindowRect() *********************************************************************** * FUNCTION GetAbsPos(o) LOCAL nLeft := 0 LOCAL nTop := 0 LOCAL nRight := 0 LOCAL nBottom := 0 LOCAL cBuffer := Space(16) // cBuffer == a4LTRB_lpRect:= {nL,nT,nR,nB} LOCAL aObjPosXY := {nil,nil} *** DllCall("User32.DLL", DLL_STDCALL,"GetWindowRect", hWnd, a4LTRB_lpRect) DllCall("User32.DLL", DLL_STDCALL,"GetWindowRect", o:GetHwnd(), @cBuffer) nLeft := Bin2U(substr(cBuffer, 1, 4)) nTop := Bin2U(substr(cBuffer, 5, 4)) nRight := Bin2U(substr(cBuffer, 9, 4)) nBottom := Bin2U(substr(cBuffer, 13, 4)) aObjPosXY[1] := nLeft aObjPosXY[2] := AppDeskTop():currentSize()[2] - nBottom RETURN ( aObjPosXY ) * * END FUNCTION GetAbsPos() *********************************************************************** ***************************************************************************** * FUNCTION IsDateValid() ***************************************************************************** * FUNCTION IsDateValid(nDay, nMonth, nYear) LOCAL dDate := CtoD(" / / ") LOCAL lValid := .T. LOCAL aMonth_length := {31,28,31,30,31,30,31,31,30,31,30,31} IF IsLeapYear(nYear) aMonth_length[2] := 29 // 29 days in Feb. in a leap nYear (incl. nYear 2000) ENDIF IF nMonth < 0 .OR. nMonth > 12 lValid = .F. ELSEIF ( nDay < 1 .OR. nDay > aMonth_length[nMonth] ) lValid = .F. ENDIF IF lValid dDate:= CtoD(StrZero(nDay,2)+'/'+StrZero(nMonth,2)+'/'+StrZero(nYear,4)) ENDIF Return ( dDate ) * * END FUNCTION IsDateValid() ***************************************************************************** ***************************************************************************** * FUNCTION IsLeapYear() ***************************************************************************** FUNCTION IsLeapYear(nYear) LOCAL lValid := .F. IF !( nYear%4 == 0 ) lValid = .F. ELSEIF nYear%400 == 0 lValid = .T. ELSEIF nYear%100 == 0 lValid = .F. ELSE lValid = .T. ENDIF Return ( lValid ) * * END FUNCTION IsLeapYear() ***************************************************************************** * END PROGRAM CLICKDATE.PRG *****************************************************************************