Old code...

Discussion in 'Chit Chat' started by JakeBullet70, May 16, 2015.

  1. JakeBullet70

    JakeBullet70 Well-Known Member Licensed User

    OK...

    Code:
    ///////////////////////////
    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
     
  2. charlesg

    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: May 18, 2015
    JakeBullet70 likes this.
Loading...
  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice