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
Form1.UpdateControlState;
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
// CheckBox in stringgrid
CopyRect(r,rec);
// rec an r übergeben
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.Listboxcreate(Listbox: TListbox; Nummer: integer);
begin
{Listbox:=TListbox.Create(self);
Listbox.Parent:=Form1;
L[Nummer]:=Listbox; }
end;
procedure TForm1.listboxenverteilen;
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.