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
Gruß: Bernd (BSP)