CalendarGadget mit eigenem Font

Für allgemeine Fragen zur Programmierung mit PureBasic.
BSP
Beiträge: 203
Registriert: 01.02.2009 14:04

CalendarGadget mit eigenem Font

Beitrag von BSP »

Hallo Allerseits.
Ich hatte hier schon nach dem Thema gesucht aber nicht brauchbares gefunden. (Oder übersehen).
Darum habe ich nun ein eigenes "Gadget" gebastelt. (Ist noch nicht ganz fertig, funktioniert aber soweit).
Ihr findet dort auch einen "C" Button.
Der ist dazu gedacht: Bei Klick darauf wird das ausgewählte Datum ins ClipBoard gelegt. (Jahr.Monat.Tag).
Das ist z.B. dazu gedacht, damit man damit Dateien sortieren kann.
Klick aufs Datum, Klick auf C und schon kann man das Datum im Dateinamen vorne Vorhängen.
Hier also das Progrämmchen:

Code: Alles auswählen

; ==============================
; PureBasic Kalender Gadget mit ISO-KW
; ==============================
; PureBasic Kalender Gadget
; Version: 1.0 – 17.01.2026
; Autor: Eigenentwicklung + ChatGPT Hilfe
; Zweck: Eigenes Kalender-Gadget mit anpassbarer Schrift und Farben
; Features:
; - Tagesbuttons mit eigener Schrift (Titel + Tagesschrift)
; - Farben für Heute, Wochenende, ausgewählte Tage
; - Navigation: vorheriger / nächster Monat
; - Anzeige beim Klick auf einen Tag
; - Alle Buttons dynamisch erstellt
; ==============================

; ------------------------------
; Globale Variablen
; ------------------------------
Enumeration gadgets
  #CalBtnPrev   = 100
  #CalBtnNext   = 101
  #CalTxtMonth  = 102
  #CalTxtSelect = 103
  #CalBtnToday  = 104
  #CalBtnCopy = 105
  
EndEnumeration

Structure calendar_t
  Container.i
  CurrentMonth.i
  CurrentYear.i
  SelectedDay.i
  Array DayButton.i(41, 2)
  FontTitle.i
  FontDay.i
  Array ISOWeekGadget.i(5) ; für 6 Kalenderwochen
EndStructure

Global *cal.calendar_t
Global monate$ = "Januar,Februar,März,April,Mai,Juni,Juli,August,September,Oktober,November,Dezember"
Global wochentag$ = "Mo,Di,Mi,Do,Fr,Sa,So,"

; Farben
#Col_NormalBG  = $FFFFFF
#Col_WeekendBG = $9EB6F7
#Col_TodayBG   = $C8F0C8
#Col_SelectBG  = $FFD0A0
#Col_Text      = $000000

; ------------------------------
; Hilfsfunktionen
; ------------------------------
Procedure ISOWeek(DateValue)
  Protected year, jan4, jan4_wday, week
  
  year = Year(DateValue)
  
  ; Donnerstag entscheidet
  Protected wday = DayOfWeek(DateValue)
  If wday = 0 : wday = 7 : EndIf  ; Sonntag -> 7
  
  ; Donnerstag dieser Woche
  Protected thursday = AddDate(DateValue, #PB_Date_Day, 4 - wday)
  
  year = Year(thursday)
  
  ; 4. Januar des ISO-Jahres
  jan4 = Date(year, 1, 4, 0, 0, 0)
  jan4_wday = DayOfWeek(jan4)
  If jan4_wday = 0 : jan4_wday = 7 : EndIf
  
  ; ISO-Woche berechnen
  week = 1 + (DayOfYear(thursday) - (4 - jan4_wday)) / 7
  
  ProcedureReturn week
EndProcedure

Procedure UpdatecalendarHeader(*cal.Calendar_t)
  SetGadgetText(#CalTxtMonth, StringField(monate$, *cal\CurrentMonth, ",") + " " + Str(*cal\CurrentYear))
EndProcedure

Procedure SetDayButtonImage(*cal.Calendar_t, idx, gadget, text.s, backColor)
  Protected img, w = GadgetWidth(gadget), h = GadgetHeight(gadget)
  
  ; altes Image freigeben
  If *cal\DayButton(idx, 2)
    FreeImage(*cal\DayButton(idx, 2))
    *cal\DayButton(idx, 2) = 0
  EndIf
  
  img = CreateImage(#PB_Any, w, h, 32, backColor)
  *cal\DayButton(idx, 2) = img
  
  If StartDrawing(ImageOutput(img))
    Box(0, 0, w, h, backColor)
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText((w - TextWidth(text)) / 2, (h - TextHeight(text)) / 2, text, #Col_Text)
    StopDrawing()
  EndIf
  
  SetGadgetAttribute(gadget, #PB_Button_Image, ImageID(img))
EndProcedure

Procedure ResetDayButton(*cal.Calendar_t, gadget)
  SetGadgetColor(gadget, #PB_Gadget_BackColor, #Col_NormalBG)
  SetGadgetColor(gadget, #PB_Gadget_FrontColor, #Col_Text)
EndProcedure

Procedure DaysInMonth(Month, Year)
  Protected d = Date(Year, Month, 1, 0, 0, 0)
  d = AddDate(d, #PB_Date_Month, 1)
  d = AddDate(d, #PB_Date_Day, -1)
  ProcedureReturn Day(d)
EndProcedure

Procedure FirstWeekDay(Month, Year)
  Protected d = Date(Year, Month, 1, 0, 0, 0)
  ProcedureReturn (DayOfWeek(d) + 6) % 7
EndProcedure

Procedure GetDayColor(*cal.Calendar_t, day, month, year)
  Protected d = Date(year, month, day, 0, 0, 0)
  Protected wday = DayOfWeek(d)
  Protected color = #Col_NormalBG
  If wday = 0 Or wday = 6 : color = #Col_WeekendBG : EndIf
  If day = Day(Date()) And month = Month(Date()) And year = Year(Date()) : color = #Col_TodayBG : EndIf
  If day = *cal\SelectedDay : color = #Col_SelectBG : EndIf
  ProcedureReturn color
EndProcedure

Procedure Drawcalendar(*cal.Calendar_t)
  Protected i, day = 1
  Protected start = FirstWeekDay(*cal\CurrentMonth, *cal\CurrentYear)
  Protected days = DaysInMonth(*cal\CurrentMonth, *cal\CurrentYear)
  
  ; Tagesbuttons
  day = 1
  For i = 0 To 41
    ResetDayButton(*cal, *cal\DayButton(i, 0))
    If i >= start And day <= days
      SetDayButtonImage(*cal, i, *cal\DayButton(i, 0), Str(day), GetDayColor(*cal, day, *cal\CurrentMonth, *cal\CurrentYear))
      *cal\DayButton(i, 1) = day
      day + 1
    Else
      SetDayButtonImage(*cal, i, *cal\DayButton(i, 0), "", #Col_NormalBG)
      *cal\DayButton(i, 1) = 0
    EndIf
  Next
  
  ; ISO-KW je Kalenderzeile setzen
  For y = 0 To 5
    Protected weekDay = 0
    Protected day1 = 0
    
    ; ersten echten Tag der Kalenderzeile suchen
    For x = 0 To 6
      day1 = *cal\DayButton(y * 7 + x, 1)
      If day1 > 0
        Break
      EndIf
    Next
    
    If day1 > 0
      Protected d = Date(*cal\CurrentYear, *cal\CurrentMonth, day1, 0, 0, 0)
      SetGadgetText(*cal\ISOWeekGadget(y), Str(ISOWeek(d)))
    Else
      SetGadgetText(*cal\ISOWeekGadget(y), "")
    EndIf
  Next
EndProcedure

Procedure auswahl_anzeigen(*cal.Calendar_t)
  Protected text$, d, d$
  text$ = ""
  If *cal\SelectedDay > 0 And *cal\SelectedDay <= DaysInMonth(*cal\CurrentMonth, *cal\CurrentYear)
    text$ = RSet(Str(*cal\SelectedDay), 2, "0") + "."
    text$ + RSet(Str(*cal\CurrentMonth), 2, "0") + "."
    text$ + Str(*cal\CurrentYear)
    d = Date(*cal\CurrentYear, *cal\CurrentMonth, *cal\SelectedDay, 0, 0, 0)
    d = DayOfWeek(d)
    d$ = StringField(wochentag$, d+1, ",")
    text$ = d$ + "." + text$
  EndIf
  SetGadgetText(#CalTxtSelect, text$)
EndProcedure

;------------------------------
; Kalender-Container erstellen
;------------------------------
Procedure Calendar_Create(Window, x, y, w, h)
  Protected *cal.Calendar_t
  *cal = AllocateStructure(Calendar_t)
  If *cal = 0 : ProcedureReturn 0 : EndIf
  
  *cal\Container = ContainerGadget(#PB_Any, x, y, w, h, #PB_Container_Flat)
  
  *cal\FontTitle = LoadFont(#PB_Any, "Arial", 16, #PB_Font_Bold)
  *cal\FontDay   = LoadFont(#PB_Any, "Arial", 12)
  
  ; Monatsnavigation
  ButtonGadget(#CalBtnPrev, 40, 10, 40, 30, "<")
  ButtonGadget(#CalBtnNext, 300, 10, 40, 30, ">")
  
  ; Monatsanzeige & Auswahl
  TextGadget(#CalTxtMonth, 80, 10, 200, 30, "", #PB_Text_Center)
  SetGadgetFont(#CalTxtMonth, FontID(*cal\FontTitle))
  TextGadget(#CalTxtSelect, 80, GadgetHeight(*cal\Container)-40, 200, 30, "", #PB_Text_Center)
  SetGadgetFont(#CalTxtSelect, FontID(*cal\FontTitle))
  
  ; Wochentage
  Define WeekDay.s
  For i = 0 To 6
    WeekDay = StringField(wochentag$, i+1, ",")
    TextGadget(200+i,40 + i*45, 50, 45, 20, WeekDay, #PB_Text_Center)
  Next
  
  ButtonGadget(#CalBtnToday, (w - 80) / 2, h - 75, 80, 25, "Heute")
  ButtonGadget(#CalBtnCopy, (w - 80) / 2 + 90, h - 75, 30, 25, "C")
  
  
  ; ISO-KW Spalte links
  For y = 0 To 5
    *cal\ISOWeekGadget(y) = TextGadget(#PB_Any, 10, 75+9 + y*35, 30, 30, "", #PB_Text_Center)
  Next
  
  ; Tagesbuttons 6x7
  Define x, y, idx = 0
  For y = 0 To 5
    For x = 0 To 6
      *cal\DayButton(idx,0) = ButtonImageGadget(#PB_Any, 40 + x*45, 75 + y*35, 45, 30, 0)
      *cal\DayButton(idx,1) = 0
      idx + 1
    Next
  Next
  
  CloseGadgetList()
  ProcedureReturn *cal
EndProcedure

Procedure Hauptfenster()
  OpenWindow(0, 0, 0, 380, 385, "Kalender", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  *cal = Calendar_Create(0, 10, 10, 360, 365)
EndProcedure

;------------------------------
; Program Start
;------------------------------
Hauptfenster()
*cal\CurrentMonth = Month(Date())
*cal\CurrentYear  = Year(Date())
*cal\SelectedDay  = 0

Drawcalendar(*cal)
UpdatecalendarHeader(*cal)

;------------------------------
; Eventloop
;------------------------------
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #CalBtnPrev
          *cal\CurrentMonth - 1
          If *cal\CurrentMonth < 1
            *cal\CurrentMonth = 12
            *cal\CurrentYear - 1
          EndIf
          Drawcalendar(*cal)
          UpdatecalendarHeader(*cal)
          auswahl_anzeigen(*cal)
        Case #CalBtnNext
          *cal\CurrentMonth + 1
          If *cal\CurrentMonth > 12
            *cal\CurrentMonth = 1
            *cal\CurrentYear + 1
          EndIf
          Drawcalendar(*cal)
          UpdatecalendarHeader(*cal)
          auswahl_anzeigen(*cal)
        Case #CalBtnToday
          *cal\CurrentMonth = Month(Date())
          *cal\CurrentYear  = Year(Date())
          *cal\SelectedDay  = Day(Date())
          
          Drawcalendar(*cal)
          UpdatecalendarHeader(*cal)
          auswahl_anzeigen(*cal)
        Case #CalBtnCopy
          If *cal\SelectedDay > 0
            d$ = RSet(Str(*cal\CurrentYear), 4, "0") + "." +
                 RSet(Str(*cal\CurrentMonth), 2, "0") + "." +
                 RSet(Str(*cal\SelectedDay), 2, "0")
            SetClipboardText(d$)
          EndIf
          
        Default
          For i = 0 To 41
            If EventGadget() = *cal\DayButton(i,0)
              *cal\SelectedDay = *cal\DayButton(i,1)
              Drawcalendar(*cal)
              auswahl_anzeigen(*cal)
              Break
            EndIf
          Next
      EndSelect
  EndSelect
ForEver
Viel Spass damit. Vieleicht kanns ja jemannd gebrauchen.
Gruß: Bernd (BSP)
PB 5.31 (x86) & (x64) Win10
BSP
Beiträge: 203
Registriert: 01.02.2009 14:04

Re: CalendarGadget mit eigenem Font

Beitrag von BSP »

Hallo Allerseits.
So. Ich habe mal weiter gebastelt. Oder besser gesagt: Neu gebastelt.
Die erste Variante hat mir auch nicht so gut gefallen. Zu viele Buttons.
Aber sie zeigt. Ist man erst einmal auf dem falschen Gleis, wird man durch KI leicht dazu verführt,
auf dem Gleis zu bleiben und weiter zu machen. Aber: Es hat echt Spass gemacht, mit der KI zu arbeiten. Grins.

Nun habe ich eine vollständig neue Variante entwickelt.
Bis auf den Teil mit der Kalenderwoche ist die vollständig auf meinen eigenen Mist gewachsen.
(Ich verstehe noch nicht so genau, wie man die Kalenderwoche berechnet. Kommt aber noch).
Ich möchte Euch die schon mal vorstellen.

Als nächstes werde ich nun aber KI einsetzen.
Mit ihr will ich das Programm aufräumen und sortieren.
Zum Schluss sollen die relevanten Teile gekapselt werden,
so das darauf wirklich so etwas wie ein eigenes "Gadget" wird.
Frage: Soll ich die alte (2te) Version durch die KI- veränderte Version ersetzen oder die KI- Version darunter setzen.
So als Beispiel dafür wie unterschiedlich KI und unprofesioneller Mensch denken?
Hier nun also die neue (2te) Version:

Code: Alles auswählen

;-===== Konstanten
Enumeration Fenster
  #hwnd
EndEnumeration

Enumeration menu
  #taste_esc
  #taste_str
EndEnumeration

;-===== Globals
Global tag$ = "Mo.Di.Mi.Do.Fr.Sa.So"
Global mon$ = "Januar.Februar.März.April.Mai.Juni.Juli.August.September.Oktober.November.Dezember"

;-===== Structuren

Structure blatt
  col_text.i
  col_hintergrund.i
  col_sonntag.i
  col_aktuell.i
  col_auswahl.i
  canvas.i
  starttag.i
  datum.i
EndStructure
;Global blatt.blatt

Structure kalender
  win.i
  scrgadg.i
  datum.i
  x.i
  y.i
  w.i
  h.i
  feldw.i
  feldh.i
  font1.i
  font2.i
  txth2.i
  txth_buttons.i
  col_hintergrund.i
  butt_mvor.i
  butt_mzur.i
  butt_yvor.i
  butt_yzur.i
  butt_heute.i
  butt_kopie.i
  butt_beenden.i
  text_datum.i
  auswahl_datum.i
  List blatt.blatt()
EndStructure
Global NewList kalender.kalender()

Procedure TextXY(text.s, FontID, *xy.POINT)
  ; Plattform unabhängig
  StartDrawing(WindowOutput((0)))
  DrawingFont(FontID)
  *xy\x = TextWidth(text)
  *xy\y = TextHeight(text)
  StopDrawing()
  ProcedureReturn
  
  ; Oder, wers lieber in Window mag.
  ; Oberen Teil auskommentieren
  Protected dc = GetDC_(0)
  SelectObject_(dc, FontID)
  GetTextExtentPoint32_(dc, text, Len(text), *xy)
  ReleaseDC_(0, dc)
EndProcedure
Procedure ISOWeek(DateValue)
  Protected year, jan4, jan4_wday, week
  
  year = Year(DateValue)
  
  ; Donnerstag entscheidet
  Protected wday = DayOfWeek(DateValue)
  If wday = 0 : wday = 7 : EndIf  ; Sonntag -> 7
  
  ; Donnerstag dieser Woche
  Protected thursday = AddDate(DateValue, #PB_Date_Day, 4 - wday)
  
  year = Year(thursday)
  
  ; 4. Januar des ISO-Jahres
  jan4 = Date(year, 1, 4, 0, 0, 0)
  jan4_wday = DayOfWeek(jan4)
  If jan4_wday = 0 : jan4_wday = 7 : EndIf
  
  ; ISO-Woche berechnen
  week = 1 + (DayOfYear(thursday) - (4 - jan4_wday)) / 7
  
  ProcedureReturn week
EndProcedure

Procedure Tage_Im_Monat(datum)
  Protected month = Month(datum)
  Protected year  = Year(datum)
  Protected d = Date(year, month, 1, 0, 0, 0)
  d = AddDate(d, #PB_Date_Month, 1)
  ProcedureReturn Day(AddDate(d, #PB_Date_Day, -1))
EndProcedure

Procedure datum_ermitteln(datum, mx, my)
  ;datum = kalender()\datum
  mx - kalender()\feldw; * 2
  my - kalender()\feldh * 2
  fx = mx / kalender()\feldw
  fy = my / kalender()\feldh
  d = Date(Year(datum), Month(datum), 1, 0, 0, 0)
  d = DayOfWeek(d)
  If d = 0 : d = 7 : EndIf
  feld = fy * 7 + fx + 1 - (d -  1)
  fx = d
  a$ = RSet(Str(feld), 2, "0") + "." + RSet(Str(Month(datum)), 2, "0") + "." + Str(Year(datum))
  datum = ParseDate("%dd.%mm.%yyyy", a$)
  If Not Day(datum) = -1
    SetGadgetText(kalender()\text_datum, a$)
    kalender()\auswahl_datum = datum
    SetClipboardText(Str(Year(datum)) + "." + RSet(Str(Month(datum)), 2, "0") + "." + RSet(Str(feld), 2, "0"))
    Debug GetClipboardText()  
  Else
    SetGadgetText(kalender()\text_datum, "")
    kalender()\auswahl_datum = datum
    kalender()\auswahl_datum = datum
    SetClipboardText("")
  EndIf
  
EndProcedure

Procedure kalender_schliessen()
  If IsGadget(kalender()\butt_mvor) : FreeGadget(kalender()\butt_mvor) : EndIf
  If IsGadget(kalender()\butt_mzur) : FreeGadget(kalender()\butt_mzur) : EndIf
  If IsGadget(kalender()\butt_heute) : FreeGadget(kalender()\butt_heute) : EndIf
  If IsGadget(kalender()\butt_kopie) : FreeGadget(kalender()\butt_kopie) : EndIf
  If IsGadget(kalender()\butt_beenden) : FreeGadget(kalender()\butt_beenden) : EndIf
  If IsGadget(kalender()\text_datum) : FreeGadget(kalender()\text_datum) : EndIf
  If IsGadget(kalender()\auswahl_datum) : FreeGadget(kalender()\auswahl_datum) : EndIf
  ForEach kalender()\blatt()
    If IsGadget(kalender()\blatt()\canvas) : FreeGadget(kalender()\blatt()\canvas) : EndIf
  Next
  If IsGadget(kalender()\win)
    FreeGadget(kalender()\win)
  Else
    CloseWindow(kalender()\win)
  EndIf
  DeleteElement(kalender())
EndProcedure

Procedure create_kalender(winx, winy, font1, font2, hwnd, anz_bleatter, ausrichtung$, sichtbar, art$ = "statisch")
  rahmen = 8
  
  ; --- startposition   <  Heute  > Buttons
  winh = 4 
  TextXY("XYZ_ÜQ0", FontID(font1), @xy.POINT)
  xy\y + rahmen * 2
  butth = xy\y
  
  ; --- Posititon des Canvas
  winh + butth + 4 
  
  TextXY("000", FontID(font2), @xy.POINT)
  txth2 = xy\y
  feldh = xy\y + rahmen
  canvash = feldh * 7+4
  scrrand = 4
  If ausrichtung$ = "u" ; untereinander
    scrh = (canvash + 4) * sichtbar + scrrand
    scrh1 = (canvash + 4) * anz_bleatter
    If anz_bleatter > 1
      scrw = 18
      EndIf
  Else
    scrh = (canvash + 4) + scrrand
    scrh1 = (canvash + 4); * sichtbar
  EndIf
  
  feldw = xy\x + rahmen * 2
  canvasw = feldw * 8 + 4
  If ausrichtung$ = "n" ; nebeneinander
    scrw + (canvasw + 4) * sichtbar + scrrand
    scrw1 = (canvasw + 4) * anz_bleatter
    If anz_bleatter > 1
      scrh + 18
    EndIf
  Else
    scrw + canvasw + 4 + scrrand
    scrw1 = canvasw + 4
  EndIf
  winh + scrh
  winw = scrw
  winw + 20
  
;   scrrand = 50
;   scrw1 = canvasw 
;   scrh1 = (canvash + 4) * anz_bleatter
;   scrw = scrw1 + scrrand
  ;scrh = (canvash + 4) * sichtbar + scrrand
  
   ; --- Position für eine Werkzeugleiste z.B. der "C" Button
  winh + butth + 4 
  ; --- Position für das ausgewählte Datum
  winh + butth + 4 
  ; --- Ende
   winh + 4
 
  AddElement(kalender())
  ;kalender()\win = OpenWindow(#PB_Any, winx, winy, winw, winh, "Kalender", #PB_Window_SystemMenu, hwnd)
  If art$ = "statisch"
    UseGadgetList(WindowID(hwnd))
    kalender()\win = ContainerGadget(#PB_Any, winx, winy,winw, winh, #PB_Container_Raised)
  Else
    kalender()\win = OpenWindow(#PB_Any, winx, winy, winw, winh, "Kalender", #PB_Window_SystemMenu, hwnd)
    StickyWindow(kalender()\win, #True)
  EndIf
  kalender()\font2 = font2
  kalender()\feldw = feldw
  kalender()\feldh = feldh
  kalender()\datum = Date()
  
  ; -==== Die obere Leiste  "<  Heute  >"
  y = 4
  ;--- Button zur
  x = 4
  kalender()\butt_yzur = ButtonGadget(#PB_Any, x, y, butth, butth,"<<")
  SetGadgetFont(kalender()\butt_yzur, FontID(font1))
  GadgetToolTip(kalender()\butt_yzur, "Jahr Zurück")
  x + butth
  kalender()\butt_mzur = ButtonGadget(#PB_Any, x, y, butth, butth,"<")
  SetGadgetFont(kalender()\butt_mzur, FontID(font1))
  GadgetToolTip(kalender()\butt_mzur, "Monat Zurück")
  
  ;--- Butto vor
  x = 4 + canvasw - butth
  kalender()\butt_yvor = ButtonGadget(#PB_Any, x, y, butth, butth,">>")
  SetGadgetFont(kalender()\butt_yvor, FontID(font1))
  GadgetToolTip(kalender()\butt_yvor, "Jahr Weiter")
  x - butth
  kalender()\butt_mvor = ButtonGadget(#PB_Any, x, y, butth, butth,">")
  SetGadgetFont(kalender()\butt_mvor, FontID(font1))
  GadgetToolTip(kalender()\butt_mvor, "Monat Weiter")
  
  ; --- Button Heute
  a$ = "Heute"
  TextXY(a$, FontID(font1), @xy.POINT)
  txtw = xy\x + 32
  v = GadgetX(kalender()\butt_mzur) + GadgetWidth(kalender()\butt_mzur)
  b = GadgetX(kalender()\butt_yvor)
  w = b - v
  x = v + (w - txtw) / 2
  kalender()\butt_heute = ButtonGadget(#PB_Any, x, y, txtw, butth,a$)
  SetGadgetFont(kalender()\butt_heute, FontID(font1))
  
  ;--- Das Canvas
  y + butth + 4
  y1 = y
  x1 = 4
  kalender()\scrgadg = ScrollAreaGadget(#PB_Any, x1, y1, scrw, scrh,scrw1, scrh1, canvash + 4)
  SetGadgetColor(kalender()\scrgadg, #PB_Gadget_BackColor, $D3D3D3)
  y1 = 2
  x1 = 2
  For i = 1 To anz_bleatter
    AddElement(kalender()\blatt())
    kalender()\blatt()\canvas = CanvasGadget(#PB_Any, x1, y1, canvasw, canvash, #PB_Canvas_Border)
    If ausrichtung$ = "u"
      y1 + canvash + 4
    ElseIf ausrichtung$ = "n"
      x1 + canvasw + 4
    EndIf
  Next
  CloseGadgetList()
  
  y + scrh + 4
;   If ausrichtung$ = "u"
;     y + (scrh + 4) * anz_bleatter
;   Else
;     y + (canvash + 4)
;   EndIf
  
  ; --- Die Werkzeugleiste
  x = 4
  kalender()\butt_kopie = ButtonGadget(#PB_Any, x, y, butth, butth,"C")
  
  txt$ = "Beenden"
  TextXY(txt$, FontID(font1), xy.POINT)
  xy\x + 16
  x = GadgetWidth(kalender()\blatt()\canvas) - xy\x - 4
  kalender()\butt_beenden = ButtonGadget(#PB_Any, x, y, xy\x, butth,txt$)
  
  x = 4
  y + butth + 4
  kalender()\text_datum = TextGadget(#PB_Any, 4, y, GadgetWidth(kalender()\blatt()\canvas), butth, "", #PB_Text_Center)
  SetGadgetFont(kalender()\text_datum, FontID(font1))
  If IsGadget(kalender()\win)
    CloseGadgetList()
  EndIf
EndProcedure


Procedure schreibe_kalenderblatt(canvas)
  ;kalender()\blatt()\datum = datum
  datum = kalender()\blatt()\datum
  ;canvas = kalender()\blatt()\canvas
  feldw = kalender()\feldw
  feldh = kalender()\feldh
  
  NewList txtx.i()
  For i = 1 To 7
    a$ = StringField(tag$, i, ".")
    TextXY(a$, FontID(kalender()\font2), @xy.POINT)
    AddElement(txtx())
    txtx() = (feldw - xy\x) / 2
  Next
  txty = (feldh - xy\y) / 2
  
  month = Month(datum)
  year  = Year(datum)
  letzter_tag = Tage_Im_Monat(datum)
  
  NewList txtx1.i()
  For i = 1 To letzter_tag
    a$ = Str(i)
    TextXY(a$, FontID(kalender()\font2), @xy.POINT)
    AddElement(txtx1())
    txtx1() = (feldw - xy\x) / 2
  Next
  txty1 = (feldh - xy\y) / 2
  
  m$ = StringField(mon$, Month(datum), ".")
  TextXY(m$, FontID(kalender()\font2), @xy.POINT)
  monatx = (GadgetWidth(canvas)-xy\x)/2
  
  StartDrawing(CanvasOutput(canvas))
  DrawingFont(FontID(kalender()\font2))
  
  Box(0,0,GadgetWidth(canvas)-3, GadgetHeight(canvas)-3,0)
  Box(1,1,GadgetWidth(canvas)-6, GadgetHeight(canvas)-6,kalender()\blatt()\col_hintergrund)
  
  Box(0,0,GadgetWidth(canvas)-4,feldh,0)
  Box(1,1,GadgetWidth(canvas)-6,feldh-2,kalender()\blatt()\col_hintergrund)
  ypos = 0
  DrawText(x + 6, 4, Str(year), $000000, kalender()\blatt()\col_hintergrund)
  DrawText(monatx, 4, m$,$000000, kalender()\blatt()\col_hintergrund)
  DrawText(GadgetWidth(canvas)-feldh, 4, RSet(Str(Month),2,"0"), $000000, kalender()\blatt()\col_hintergrund)
  
  ; --- Die Wochentage
  ypos + feldh
  ForEach txtx() : i = ListIndex(txtx())+1
    x = i * feldw
    a$ = StringField(tag$, i, ".")
    Box(x, ypos, feldw, feldh, $000000)
    Box(x+1, ypos+1, feldw-2, feldh-2, kalender()\blatt()\col_hintergrund)
    DrawText(x + txtx(), ypos+2+txty, a$,$000000, kalender()\blatt()\col_hintergrund)
  Next
  
  ClearList(txtx())
  ; --- das datum
  d = Date(Year, Month, 1, 0, 0, 0)
  d = DayOfWeek(d)
  If d = 0 : d = 7 : EndIf
  fx = d
  fy = 1
  ypos + felth
  ForEach txtx1() : i = ListIndex(txtx1())
    x = fx * feldw+2
    y = ypos+fy * feldh+2
    a$ = Str(i+1)
    col = kalender()\blatt()\col_hintergrund
    If fx = 7
      col = kalender()\blatt()\col_sonntag
    EndIf
    If   Year  = Year(Date()) And Month = Month(Date()) And i+1 = Day(Date())
      col = kalender()\blatt()\col_aktuell
    EndIf
    If   Year  = Year(kalender()\auswahl_datum) And Month = Month(kalender()\auswahl_datum) And i+1 = Day(kalender()\auswahl_datum)
      col = kalender()\blatt()\col_auswahl
    EndIf
    
    Box(x, y, feldw-4, feldh-3, $000000)
    Box(x+1, y+1, feldw-6, feldh-5, col)
    DrawText(x+1 + txtx1(), y+txty1-2, a$,$000000, col)
    fx + 1
    If fx = 8
      fy + 1
      fx = 1
    EndIf
  Next
  
; ==============================
; ISO-Kalenderwoche je Zeile
; ==============================

Protected startDate = Date(Year, Month, 1, 0, 0, 0)
Protected startWDay = DayOfWeek(startDate)
If startWDay = 0 : startWDay = 7 : EndIf   ; Sonntag -> 7

; Offset zum Montag der ersten Kalenderzeile
Protected firstMonday = AddDate(startDate, #PB_Date_Day, -(startWDay - 1))

DrawingFont(FontID(kalender()\font2))

For row = 0 To 5
  Protected mondayDate = AddDate(firstMonday, #PB_Date_Day, row * 7)
  Protected kw = ISOWeek(mondayDate)

  ; Y-Position der Kalenderzeile
  Protected ky = feldh * (row + 2) + (feldh - txty1) / 2

  ; KW links zeichnen
  DrawText(4, ky-txty1-2, RSet(Str(kw), 2, "0"), $000000, kalender()\blatt()\col_hintergrund)
Next

;   
  StopDrawing()
  ;kalender()\datum = datum
  
EndProcedure


Procedure Hauptfenster()
  flag = #PB_Window_SystemMenu
  flag | #PB_Window_ScreenCentered
  flag | #PB_Window_Maximize
  OpenWindow(#hwnd, 0, 0, 0, 0, "Kalender", flag)
  SetWindowColor(#hwnd, $C0C0C0)
  
  AddKeyboardShortcut(#hwnd, #PB_Shortcut_Escape, #taste_esc)
  
  ; --- 3 Baetter untereinander . Gestartet wird aktueller Monat - 1
  x = 10
  y = 30
  font1 = LoadFont(#PB_Any, "", 10) ; Font für Kalendergadgets
  font2 = LoadFont(#PB_Any, "", 10) ; Font fürs Kalenderblatt
  anz_bleatter = 6
  sichtbar = 3
  ausrichtung$ = "u" ; untereinander
  create_kalender(x, y, font1, font2, #hwnd, anz_bleatter, ausrichtung$, sichtbar)
  datum = Date()
  datum = AddDate(Datum, #PB_Date_Month, -1)
  kalender()\datum = datum
  ForEach kalender()\blatt()
    kalender()\blatt()\col_aktuell = $FFFF00
    kalender()\blatt()\col_sonntag = $8080F0
    kalender()\blatt()\col_auswahl = $00FC7C
    
    Select zaehler ; ListIndex(kalender()\blatt())
      Case 0 : kalender()\blatt()\col_hintergrund = $B3DEF5
      Case 1 : kalender()\blatt()\col_hintergrund = $ffffff
      Case 2 : kalender()\blatt()\col_hintergrund = $D4FF7F
    EndSelect
    zaehler + 1 : If zaehler > 2 : zaehler = 0 : EndIf
    kalender()\blatt()\datum = datum
    schreibe_kalenderblatt(kalender()\blatt()\canvas)
    datum = AddDate(datum, #PB_Date_Month, 1)
  Next
  
  ; --- 1nen Kalender daneben
  ;x = WindowX(kalender()\win) + WindowWidth(kalender()\win)+10; noch lassen für später
  x = GadgetX(kalender()\win) + GadgetWidth(kalender()\win)+10
  y = 30
  font1 = LoadFont(#PB_Any, "", 12) ; Font für Kalendergadgets
  font2 = LoadFont(#PB_Any, "", 12) ; Font fürs Kalenderblatt
  anz_bleatter = 1
  sichtbar = 1
  ausrichtung$ = "" ; eine Ausrichtung wird hier nicht gebraucht
  create_kalender(x, y, font1, font2, #hwnd, anz_bleatter, ausrichtung$, sichtbar)
  datum = Date()
  kalender()\datum = datum
  kalender()\blatt()\col_aktuell = $FFFF00
  kalender()\blatt()\col_sonntag = $8080F0
  kalender()\blatt()\col_auswahl = $00FC7C
  kalender()\blatt()\col_hintergrund = $32CD9A
  kalender()\blatt()\datum = datum
  schreibe_kalenderblatt(kalender()\blatt()\canvas)
  
  ; --- 1nen Kalender daneben im Fenster
  ;x = WindowX(kalender()\win) + WindowWidth(kalender()\win)+10; noch lassen für später
  x = GadgetX(kalender()\win) + GadgetWidth(kalender()\win)+10
  y = 30
  font1 = LoadFont(#PB_Any, "", 12) ; Font für Kalendergadgets
  font2 = LoadFont(#PB_Any, "", 12) ; Font fürs Kalenderblatt
  anz_bleatter = 1
  sichtbar = 1
  ausrichtung$ = "" ; eine Ausrichtung wird hier nicht gebraucht
  create_kalender(x, y, font1, font2, #hwnd, anz_bleatter, ausrichtung$, sichtbar, "fenster")
  datum = Date()
  kalender()\datum = datum
  kalender()\blatt()\col_aktuell = $FFFF00
  kalender()\blatt()\col_sonntag = $8080F0
  kalender()\blatt()\col_auswahl = $00FC7C
  kalender()\blatt()\col_hintergrund = $32CD9A
  kalender()\blatt()\datum = datum
  schreibe_kalenderblatt(kalender()\blatt()\canvas)
  
  ; --- 3 Baetter nebeneinander . Gestartet wird aktueller Monat - 1
  PushListPosition(kalender())
  SelectElement(kalender(), 1)
  x = GadgetX(kalender()\win); + GadgetWidth(kalender()\win)+10
  y = GadgetY(kalender()\win) + GadgetHeight(kalender()\win)+40-22
  PopListPosition(kalender())
  font1 = LoadFont(#PB_Any, "", 10) ; Font für Kalendergadgets
  font2 = LoadFont(#PB_Any, "", 10) ; Font fürs Kalenderblatt
  anz_bleatter = 6
  sichtbar = 3
  ausrichtung$ = "n" ; nebeneinander
  create_kalender(x, y, font1, font2, #hwnd, anz_bleatter, ausrichtung$, sichtbar)
  datum = Date()
  datum = AddDate(Datum, #PB_Date_Month, -1)
  kalender()\datum = datum
  zaehler = 0
  ForEach kalender()\blatt()
    kalender()\blatt()\col_aktuell = $FFFF00
    kalender()\blatt()\col_sonntag = $8080F0
    kalender()\blatt()\col_auswahl = $00FC7C
    Select zaehler ; ListIndex(kalender()\blatt())
      Case 0 : kalender()\blatt()\col_hintergrund = $B3DEF5
      Case 1 : kalender()\blatt()\col_hintergrund = $ffffff
      Case 2 : kalender()\blatt()\col_hintergrund = $D4FF7F
    EndSelect
    zaehler + 1 : If zaehler > 2 : zaehler = 0 : EndIf
    kalender()\blatt()\datum = datum
    schreibe_kalenderblatt(kalender()\blatt()\canvas)
    datum = AddDate(datum, #PB_Date_Month, 1)
  Next
  
EndProcedure

;-===== Programm Start
Hauptfenster()

datum = Date()

;-===== Events
InitKeyboard()
Repeat
  ev = WaitWindowEvent()
   Select ev
     Case #PB_Event_CloseWindow
       Select EventWindow()
         Case #hwnd
           Break
         Default
           ForEach kalender()
             If EventWindow() = kalender()\win
               kalender_schliessen()
               Break ;2 ; Diese Schleife + Eventschleife
             EndIf
           Next
       EndSelect
     
    Case #PB_Event_Menu
      Select EventMenu()
        Case #taste_esc
          Break
      EndSelect
      
    Default
      If ev = #PB_Event_Gadget
        ForEach kalender()
          Select EventGadget()
            Case kalender()\butt_yvor ;---- Butt Vor
              datum = kalender()\datum
              datum = AddDate(datum, #PB_Date_Year, 1)
              kalender()\datum = datum
              ForEach kalender()\blatt()
                kalender()\blatt()\datum = datum
                schreibe_kalenderblatt(kalender()\blatt()\canvas)
                datum = AddDate(Datum, #PB_Date_Month, 1)
              Next
              Break
            
            Case kalender()\butt_mvor ;---- Butt Vor
              datum = kalender()\datum
              datum = AddDate(datum, #PB_Date_Month, 1)
              kalender()\datum = datum
              ForEach kalender()\blatt()
                kalender()\blatt()\datum = datum
                schreibe_kalenderblatt(kalender()\blatt()\canvas)
                datum = AddDate(Datum, #PB_Date_Month, 1)
              Next
              Break
            Case kalender()\butt_yzur ;---- Butt Zur
              datum = kalender()\datum
              datum = AddDate(datum, #PB_Date_Year, -1)
              kalender()\datum = datum
              ForEach kalender()\blatt()
                kalender()\blatt()\datum = datum
                schreibe_kalenderblatt(kalender()\blatt()\canvas)
                datum = AddDate(Datum, #PB_Date_Month, 1)
              Next
              Break
            Case kalender()\butt_mzur ;---- Butt Zur
              datum = kalender()\datum
              datum = AddDate(datum, #PB_Date_Month, -1)
              kalender()\datum = datum
              ForEach kalender()\blatt()
                kalender()\blatt()\datum = datum
                schreibe_kalenderblatt(kalender()\blatt()\canvas)
                datum = AddDate(Datum, #PB_Date_Month, 1)
              Next
              Break
            Case kalender()\butt_heute ;---- Butt Heute
              datum = Date()
              If ListSize(kalender()\blatt()) > 1
                datum = AddDate(Datum, #PB_Date_Month, -1)
              EndIf
              kalender()\datum = datum
              ForEach kalender()\blatt()
                kalender()\blatt()\datum = datum
                schreibe_kalenderblatt(kalender()\blatt()\canvas)
;                 schreibe_kalenderblatt(Datum, kalender()\blatt()\canvas)
                datum = AddDate(Datum, #PB_Date_Month, 1)
              Next
              Break
            Case kalender()\butt_beenden ;---- Butt Beenden
              kalender_schliessen()
              Break
            Case kalender()\butt_kopie
              a$ = GetGadgetText(kalender()\text_datum)
              If Len(a$)
                a$ = FormatDate("%yyyy.%mm.%dd", kalender()\auswahl_datum)
                Debug a$
              EndIf
              
            Default ;---- Klick auf Kalenderblatt
              ForEach kalender()\blatt()
                If EventGadget() = kalender()\blatt()\canvas And EventType() = #PB_EventType_LeftClick
                  mx = GetGadgetAttribute(kalender()\blatt()\canvas,#PB_Canvas_MouseX)
                  my = GetGadgetAttribute(kalender()\blatt()\canvas,#PB_Canvas_MouseY)
                  dat = datum_ermitteln(kalender()\blatt()\datum, mx, my)
                  ForEach kalender()\blatt()
                    ;kalender()\blatt()\datum = datum
                    schreibe_kalenderblatt(kalender()\blatt()\canvas)
                  Next
                    ;kalender()\datum = datum
                  EndIf
                Next
          EndSelect
        Next
      EndIf
  EndSelect
ForEver
PB 5.31 (x86) & (x64) Win10
Antworten