!----------------------------------------------------------------------------------------------
Kalender PROCEDURE

DayNumber            LONG
MonthNumber          SHORT
YearNumber           SHORT
ChangeMonthYear      BYTE(False)
UpdateAssign         BYTE(True)
PassedDate           LONG
lTagesNr             LONG
cSaveVar             STRING(10)

TheWnd WINDOW('x'),AT(,,145,108),DOUBLE,|
                   ALRT(UpKey),ALRT(DownKey),ALRT(PgUpKey),ALRT(PgDnKey),|
                   ALRT(RightKey),ALRT(LeftKey),|
                   ALRT(EnterKey),ALRT(MouseLeft2), |
                   SYSTEM,GRAY,FONT(C_SS_Font,8,,),CENTER,HLP('~Kalender')
         STRING('Mo'),AT(2,1,10,10), FONT(,,0800000H,),USE(?StringMo),CENTER
         STRING('Di'),AT(14,1,10,10),FONT(,,0800000H,),USE(?StringTu),CENTER
         STRING('Mi'),AT(26,1,12,10),FONT(,,0800000H,),USE(?StringWe),CENTER
         STRING('Do'),AT(38,1,10,10),FONT(,,0800000H,),USE(?StringTh),CENTER
         STRING('Fr'),AT(50,1,10,10),FONT(,,0800000H,),USE(?StringFr),CENTER
         STRING('Sa'),AT(62,1,10,10),FONT(,,0008000H,),USE(?StringSa),CENTER
         STRING('So'),AT(74,1,10,10),FONT(,,00000FFH,),USE(?StringSu),CENTER
         BUTTON(),AT(131,0,11,11),USE(?TodayButton),ICON('date.ico'),TIP('springt zum heutigen Datum')
         PANEL,AT(0,0,,12),USE(?Panel1),FULL,BEVEL(0,0,09H)
         PANEL,AT(110,17,32,29),USE(?Panel3),BEVEL(-1)
         STRING('Monat'),AT(112,20,28,10),FONT(,,080H,),USE(?StringMonth),TRN,CENTER
         SPIN(@n-6),AT(114,29,24,12),USE(MonthNumber),IMM,HSCROLL,STEP(1),TIP('ändert Monat')
         PANEL,AT(110,50,32,29),USE(?Panel2),BEVEL(-1)
         STRING('Jahr'),AT(112,53,28,10),FONT(,,080H,),USE(?StringYear),TRN,CENTER
         SPIN(@n-6),AT(114,62,24,12),USE(YearNumber), IMM,HSCROLL,STEP(1),TIP('ändert Jahr')
         REGION,AT(1,15,12,11), USE(?DayRegion1), IMM
         REGION,AT(13,15,12,11),USE(?DayRegion2), IMM
         REGION,AT(25,15,12,11),USE(?DayRegion3), IMM
         REGION,AT(37,15,12,11),USE(?DayRegion4), IMM
         REGION,AT(49,15,12,11),USE(?DayRegion5), IMM
         REGION,AT(61,15,12,11),USE(?DayRegion6), IMM
         REGION,AT(73,15,12,11),USE(?DayRegion7), IMM
         REGION,AT(1,26,12,11), USE(?DayRegion8), IMM
         REGION,AT(13,26,12,11),USE(?DayRegion9), IMM
         REGION,AT(25,26,12,11),USE(?DayRegion10),IMM
         REGION,AT(37,26,12,11),USE(?DayRegion11),IMM
         REGION,AT(49,26,12,11),USE(?DayRegion12),IMM
         REGION,AT(61,26,12,11),USE(?DayRegion13),IMM
         REGION,AT(73,26,12,11),USE(?DayRegion14),IMM
         REGION,AT(1,37,12,11), USE(?DayRegion15),IMM
         REGION,AT(13,37,12,11),USE(?DayRegion16),IMM
         REGION,AT(25,37,12,11),USE(?DayRegion17),IMM
         REGION,AT(37,37,12,11),USE(?DayRegion18),IMM
         REGION,AT(49,37,12,11),USE(?DayRegion19),IMM
         REGION,AT(61,37,12,11),USE(?DayRegion20),IMM
         REGION,AT(73,37,12,11),USE(?DayRegion21),IMM
         REGION,AT(1,48,12,11), USE(?DayRegion22),IMM
         REGION,AT(13,48,12,11),USE(?DayRegion23),IMM
         REGION,AT(25,48,12,11),USE(?DayRegion24),IMM
         REGION,AT(37,48,12,11),USE(?DayRegion25),IMM
         REGION,AT(49,48,12,11),USE(?DayRegion26),IMM
         REGION,AT(61,48,12,11),USE(?DayRegion27),IMM
         REGION,AT(73,48,12,11),USE(?DayRegion28),IMM
         REGION,AT(1,59,12,11), USE(?DayRegion29),IMM
         REGION,AT(13,59,12,11),USE(?DayRegion30),IMM
         REGION,AT(25,59,12,11),USE(?DayRegion31),IMM
         REGION,AT(37,59,12,11),USE(?DayRegion32),IMM
         REGION,AT(49,59,12,11),USE(?DayRegion33),IMM
         REGION,AT(61,59,12,11),USE(?DayRegion34),IMM
         REGION,AT(73,59,12,11),USE(?DayRegion35),IMM
         REGION,AT(1,70,12,11), USE(?DayRegion36),IMM
         REGION,AT(13,70,12,11),USE(?DayRegion37),IMM
         STRING(''),AT(1,16,10,10), USE(?DayString1), TRN,RIGHT
         STRING(''),AT(13,16,10,10),USE(?DayString2), TRN,RIGHT
         STRING(''),AT(25,16,10,10),USE(?DayString3), TRN,RIGHT
         STRING(''),AT(37,16,10,10),USE(?DayString4), TRN,RIGHT
         STRING(''),AT(49,16,10,10),USE(?DayString5), TRN,RIGHT
         STRING(''),AT(61,16,10,10),USE(?DayString6), TRN,RIGHT
         STRING(''),AT(73,16,10,10),USE(?DayString7), TRN,RIGHT
         STRING(''),AT(1,27,10,10), USE(?DayString8), TRN,RIGHT
         STRING(''),AT(13,27,10,10),USE(?DayString9), TRN,RIGHT
         STRING(''),AT(25,27,10,10),USE(?DayString10),TRN,RIGHT
         STRING(''),AT(37,27,10,10),USE(?DayString11),TRN,RIGHT
         STRING(''),AT(49,27,10,10),USE(?DayString12),TRN,RIGHT
         STRING(''),AT(61,27,10,10),USE(?DayString13),TRN,RIGHT
         STRING(''),AT(73,27,10,10),USE(?DayString14),TRN,RIGHT
         STRING(''),AT(1,38,10,10), USE(?DayString15),TRN,RIGHT
         STRING(''),AT(13,38,10,10),USE(?DayString16),TRN,RIGHT
         STRING(''),AT(25,38,10,10),USE(?DayString17),TRN,RIGHT
         STRING(''),AT(37,38,10,10),USE(?DayString18),TRN,RIGHT
         STRING(''),AT(49,38,10,10),USE(?DayString19),TRN,RIGHT
         STRING(''),AT(61,38,10,10),USE(?DayString20),TRN,RIGHT
         STRING(''),AT(73,38,10,10),USE(?DayString21),TRN,RIGHT
         STRING(''),AT(1,49,10,10), USE(?DayString22),TRN,RIGHT
         STRING(''),AT(13,49,10,10),USE(?DayString23),TRN,RIGHT
         STRING(''),AT(25,49,10,10),USE(?DayString24),TRN,RIGHT
         STRING(''),AT(37,49,10,10),USE(?DayString25),TRN,RIGHT
         STRING(''),AT(49,49,10,10),USE(?DayString26),TRN,RIGHT
         STRING(''),AT(61,49,10,10),USE(?DayString27),TRN,RIGHT
         STRING(''),AT(73,49,10,10),USE(?DayString28),TRN,RIGHT
         STRING(''),AT(1,60,10,10), USE(?DayString29),TRN,RIGHT
         STRING(''),AT(13,60,10,10),USE(?DayString30),TRN,RIGHT
         STRING(''),AT(25,60,10,10),USE(?DayString31),TRN,RIGHT
         STRING(''),AT(37,60,10,10),USE(?DayString32),TRN,RIGHT
         STRING(''),AT(49,60,10,10),USE(?DayString33),TRN,RIGHT
         STRING(''),AT(61,60,10,10),USE(?DayString34),TRN,RIGHT
         STRING(''),AT(73,60,10,10),USE(?DayString35),TRN,RIGHT
         STRING(''),AT(1,71,10,10), USE(?DayString36),TRN,RIGHT
         STRING(''),AT(13,71,10,10),USE(?DayString37),TRN,RIGHT
         PANEL,AT(0,84,,1),USE(?Panel4),FULL,BEVEL(0,0,09H)
         BUTTON('&Speichern'),AT(3,90,60,12),USE(?OK),RIGHT,ICON('save.ico'),ALRT(UpKey),ALRT(DownKey),ALRT(LeftKey),ALRT(RightKey),TIP(C_TipCloseWithSave)
         BUTTON('S&chließen'),AT(65,90,60,12),USE(?Cancel),RIGHT,ICON('exit5.ico'),ALRT(UpKey),ALRT(DownKey),ALRT(LeftKey),ALRT(RightKey),TIP(C_TipCloseNoSave)
         BUTTON(),AT(127,90,15,12),USE(?PbHelp),ICON('help.ico'),ALRT(UpKey),ALRT(DownKey),ALRT(LeftKey),ALRT(RightKey),TIP(C_TipOpenHelp4Wnd)
       END

  CODE

  OPEN(TheWnd)

  PassedDate = TODAY()
  cSaveVar = PassedDate
  DayNumber = PassedDate
  MonthNumber = MONTH(PassedDate)
  YearNumber = YEAR(PassedDate)
  lTagesNr = DAY(PassedDate)
  DO CheckRange

  ACCEPT
    CASE EVENT()
    OF EVENT:AlertKey
      CASE FIELD()
      OF ?OK OROF ?Cancel
        OnAlertKey(KEYCODE())
      ELSE
        CASE KEYCODE()
        OF LeftKey
          PassedDate -=1
          IF MonthNumber <> MONTH(PassedDate) OR YearNumber <> YEAR(PassedDate)
            MonthNumber = MONTH(PassedDate)
            YearNumber  = YEAR(PassedDate)
          END
          lTagesNr = DAY(PassedDate)
          UpdateAssign = True
        OF RightKey
          PassedDate +=1
          IF MonthNumber <> MONTH(PassedDate) OR YearNumber <> YEAR(PassedDate)
            MonthNumber = MONTH(PassedDate)
            YearNumber  = YEAR(PassedDate)
          END
          lTagesNr = DAY(PassedDate)
          UpdateAssign = True
        OF UpKey
          MonthNumber -=1
          ChangeMonthYear = True
        OF DownKey
          MonthNumber +=1
          ChangeMonthYear = True
        OF PgUpKey
          YearNumber -= 1
          ChangeMonthYear = True
        OF PgDnKey
          YearNumber += 1
          ChangeMonthYear = True
        OF EnterKey OROF MouseLeft2
          POST(EVENT:Accepted,?OK)
        END
        IF MonthNumber > 12
          MonthNumber = 1
          YearNumber +=1
        ELSIF MonthNumber < 1
          MonthNumber = 12
          YearNumber -=1
        END
        IF ChangeMonthYear
          ChangeMonthYear = False
          PassedDate = DEFORMAT((FORMAT(lTagesNr,@P##P) & '.' &|
                                 FORMAT(MonthNumber,@P##P) & '.' &|
                                 FORMAT(YearNumber,@P####P)),@D06.)
          lTagesNr = DAY(PassedDate)
          UpdateAssign = True
        END
        DO CheckRange
      END
    END
    CASE FIELD()
    OF ?MonthNumber
      IF EVENT() = EVENT:NewSelection
        IF MonthNumber > 12
          MonthNumber = 1
          YearNumber +=1
        ELSIF MonthNumber < 1
          MonthNumber = 12
          YearNumber -=1
        END
        PassedDate = DEFORMAT((FORMAT(lTagesNr,@P##P) & '.' &|
                               FORMAT(MonthNumber,@P##P) & '.' &|
                               FORMAT(YearNumber,@P####P)),@D06.)
        UpdateAssign = True
        MonthNumber = MONTH(PassedDate)
        YearNumber = YEAR(PassedDate)
        lTagesNr = DAY(PassedDate)
        DO CheckRange
      END
    OF ?YearNumber
      IF EVENT() = EVENT:NewSelection
        PassedDate = DEFORMAT((FORMAT(lTagesNr,@P##P) & '.' &|
                               FORMAT(MonthNumber,@P##P) & '.' &|
                               FORMAT(YearNumber,@P####P)),@D06.)
        UpdateAssign = True
        MonthNumber = MONTH(PassedDate)
        YearNumber = YEAR(PassedDate)
        lTagesNr = DAY(PassedDate)
        DO CheckRange
      END
    OF ?TodayButton
      IF EVENT() = EVENT:Accepted
        MonthNumber = MONTH(TODAY())
        YearNumber  = YEAR(TODAY())
        PassedDate  = TODAY()
        lTagesNr = DAY(PassedDate)
        UpdateAssign = True
        DO CheckRange
      END
    END
    IF EVENT() = EVENT:Accepted
      CASE FIELD()
      OF ?OK
        SETTODAY(PassedDate)   !Systemdatum setzen
        PassedDate = TODAY()
        cSaveVar = PassedDate
        POST(EVENT:CloseWindow)
      OF ?Cancel
        POST(EVENT:CloseWindow)
      OF ?PbHelp
        HELP(,TheWnd{Prop:Hlp})
      ELSE
        LOOP DayRegion# = ?DayRegion1 TO ?DayRegion37
          IF FIELD() = DayRegion#
            DayString# = DayRegion#+37
            IF DayString#{PROP:TEXT} <> ''
              PassedDate = DEFORMAT(DayString#{PROP:TEXT} &'/' &MonthNumber &'/' &YearNumber,@D6)
              lTagesNr = DAY(PassedDate)
              UpdateAssign = True
              DO CheckRange
            END
          END
        END
      END
    END
  END
  CLOSE(TheWnd)
  RETURN

SetWindowTitle ROUTINE
  EXECUTE MonthNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Januar ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Februar ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. März ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. April ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Mai ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Juni ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Juli ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. August ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. September ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Oktober ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. November ' & YearNumber
    TheWnd{PROP:TEXT} = lTagesNr & '. Dezember ' & YearNumber
  END

AssignAllStrings ROUTINE
  CASE MonthNumber
  OF 4 OROF 6 OROF 9 OROF 11
    MaxDays#=30
  OF 2
    IF YearNumber % 4 = 0
      MaxDays# = 29
    ELSE
      MaxDays# = 28
    END
  ELSE
    MaxDays# = 31
  END
  LOOP DayString# = ?DayString1 TO ?DayString7
    IF DayString# - ?DayString1 + 1 = DEFORMAT(('1/' &MonthNumber &'/' & YearNumber),@D6) % 7 OR DayString# = ?DayString7
      DayString#{PROP:TEXT} = '1'
      IF DEFORMAT(DayString#{PROP:Text},@n2) = DAY(DayNumber) AND MonthNumber = MONTH(DayNumber) AND YearNumber = YEAR(DayNumber)
        DayString#{PROP:FontColor} = COLOR:Blue
        DayString#{PROP:FontStyle} = FONT:Bold
      END
      LOOP DayRegion# = DayString#+1 TO ?DayString37
        DayPrev# = DayRegion#-1
        IF DayPrev#{PROP:TEXT} <> '' AND (DEFORMAT(DayPrev#{PROP:TEXT},@n2) + 1) NOT > MaxDays#
           DayRegion#{PROP:TEXT} = DEFORMAT(DayPrev#{PROP:TEXT},@n2) + 1
           IF DEFORMAT(DayRegion#{PROP:Text},@n2) = DAY(DayNumber) AND MonthNumber = MONTH(DayNumber) AND YearNumber = YEAR(DayNumber)
             DayRegion#{PROP:FontColor} = COLOR:Blue
             DayRegion#{PROP:FontStyle} = FONT:Bold
           ELSE
             DayRegion#{PROP:FontColor} = COLOR:Black
             DayRegion#{PROP:FontStyle} = FONT:Regular
           END
        ELSE
           DayRegion#{PROP:TEXT} = ''
        END
      END
      BREAK
    ELSE
      DayString#{PROP:TEXT} = ''
    END
  END

HighlightPassedDate ROUTINE
  LOOP DayString# = ?DayString1 TO ?DayString37
    IF DayString#{PROP:Text} = DAY(PassedDate) AND MonthNumber = MONTH(PassedDate) AND YearNumber = YEAR(PassedDate)
      DayRegion# = DayString#-37
      DayRegion#{PROP:BevelOuter} = 1
      DayRegion#{PROP:BevelInner} = -1
      BREAK
    END
  END

ClearHighlight ROUTINE
  LOOP DayRegion# = ?DayRegion1 TO ?DayRegion37
    IF DayRegion#{PROP:Bevel} <> 0
      DayRegion#{PROP:Bevel} = 0
    END
  END

CheckRange ROUTINE
  IF YearNumber < 1801
    PassedDate = 4
    MonthNumber = MONTH(PassedDate)
    YearNumber = YEAR(PassedDate)
    UpdateAssign = True
    MESSAGE('Der Kalender reicht nur bis Jahr 1801.','Ungültiges Datum')
  ELSIF YearNumber > 2099
    PassedDate = 109211
    MonthNumber = MONTH(PassedDate)
    YearNumber = YEAR(PassedDate)
    UpdateAssign = True
    MESSAGE('Der Kalender reicht nur bis Jahr 2099.','Ungültiges Datum')
  END
  IF UpdateAssign
    DO SetWindowTitle
  END
  DO ClearHighlight
  IF UpdateAssign
    DO AssignAllStrings
  END
  DO HighlightPassedDate
  UpdateAssign = False