Hallo,
kann mal jemand durch den Code gehen und mir erklären warum er nicht das macht was soll?
Ich gebe zu, es hört sich blöd an, aber sehe den Wald vor lauter Bäumen nicht mehr und das
obwohl ich den Code in Delphi 7 selber geschrieben habe.
Es geht um einen Kalender, der neben der Anzeige der einzelnen Tage auch den Tagesnamen
in Kurzform anzeigen soll, also
M für Montag usw. .
Dazu habe ich erst einmal zwei Controls programmiert:
Das erste Control
Delphi-Quellcode:
...
TBaseControl = class(TCustomControl)
private
FFirst : Boolean;
FText : String;
protected
procedure CreateWnd; override;
procedure Paint; override;
public
constructor Create(aOwner : TComponent); override;
end;
...
constructor TBaseControl.Create(aOwner : TComponent);
begin
inherited Create(aOwner);
FFirst := True;
end;
procedure TBaseControl.CreateWnd;
begin
if Assigned(Parent) and FFirst then
begin
inherited CreateWnd;
FFirst := False;
Width := Canvas.TextWidth('WD');
Height := Canvas.TextWidth('WD');
end;
end;
procedure TBaseControl.Paint;
var
R : TRect;
begin
R := GetClientRect;
with Canvas do
begin
{$IFDEF DEBUG}
Rectangle(R);
InflateRect(R, -1, -1);
{$ENDIF}
FillRect(R);
TextOut((Width div 2) - (TextWidth(FText) div 2), (Height div 2) - (TextHeight(FText) div 2), FText);
end;
end;
stellt mehr oder weniger rudimentäre Funktionen wie die Ausgabe des Textes und die Größe bereit.
Das Zweite Control beinhaltet eine Auflistung entsprechend der benötigten Anzahl von Elementen und
überschreibt einige Prozeduren des BasisControls:
Delphi-Quellcode:
...
TArrayStyle = (asNone, asWeekDay, asDay);
...
TArrayControl = class(TBaseControl)
private
FArray : TObjectList;
FStyle : TArrayStyle;
procedure SetStyle(Value : TArrayStyle);
protected
procedure ClearArray;
procedure CreateArray;
procedure CreateWnd; override;
procedure Paint; override;
public
constructor Create(aOwner : TComponent); override;
destructor Destroy; override;
property Style : TArrayStyle read FStyle write SetStyle;
end;
...
constructor TArrayControl.Create(aOwner : TComponent);
begin
inherited Create(aOwner);
FStyle := asNone;
FArray := TObjectList.Create;
end;
procedure TArrayControl.SetStyle(Value : TArrayStyle);
begin
if FStyle <> Value then FStyle := Value;
end;
procedure TArrayControl.CreateArray;
var
I, L : Integer;
BC : TBaseControl;
FMax : Integer;
begin
if FFirst or (Style = asNone) then Exit;
FMax := 0;
case Style of
asWeekDay : FMax := 6;
asDay : FMax := 7;
end;
{$IFDEF DEBUG}
L := 1;
{$ELSE}
L := 0;
{$ENDIF}
for I := 0 to FMax do
begin
BC := TBaseControl.Create(Self);
BC.Parent := Self;
{$IFDEF DEBUG}
BC.Top := 1;
{$ELSE}
BC.Top := 0;
{$ENDIF}
BC.Left := L;
case Style of
asWeekDay : BC.FText := DayShortStr[I + 1];
asDay : BC.FText := IntToStr(I);
end;
if (I = 0) and (Style = asDay) then Inc(L, 2);
Inc(L, BC.Width -1);
FArray.Add(BC);
end;
{$IFDEF DEBUG}
Width := L + 2;
Height:= Height + 2;
{$ELSE}
Width := L + 1;
{$ENDIF}
end;
procedure TArrayControl.ClearArray;
begin
FArray.Clear;
end;
procedure TArrayControl.CreateWnd;
begin
if Assigned(Parent) then
begin
inherited CreateWnd;
CreateArray;
end;
end;
procedure TArrayControl.Paint;
var
R : TRect;
begin
R := GetClientRect;
with Canvas do
begin
{$IFDEF DEBUG}
Pen.Color := clRed;
Rectangle(R);
InflateRect(R, -1, -1);
{$ENDIF}
FillRect(R);
end;
end;
Die beiden Controls harmonieren auch (siehe Anhang, Button "Create 'TActionControl'").
Da ein Kalender auch alle Wochen eines Monats anzeigen soll ist ein weiteres Control hinzugekommen,
TContainerControl. TContainerControl kapselt nun seiner Seits alle in Frage kommenden
Wochen eines Monats inkl. der Wochentage; Theoretisch.
Delphi-Quellcode:
...
TContainerControl = class(TBaseControl)
private
FOldDate : TDateTime;
FArray : TObjectList;
FMaxWeeks : Integer;
procedure WeeksInTheMonth(ANow : TDateTime);
protected
FCalendar : TCalendarControl;
procedure ClearArray;
procedure CreateArray;
procedure CreateWnd; override;
procedure Paint; override;
procedure SetCalendar(Value : TCalendarControl);
property Calendar : TCalendarControl read FCalendar write SetCalendar;
public
constructor Create(aOwner : TComponent); override;
destructor Destroy; override;
procedure Update; override;
end;
...
constructor TContainerControl.Create(aOwner : TComponent);
begin
inherited Create(aOwner);
FMaxWeeks := 0;
FOldDate := 0;
FArray := TObjectList.Create;
end;
procedure TContainerControl.WeeksInTheMonth(ANow : TDateTime);
var
Y, M, D,
W1, W2 : Word;
DT : TDateTime;
begin
DecodeDate(aNow, Y, M, D);
DT := EncodeDate(Y, M, 1);
W1 := WeekOfTheYear(DT);
DT := IncDay(IncMonth(DT, 1), -1);
if WeekOfTheYear(DT) = 1 then W2 := WeeksInYear(aNow) + 1
else W2 := WeekOfTheYear(DT);
FMaxWeeks := (W2 - W1);
end;
procedure TContainerControl.ClearArray;
begin
FArray.Clear;
end;
procedure TContainerControl.CreateArray;
var
I, T, W : Integer;
AC : TArrayControl;
begin
// if Assigned(FCalendar) then
begin
ClearArray;
T := 1;
W := Width;
for I := 0 to FMaxWeeks + 1 do
begin
AC := TArrayControl.Create(Self);
if (I = 0) then
begin
Inc(T, 2);
AC.Left := Width + 2;
AC.Style:= asWeekDay;
end
else
begin
AC.Left := 1;
AC.Style:= asDay;
end;
AC.Parent := Self;
AC.Top := T;
Inc(T, AC.Height -1);
W := AC.Width;
FArray.Add(AC);
end;
Width := W + 2;
Height:= T + 2;
end;
end;
procedure TContainerControl.CreateWnd;
begin
if Assigned(Parent) then
begin
inherited CreateWnd;
CreateArray;
end;
end;
procedure TContainerControl.Paint;
var
R : TRect;
begin
R := GetClientRect;
with Canvas do
begin
{$IFDEF DEBUG}
Brush.Color := clLime;
Rectangle(R);
InflateRect(R, -1, -1);
{$ENDIF}
FillRect(R);
end;
end;
procedure TContainerControl.SetCalendar(Value : TCalendarControl);
begin
if FCalendar <> Value then
begin
FCalendar := Value;
Update;
end;
end;
procedure TContainerControl.Update;
begin
inherited Update;
if Assigned(FCalendar) then
if (FOldDate = 0) then
begin
FOldDate := FCalendar.Date;
WeeksInTheMonth(FCalendar.Date);
CreateArray;
end
else
begin
FOldDate := FCalendar.Date;
WeeksInTheMonth(FCalendar.Date);
ClearArray;
CreateArray;
end;
end;
destructor TContainerControl.Destroy;
begin
ClearArray;
inherited Destroy;
end;
...
Theoretisch deshalb weil es in folgender Schleife zu seltsamen Verhalten kommt:
Delphi-Quellcode:
...
procedure TContainerControl.CreateArray;
var
I, T, W : Integer;
AC : TArrayControl;
begin
// if Assigned(FCalendar) then
begin
ClearArray;
T := 1;
W := Width;
for I := 0 to FMaxWeeks + 1 do
begin
AC := TArrayControl.Create(Self);
if (I = 0) then
begin
Inc(T, 2);
AC.Left := Width + 2;
AC.Style:= asWeekDay;
end
else
begin
AC.Left := 1;
AC.Style:= asDay;
end;
AC.Parent := Self;
AC.Top := T;
Inc(T, AC.Height -1);
W := AC.Width; <<-hier
FArray.Add(AC);
end;
Width := W + 2;
Height:= T + 2;
end;
end;
...
AC.Width ist hier
0!?
Durch die Zuweisung von
AC.Parent := Self; werden die CreateWnd-Prozeduren der vorgänger Objectkte aufgerufen
und da TBaseControl.CreateWnd eine Größenzuweisung macht
Delphi-Quellcode:
...
Width := Canvas.TextWidth('WD');
Height := Canvas.TextWidth('WD');
...
ist mir dieses Verhalten schleiherhaft, zumal es beider zweiten und jeder weiteren Zeile ordnungsgemäß
funktioniert(siehe Button "Create 'TContainerObject'", manuelle Änderung der variablen FMaxWeeks in
TContainerControl.CreateArray vorausgesetzt).
Ich hatte ursprünglich für die Variable
FArray ein dynamisches Array alá
Array of verwendet,
da lief alles Reibungslos,; Allerdings taten sich Probleme beim löschen/freigeben auf.
Falls es Fragen geben sollte bezüglich der Zahlen in den Feldern, die mit '0' gefüllten sind,
sie sind für die Kalenderwochen reserviert, 1-7 stehen somit für die Kalendertage.
Ich vermute mal das dies auch der Fehler ist warum hier
Kalender keine Wochentagskonstanten angezeigt werden.
Für Hinweise bzw. Hilfe wie immer Dankbar
Alter Mann
PS Die Prozedur 'TContainerControl.Update' hat damit 'noch' nichts zu tun und wird garantiert noch geändert.
Aber wer will, kann sich ja beteiligen.