PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

CalendarGadget mit eigenem Font

https://www.purebasic.fr/german/viewtopic.php?t=33494

Seite 1 von 1

CalendarGadget mit eigenem Font

Verfasst: 18.01.2026 06:52
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)
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de