Old code...

JakeBullet70

Well-Known Member
Licensed User
OK...

B4X:
///////////////////////////
function CalStuff( TODAY )
///////////////////////////
LOCAL dToday_Is,i,last,row,col,day,cal_buf
LOCAL cDateString,dItsTodaysDate,nTTLJob
LOCAL xKey_Hit,GetList:={}
LOCAL x[42],y[42],aWhere := { {},{},{},{} }
LOCAL xoffset := 6, yoffset := 3
LOCAL x1 := 3,    y1 := 5
LOCAL cOldMouseArea := MouseDefArea(0,0,24,79)
LOCAL nDayPercent   := 0,lOldIns := READINSERT(.T.)
LOCAL ECOL,EROW,TCOL,TROW,BCOL
local aAdd2UpdateCal

PUBLIC nJobPage := 1


SET KEY K_F9 to
set century off
TAKE_OUT_THE_TRASH

DEFAULT today TO DATE()
dToday_Is := DOW(today)
DAY       := DAY(today)


IF !OpenDBFS() ; RETURN Nil ; ENDIF
aCalNumInfo := ARead("caldata.arr")
ActivateCal(aCalNumInfo[13,1])
SCR( PUSH )
DrawScreen( aCalNumInfo )


do while TRUE
   ClearWin(04,02,22,44,aClr[CLR_BOX,3])
   ClearWin(04,50,22,77,aClr[CLR_BOX,3])
    FOR i = 1 TO 7
        x[i] = x1 + ( xoffset * (i - 1) )
    NEXT
    FOR i = 1 TO 6
        y[i] = y1 + ( yoffset * (i - 1) )
    NEXT
    COL  := dow( today - (day(today)-1))
    BCOL := COL
    ROW  := 1
    DAY  := ROW
    TCOL := 0
    TROW := TCOL

    *-- Call udf TO find the lastday of the current month --*
    LAST   := LASTDAY(TODAY)
   aWhere := ARRAY(LAST,4)


    *-- Make calendar --*
   Scr( PUSH,8,5,13,42)
   SD_Box(8,5,12,40,aClr[CLR_A1_BOX])
   @ 10,7 say "Please Wait,  Calculating Month." COLOR aClr[CLR_A1_BOX,1]
   DispBegin()
   Scr( POP )
    do while row <=6 .and. DAY <= LAST
        do while col <= 7 .and. DAY <= LAST
            IF DAY == DAY(TODAY)
                tcol := col  //*-- remember today --*//
                trow := row  //*-- remember today --*//
         ENDIF

         IF NEXTKEY() == K_PGUP .or. NEXTKEY() == K_PGDN
            // nothing...
         else
            UpdateDays(ctod(strzero(month(today),2)+"/"+strzero(day,2)+"/"+;
                       strzero(year(today),4)),row,col,y,x,DAY)
         ENDIF

         aWhere[DAY][1] := y[row] ;   aWhere[DAY][2] := x[col]
         aWhere[DAY][3] := row    ;   aWhere[DAY][4] := col
            DAY += 1
            COL += 1
        enddo
        ECOL := COL - 1
        col  := 1
        ROW  += 1
    enddo
   DispEnd()

    DAY  := DAY(today)
    EROW := ROW -1
    ROW  := TROW
    COL  := TCOL


    *-- display box around day position --*
    do while .t.
      DispBegin()
      dItsTodaysDate := ctod(strzero(month(today),2)+"/"+strzero(day,2)+"/"+strzero(year(today),4))
      UpdateDays(dItsTodaysDate,row,col,y,x,DAY)
      @ 3,47 say PADC(CDOW(dItsTodaysDate),31) COLOR aClr[CLR_BOX,3]
      @ 1,01 say PADC( PrettyDate( dItsTodaysDate,6 ),45)  COLOR aClr[CLR_BOX,2]
        @ y[row]-1,x[col]-1 say "ÚÄÄÄÄÄ¿"    color aClr[ CLR_BOX,3 ]
        @ y[row],x[col]-1   say "³"          color aClr[ CLR_BOX,3 ]
        @ y[row],x[col]+5   say "³"          color aClr[ CLR_BOX,3 ]
        @ y[row]+1,x[col]-1 say "³"          color aClr[ CLR_BOX,3 ]
        @ y[row]+1,x[col]+5 say "³"          color aClr[ CLR_BOX,3 ]
        @ y[row]+2,x[col]-1 say "ÀÄÄÄÄÄÙ"    color aClr[ CLR_BOX,3 ]
      DispEnd()

      //** get mouse and keys **//
        xKey_Hit = GetCalKey( dItsTodaysDate )
      IF valtype(xKey_Hit) == 'A'
         xKey_Hit := ProcessMouse(aWhere,xKey_Hit,x,y,@ROW,@DAY,@COL)
         IF xKey_Hit == _MOUSE_PICK_
            //** mouse move to another day **//
            //** so reset job page to 1
            pRESET_TO_JOB_PAGE_1
            loop
         ENDIF
         IF xKey_Hit == _DATE_SELECTED_
            xKey_Hit := K_ENTER
         ENDIF
      ENDIF
      IF !EMPTY(aJobsToDo)
         ChkExtraKeys(xKey_Hit)          // check ext keys //
      ENDIF

      EraseCalHilite(y,x,col,row)

        DO CASE
            case xKey_Hit == K_ESC
              MouseDefArea( cOldMouseArea )
              DBCloseAll()
              SD_DBF( POP )
              Scr( POP )
              READINSERT( lOldIns )
              AWrite("caldata.arr",aCalNumInfo)
              RELEASE nJobPage
              SET KEY K_F9 to GenericToDoCAL()
                 RETURN( pBLANK_DATE )

            case xKey_Hit == K_DOWN
                 IF .not. ((row+1 == EROW .and. COL > ECOL) .or. row == EROW)
                     IF row <= 5
                         row += 1 ; day += 7
                     ENDIF
                 pRESET_TO_JOB_PAGE_1
                 ENDIF

            case xKey_Hit == K_UP
                 IF .not. (row-1 == 1 .and. COL < BCOL)
                     IF row > 1
                         day -= 7 ; row -= 1
                     ENDIF
                 pRESET_TO_JOB_PAGE_1
                 ENDIF

            case xKey_Hit == K_LEFT
                IF .not. (row == 1 .and. COL -1 < BCOL)
                    IF col > 1
                        col -= 1 ;    day -= 1
                    else
                        IF row > 1
                            day -= 1 ;    row -= 1 ;    col := 7
                        ENDIF
                    ENDIF
               pRESET_TO_JOB_PAGE_1
                ENDIF

            case xKey_Hit == K_RIGHT
                IF .not. (row == EROW .and. COL +1 > ECOL)
                    IF col <= 6
                        col += 1 ;    day += 1
                    else
                        IF row <= 5
                            row += 1 ;    day += 1 ;    col := 1
                        ENDIF
                    ENDIF
               pRESET_TO_JOB_PAGE_1
                ENDIF

            case xKey_Hit == K_ENTER
              JobsMenu(dItsTodaysDate,y,x,aWhere)

            case xKey_Hit == K_TAB
              aAdd2UpdateCal := {}
              MakePhoneCalls(dItsTodaysDate,@aCallsToDo,aAdd2UpdateCal)
              ChkUpdateCal(dItsTodaysDate,aAdd2UpdateCal,aWhere,y,x)



            case xKey_Hit <= K_ALT_F1 .and. xKey_Hit >= K_ALT_F10 .or. ;
              xKey_Hit == K_ALT_F11 .or. xKey_Hit == K_ALT_F12
              IF CheckCalNumKeys(xKey_Hit,@aCalNumInfo)
                 pRESET_TO_JOB_PAGE_1
                 exit
              ENDIF

            case xKey_Hit == K_CTRL_BS
              //** this is the show & select all valid calendar
              IF ShowChangeCal(@aCalNumInfo)
                 pRESET_TO_JOB_PAGE_1
                 exit
              ENDIF

            case xKey_Hit  == K_PGDN
              today := ADDMONTH(dItsTodaysDate,1)
              pRESET_TO_JOB_PAGE_1
                 exit

            case xKey_Hit  == K_PGUP
              today := ADDMONTH(dItsTodaysDate,-1)
              pRESET_TO_JOB_PAGE_1
                 exit

         case xKey_Hit  == K_ALT_Y
              MultiView(dItsTodaysDate,aCalNumInfo)

         case xKey_Hit  == K_ALT_W
              WeeklyView(dItsTodaysDate,aCalNumInfo)

         case xKey_Hit  ==  K_CTRL_PGUP
              nTTLJob := LEN(aJobsToDo)
              if nJobPage == 1
                 SD_EBeep()
              else
                 nJobPage--
              endif
              ShowWhatCal(aCalNumInfo)


         case xKey_Hit  ==  K_CTRL_PGDN
              nTTLJob := LEN(aJobsToDo)
              DO CASE
              CASE nTTLJob >= 18 .AND. nJobPage == 1
                   nJobPage++
              CASE nTTLJob >= 35 .AND. nJobPage == 2
                   nJobPage++
              CASE nTTLJob >= 52 .AND. nJobPage == 3
                   nJobPage++
              OTHERWISE
                   SD_EBeep()
              ENDCASE
              ShowWhatCal(aCalNumInfo)

        endcase
    enddo
enddo
 

charlesg

Member
Licensed User
Clipper?

Still in use all over the place. Most of the Chinese take-aways in this part of the UK still seem to be using it. Probably because, with modern hardware, it is blindingly fast.

I use an industry specific POS program originally written in Clipper but now guified with Alaska xBase++. Right down to dbf and ntx files. Rock solid.

There is also an open source Clipper clone called Harbour. There are guified versions (e.g. xHarbour and HMG) and even one wrapped inside QT (Marinas GUI)
 
Last edited:
Top