Kalender mit Checkboxen

[loirad]

Hallo ihr,
ich möchte für jeden Tag meines Kalenders eine Listbox einfügen. Jedoch sind immer zu wenig Listboxen da --> ich häng mal die exe an --> guckt es euch an bitte!
Hier der Quelltext:

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Grids, StdCtrls, DateUtils;

type
  TForm1 = class(TForm)
    Kalender: TStringGrid;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Beenden1: TMenuItem;
    Monat: TLabel;
    zuruek: TButton;
    vor: TButton;
    procedure FormCreate(Sender: TObject);
    function welchermonat(Monat:string):string;
    procedure vorClick(Sender: TObject);
    procedure fuellen(Monat,Jahr, Wochentag: integer);
    procedure clear;
    function Wochentag(Datum:TDateTime):integer;
    procedure zuruekClick(Sender: TObject);
    procedure KalenderDblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure KalenderDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure setRect(rec:Trect;Nummer:integer);
    procedure Listboxcreate(Listbox:TListbox;Nummer:integer);
    procedure listboxenverteilen;
  private
    { Private-Deklarationen }
    taga,mona,monatsnamea,jahra,tag,mon,monatsname,jahr:String;
    dat:TDateTime;
    L: array [1..31] of TListbox;
    day:integer;
  public
    { Public-Deklarationen }
    Nameu,VonT,BisT,VonZ,BisZ,Wiederholung,Inhalt:string;
    neuerText:boolean;  
  end;

var
  Form1: TForm1;
  L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,
  L17,L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,
  L31:TListbox;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
neuerText:=false;
Kalender.Top:=20;
Kalender.Left:=0;
Kalender.Width:=Form1.ClientWidth;
Kalender.Height:=Form1.ClientHeight-20;
Kalender.DefaultColWidth:=(Kalender.Width div 7)-2;
Kalender.DefaultRowHeight:=(Kalender.Height div 7)-2;
Kalender.Cells[0,0]:='Montag';
Kalender.Cells[1,0]:='Dienstag';
Kalender.Cells[2,0]:='Mittwoch';
Kalender.Cells[3,0]:='Donnerstag';
Kalender.Cells[4,0]:='Freitag';
Kalender.Cells[5,0]:='Samstag';
Kalender.Cells[6,0]:='Sonntag';
Monat.Top:=0;
Monat.Left:=Form1.ClientWidth div 2 - Monat.Width div 2;
zuruek.Left:=0;
zuruek.Top:=0;
vor.Top:=0;
vor.Left:=Form1.ClientWidth-vor.Width;
dat:=now;
taga:=FormatDateTime('d',dat);
mona:=FormatDateTime('m',dat);
jahra:=FormatDateTime('yyyy',dat);
monatsnamea:=welchermonat(mona);
Form1.Caption:='Kalender - '+taga+'. '+monatsnamea+' '+jahra;
Monat.Caption:=monatsnamea+' '+jahra;
day:=Wochentag(strtodate('01.'+mona+'.'+jahra));
fuellen(strtoint(mona),strtoint(jahra),day);
tag:=taga;
mon:=mona;
monatsname:=monatsnamea;
jahr:=jahra;
listboxenverteilen;
end;

function TForm1.welchermonat(Monat: String): string;
begin
case strtoint(Monat) of
 1:result:='Januar';
 2:result:='Februar';
 3:result:='März';
 4:result:='April';
 5:result:='Mai';
 6:result:='Juni';
 7:result:='Juli';
 8:result:='August';
 9:result:='September';
 10:result:='Oktober';
 11:result:='November';
 12:result:='Dezember';
end;
end;

procedure TForm1.vorClick(Sender: TObject);
begin
clear;
if strtoint(mon)<12 then
 mon:=inttostr(1+strtoint(mon))
else
 begin
  mon:='1';
  jahr:=inttostr(1+strtoint(jahr));
 end;
fuellen(strtoint(mon),strtoint(jahr),Wochentag(strtodate('01.'+mon+'.'+jahr)));
monatsname:=welchermonat(mon);
Monat.Caption:=monatsname+' '+jahr;
day:=Wochentag(strtodate('01.'+mon+'.'+jahr));
listboxenverteilen;
end;

procedure TForm1.fuellen(Monat, Jahr, Wochentag: integer);
var i,j,z:integer;
begin
i:=1;
z:=1;
j:=Wochentag-1;
repeat
 Kalender.Cells[j,z]:=inttostr(i)+'. '+welchermonat(inttostr(Monat))+' '+inttostr(Jahr);
 if j<6 then
  begin
   inc(j);
  end
 else
  begin
   inc(z);
   j:=0;
  end;
 inc(i);
until i>Daysinamonth(Jahr,Monat);
end;

procedure TForm1.clear;
var i,j:integer;
begin
for i:=0 to Kalender.ColCount do
 for j:=1 to Kalender.RowCount do
  Kalender.Cells[i,j]:='';
for i:=1 to Length(L) do
  L[i].Free;
fillchar(L,sizeOf(L),0) ;
end;

function TForm1.Wochentag(Datum: TDateTime): integer;
begin
case DayOfWeek(Datum) of
 1: Result := 7;
 2: Result := 1;
 3: Result := 2;
 4: Result := 3;
 5: Result := 4;
 6: Result := 5;
 7: Result := 6;
end;
end;

procedure TForm1.zuruekClick(Sender: TObject);
begin
Form1.Hide;
clear;
if strtoint(mon)>1 then
 mon:=inttostr(strtoint(mon)-1)
else
 begin
  mon:='12';
  jahr:=inttostr(strtoint(jahr)-1);
 end;
fuellen(strtoint(mon),strtoint(jahr),Wochentag(strtodate('01.'+mon+'.'+jahr)));
monatsname:=welchermonat(mon);
Monat.Caption:=monatsname+' '+jahr;
day:=Wochentag(strtodate('01.'+mon+'.'+jahr));
listboxenverteilen;
Form1.Show;
end;

procedure TForm1.KalenderDblClick(Sender: TObject);
begin
if Kalender.Cells[Kalender.Selection.Left,Kalender.Selection.Top]<>'' then
 begin
  Form1.Enabled:=false;
  Form2.Show;
  Form2.Name.SetFocus;
  Inhalt:=Form1.Kalender.Cells[Form1.Kalender.Selection.Left,Form1.
  Kalender.Selection.Top]
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form2.Close;
end;

procedure TForm1.KalenderDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
if Kalender.Cells[ACol,ARow]='' then
 begin
  Kalender.Canvas.Brush.Color := clMedGray;
  Kalender.Canvas.FillRect(Rect);
 end;
end;

procedure TForm1.setRect(rec: Trect;Nummer:integer);
var r:TRect;
begin
  CopyRect(r,rec);
  r.BottomRight:=L[Nummer].Parent.ScreenToClient(Kalender.ClientToScreen(r.BottomRight));
  r.TopLeft:=L[Nummer].Parent.ScreenToClient(Kalender.ClientToScreen(r.TopLeft));
  L[Nummer].SetBounds(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
  L[Nummer].BringToFront;
end;

procedure TForm1.listboxenverteilen;                              //Hier müsste irgendwo der Fehler sein!
var x,y,i:integer;
begin
x:=day-1;
y:=1;
for i:=1 to 31{daysinamonth(strtoint(jahr),strtoint(mon))} do
 begin
  L[i]:=TListbox.Create(self);
  with L[i] do
    begin
      parent := Form1;
      name := 'L'+IntToStr(i);
      left := 10;
      top := i * 2;
      Width:=Form1.Kalender.DefaultColWidth;
     if x<7 then
      begin
       setRect(Kalender.CellRect(x,y),i);
       inc(x);
      end
     else
      begin
       x:=0;
       inc(y);
       setRect(Kalender.CellRect(x,y),i);
      end;
    end;
 end;

end;

end.

Vielen Dank für weitere Antworten
loirad!!!

[Bummi]

so, siehst Du wenigstens etwas und kannst den Rest der Bugs ausbauen

Delphi-Quellcode:

procedure TForm1.listboxenverteilen;                             //Hier müsste irgendwo der Fehler sein!
var x,y,i:integer;
begin
x:=day-1-1;
y:=1;
for i:=1 to 31{daysinamonth(strtoint(jahr),strtoint(mon))} do
 begin
  L[i]:=TListbox.Create(self);

      L[i].Color := clLime;
      L[i].parent := Kalender;
      L[i].name := 'L'+IntToStr(i);
      L[i].Boundsrect := Kalender.CellRect(x,y);
      L[i].BringToFront;
     if x<6 then
      begin
       inc(x);
      end
     else
      begin
       x:=0;
       inc(y);
      end;

 end;

end;

[DeddyH]

Wieso eigentlich das with, wenn es dann (außer natürlich bei dem einzigen wirklich doppeldeutigen Feld) gar nicht zur Anwendung kommt?

[Bummi]

ich war schon am ausbauen, habe es dann aber nicht fertiggestellt ....

[Hobby-Programmierer]

Nabend ...,
der oben gepostete Quellcode passt aber nicht zu der angehängten Exe. Hänge doch mal bitte das gesamte Projekt an den nächsten Beitrag.

[loirad]

Anbei hier das richtige aktuelle Projekt: