KalenderImage

[roherter]

Ja da der Code zuerst nur für mich war habe ich keinen Grund gehabt ihn zu Formatieren,falls ihn jemand Formatiert haben möchte muss er das schon selbst tun!
Ts-Soft:Danke dir trotzdem!

[Kiffi]

> Ja da der Code zuerst nur für mich war habe ich keinen Grund gehabt ihn
> zu Formatieren

... da Du Dich nun jedoch entschieden hast, Deinen Code der Allgemeinheit
zur Verfügung zu stellen, solltest Du dem Motto des Forums "Code, Tipps und
Tricks" gerecht werden, ihn auch "beispielhaft" formatieren.

[au weia, das gibt wieder Haue]

[ts-soft]

Bitte, bitte, aber mein Tip wird wohl nicht funzen, da ich nicht feststellen
konnte, wo Deine eigentliche If abfrage endet. Da ich im Moment die PB-IDE
verwende, kann ich also kein Feedback geben, weil mehr als starten geht ja
nicht.
Unformatierten Code werde ich mir unter Code, Tipps und Tricks wohl auch
nicht mehr umbedingt ansehen, es sei den ich verwende gerade jaPBe.

[roherter]

Werde mich dem annehmen kannst mir mal n paar tips geben was du unter einer beispielhaften Formatierung verstehst meinst du Zeileneinrückungen und Kommentare???

[ts-soft]

Ohne Zeileneinrückungen kann man dem Source doch nicht folgen. Ist doch einfach nur Spagetthi. Und Kommentare, wenn erforderlich, sollten auch nicht
fehlen

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

Kanns nicht mehr sehen

[roherter]

Danke Kommentare setze ich noch welche ein!
Habe aber erst heute abend Zeit mich dem zu widmen dann versuche ich auch die anderen Tips umzusetzen!

[roherter]

So habe es Versucht noch mit ein Paar Komentaren aufzuarbeiten:

Code: Alles auswählen

;PureBasic 4.0 Beta6
z=0
d=0

Enumeration
  #window
  #kalendergadget
  #Kalimg
EndEnumeration

;---Diese Procedure ermittelt ob das angebene Jahr(j) ein Schaltjahr ist
Procedure IsLeapyear(j)
  Protected d.l
  If ((j % 4) = 0 And (j % 100)) <> 0 Or (j % 400) = 0
    d = 1
  EndIf
  ProcedureReturn d
EndProcedure
 ;----------------------------------------------------------------------
 
 
 ;---Diese Procedure ermittelt die Anzahl der Tage des Monats(m) im angegebenen Jahr(j)
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
;------------------------------------------------------------------------

 ;---Diese Procedure erzeugt ein Image(Calenderid) auf dem mit dem angegebenen Font(CalenderFont)
 ;---ein Kalenderblatt welches den Monat des angegebenen Jahres anzeigt

Procedure CalenderImagegadget(Calenderid,CalenderFont.s,Jahr,Monat)
  textfont1 = LoadFont(#PB_Any,CalenderFont, 12)
  textid1=FontID(textfont1)
  Dim months.l(12)

  ;Kalendertage für alle 12 Monate abfragen,eigentlich nicht nötig für den eingebenen Monat würde reichen
  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"

  For a=1 To 12
  Next a
  Dayplace= DayOfWeek(Date(Jahr,Monat,1,0,0,0))
  If Dayplace=0
    Dayplace=7
  EndIf
  
  
  Calenderid=CreateImage(#PB_Any,150,160,24)
  If Calenderid 
    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))
      
      ;Kästchen Zeichnen
      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
      ;------------------------
      
      ;Kalendertage auf das Image zeichnen
      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 Calenderid 
    Else
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0
  EndIf
 
EndProcedure
;-----------------------------------------------------------
;-----------------------------------------------------------

;Beispiel -----------------------------------------
Calender=CalenderImagegadget(#Kalimg,"Times",2006,4);Kalenderblatt für April erzeugen
;-
If OpenWindow(#window,0,0,300,200,"lolo")
  If CreateGadgetList(WindowID(#window))
    ImageGadget(#kalendergadget,0,0,150,70,ImageID(Calender));Kalenderblat auf einem Imagegadget ausgeben
  EndIf
EndIf

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

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

[ts-soft]

Und jetzt nochmal mit #PB_Any Unterstützung

Code: Alles auswählen

;PureBasic 4.0 Beta6
z=0
d=0

Enumeration
  #window
  #kalendergadget
  #Kalimg
EndEnumeration

;---Diese Procedure ermittelt ob das angebene Jahr(j) ein Schaltjahr ist
Procedure IsLeapyear(j)
  Protected d.l
  If ((j % 4) = 0 And (j % 100)) <> 0 Or (j % 400) = 0
    d = 1
  EndIf
  ProcedureReturn d
EndProcedure
 ;----------------------------------------------------------------------
 
 
 ;---Diese Procedure ermittelt die Anzahl der Tage des Monats(m) im angegebenen Jahr(j)
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
;------------------------------------------------------------------------

 ;---Diese Procedure erzeugt ein Image(Calenderid) auf dem mit dem angegebenen Font(CalenderFont)
 ;---ein Kalenderblatt welches den Monat des angegebenen Jahres anzeigt

Procedure CalenderImagegadget(Calenderid,CalenderFont.s,Jahr,Monat)
  textfont1 = LoadFont(#PB_Any,CalenderFont, 12)
  textid1=FontID(textfont1)
  Dim months.l(12)

  ;Kalendertage für alle 12 Monate abfragen,eigentlich nicht nötig für den eingebenen Monat würde reichen
  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"

  For a=1 To 12
  Next a
  Dayplace= DayOfWeek(Date(Jahr,Monat,1,0,0,0))
  If Dayplace=0
    Dayplace=7
  EndIf
 
  If Calenderid = #PB_Any
     Calenderid=CreateImage(#PB_Any,150,160,24)
  Else
    CreateImage(Calenderid,150,160,24)
  EndIf
  If Calenderid
    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))
     
      ;Kästchen Zeichnen
      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
      ;------------------------
     
      ;Kalendertage auf das Image zeichnen
      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 Calenderid
    Else
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0
  EndIf
 
EndProcedure
;-----------------------------------------------------------
;-----------------------------------------------------------

;Beispiel -----------------------------------------
;Calender=CalenderImagegadget(#PB_Any,"Times",2006,4);Kalenderblatt für April erzeugen
CalenderImagegadget(#Kalimg,"Times",2006,4);Kalenderblatt für April erzeugen
;-
If OpenWindow(#window,0,0,300,200,"lolo")
  If CreateGadgetList(WindowID(#window))
    ;ImageGadget(#kalendergadget,0,0,150,70,ImageID(Calender));Kalenderblat auf einem Imagegadget ausgeben
    ImageGadget(#kalendergadget,0,0,150,70,ImageID(#Kalimg));Kalenderblat auf einem Imagegadget ausgeben
  EndIf
EndIf

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

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

Für #PB_Any einfach die 2 Kommentare einen tiefer legen

[roherter]

Gut danke dir Ts-Soft!

[Michael Vogel]

> Ja da der Code zuerst nur für mich war habe ich keinen Grund gehabt ihn
> zu Formatieren

... da Du Dich nun jedoch entschieden hast, Deinen Code der Allgemeinheit
zur Verfügung zu stellen, solltest Du dem Motto des Forums "Code, Tipps und
Tricks" gerecht werden, ihn auch "beispielhaft" formatieren.

Also, der Aufwand für ordnungsgemäßes Einrücken sollte nicht so ein Problem sein, ich habe da auch ein kleines Tool geschrieben, das sehr vorzügliche Dienste leistet (es berücksichtigt auch eure private Neigungen, da es aus der IDE Konfiguration ausliest, ob ihr Tabulatoren oder Leerzeichen zum Einrücken verwendet )

http://www.purebasic.fr/english/viewtop ... autoindent