KalenderImage

[roherter]

Hiermit könnt ihr euch ein Image erstellen auf dem ein Kalendermonat angezeigt wird ,falls ihr Fehler findet bitte Bescheid sagen!

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 
;---------------------------------

[ts-soft]

>> fals ihr Fehler findet bitte Bescheid sagen!
Bescheid

[roherter]

Und wo du nase, .
Also bei mir funktioniert alles hier ist ein Screenshot:


Könntest mich ja wenigstens auf den fehler hinweisen und mir sagen wo im code er ist!

[ts-soft]

>> Könntest mich ja wenigstens auf den fehler hinweisen und mir sagen wo im code er ist!
Hab ich gemacht!

>> fals ihr Fehler findet bitte Bescheid sagen!
Bescheid

Hab nicht gesagt, das er im Code ist

[roherter]

Dann bin ich ja erleichtert spielst du wieder auf meine rechtschreibung an,

[ts-soft]

Aber nur weil Du drum gebeten hast, würde ich sonst nicht machen

[SoS]

Tolle Sache.
Ich hätte da noch eine kleine Idee für eine Erweiterung.

In die Procedur CalenderImagegadget

Code: Alles auswählen

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

und dann könnte man bei

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 

/edit

Code bischen modifiziert.

[ts-soft]

Gute Idee
Und für Calenderid eine Unterstützung für #PB_Any, brauchste ja nur auf -1
Prüfen und entsprechend reagieren (Die ID zurückgeben)

[roherter]

Ja danke dir,ich hatte die procedure eigentlich für ein Projekt von mir geschrieben wo ich die makierung des tage nicht brauchte aber kanns gerne noch mit einbauen wenn interesse besteht!

Ts.Soft: meinst du diese stelle

Code: Alles auswählen

If CreateImage(Calenderid,150,160,24) 

Und dan soll ichs so machen

Code: Alles auswählen

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

[ts-soft]

Ab Zeile 61 fügst Du in Deinen unformatierten Source folgendes ein:

Code: Alles auswählen

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

und am Ende machste

Code: Alles auswählen

ProcedureReturn Calenderid; statt 1

Ungetestet, hab keine Lust Deinen Source zu formatieren