PureBoard

Code: Alles auswählen

;PureBasic 4.0 Beta6 
z=0
d=0

Enumeration
#window
#kalendergadget
#Kalimg
EndEnumeration


Procedure IsLeapyear(j)
  Protected d.l
  If ((j % 4) = 0 And (j % 100)) <> 0 Or (j % 400) = 0
      d = 1
  EndIf
  ProcedureReturn d
EndProcedure
 
Procedure GetNumOfDaysPerMonth(m, j)
  Protected d.l
  d = 30 + (m + m / 8) % 2 - 2 * ((m + 10) / 12 - (m + 9) / 12)
  If m = 2
    If IsLeapyear(j)
      d + 1
    EndIf
  EndIf
  ProcedureReturn d
EndProcedure
Procedure CalenderImagegadget(Calenderid,CalenderFont.s,Jahr,Monat)
textfont1 = LoadFont(#PB_Any,Calenderfont, 12)
textid1=FontID(textfont1)
Dim months.l(12)
For a=1 To 12
months(a)= getnumofdayspermonth(a,Jahr)
Next a
Dim month_text.s(12)
month_text.s(1)="Januar"
month_text.s(2)="Februar"
month_text.s(3)="März"
month_text.s(4)="April"
month_text.s(5)="Mai"
month_text.s(6)="Juni"
month_text.s(7)="Juli"
month_text.s(8)="August"
month_text.s(9)="September"
month_text.s(10)="Oktober"
month_text.s(11)="November"
month_text.s(12)="Dezember"
wochentage.s="Mo Di Mi Do Fr Sa So"
Debug result
For a=1 To 12
Debug month_text(a)
;-kalenderimage
Next a
Dayplace= DayOfWeek(Date(Jahr,monat,1,0,0,0))
If dayplace=0
dayplace=7
EndIf 
;-
If CreateImage(Calenderid,150,160,24)
If StartDrawing(ImageOutput(Calenderid))
DrawingFont(textid1)
DrawingMode(1)
FrontColor(RGB(255,255,255))
Box(0,0,150,20,RGB(51,102,153))
DrawText((150/2)-(TextWidth(month_text(monat))/2),0,month_text(monat))
Box(0,20,150,20,RGB(172,193,210))
DrawText((150/2)-(TextWidth(wochentage)/2),20,wochentage) 
Box(0,40,150,120,RGB(255,255,255))
FrontColor(RGB(0,0,0))
For a=4 To 150 Step 21
Line(a,40,0,160)
Next a
For a=40 To 160 Step 20
Line(0,a,150,0)
Next a
For c=40 To 160 Step 20
For b=5 To 150 Step 21.5

d=d+1
If z<months(monat) And d>Dayplace-1

z=z+1
DrawText(b,c,Str(z))
EndIf 
Next b
Next c
StopDrawing()
ProcedureReturn 1
Else 
ProcedureReturn 0
EndIf 
Else
ProcedureReturn 0
EndIf 

EndProcedure

;Beispiel -----------------------------------------
Calender=Calenderimagegadget(#kalimg,"Times",2006,4)
;-
If OpenWindow(#window,0,0,300,200,"lolo")
If CreateGadgetList(WindowID(#window))
ImageGadget(#kalendergadget,0,0,150,70,ImageID(#kalimg))
EndIf 
EndIf 

Repeat
event=WaitWindowEvent()
windowid=EventWindow()
gadgetid=EventGadget()
eventtype=EventType()
Until event=#PB_Event_CloseWindow 

End 
;---------------------------------

Code: Alles auswählen

heute.l=Val(FormatDate("%dd", Date()))

Code: Alles auswählen

      If z<months(Monat) And d>Dayplace-1 
        z=z+1
        z$=Str(z)
        If z=heute
            ;Hier mit Box,Circle oder was auch immer den aktuellen Tag markieren
       EndIf
        DrawText(b,c,Str(z)) 
      EndIf 

Code: Alles auswählen

If CreateImage(Calenderid,150,160,24) 

Code: Alles auswählen

result =  CreateImage(-1,150,160,24)
if result
Procedurereturn result

Code: Alles auswählen

If Calenderid = #PB_Any
  Calenderid = CreateImage(#PB_Any,150,160,24)
Else
 CreateImage(Calenderid,150,160,24)
EndIf 

Code: Alles auswählen

ProcedureReturn Calenderid; statt 1