Merkwürdiges Verhalten von Controls in einer Schleife

[Alter Mann]

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.