Eigener Kalender bauen

[nahpets]

Ein StrToLabel kann man sich doch selber bauen:

Wenn es für die Komponenten auf dem Formular eine Namenskonvention gibt, dann kann man sich doch, ausgehend vom Datum, per FindComponent das passende Label suchen:

Einfachste Methode wäre, die Labels mit 'nem Namen versehen, der im Datum vorkommt. Z. B.

Delphi-Quellcode:

lbMonat0101 : TLabel;
lbMonat0102 : TLabel;
...
lbMonat1231 : TLabel;
...
lbTag0101 : TLabel;
lbTag0102 : TLabel;
...
lbTag1231 : TLabel;

Damit haben wir Komponentennamen, die man automatisch "zusammenbauen" kann und somit per FindComponent suchen kann.

Ist jetzt mal nur so ungetestet hingedaddelt:

Delphi-Quellcode:

procedure ProcessOneDay(ADate: TDate);
var
          sWoTag  : String;
          lbDate  : TLabel;
          lbDay   : TLabel;
          lbFeld  : TLabel;
          lbCount : TLabel;
begin
  lbDate := FindComponent(Format('lbMonat%s%s',[Copy(DateToStr(ADate),4,2),Copy(DateToStr(ADate),1,2)]));
  if not Assigned(lbDate then Exit; // oder 'ne Fehlermeldung
  lbDay := FindComponent(Format('lbTag%s%s',[Copy(DateToStr(ADate),4,2),Copy(DateToStr(ADate),1,2)]));
  if not Assigned(lbDay then Exit; // oder 'ne Fehlermeldung
  lbFeld := FindComponent(Format('lbFeld%s%s',[Copy(DateToStr(ADate),4,2),Copy(DateToStr(ADate),1,2)]));
  if not Assigned(lbFeld then Exit; // oder 'ne Fehlermeldung
  lbCount := FindComponent(Format('lbCount%s%s',[Copy(DateToStr(ADate),4,2),Copy(DateToStr(ADate),1,2)]));
  if not Assigned(lbCount then Exit; // oder 'ne Fehlermeldung
  Case DayOfWeek(ADate) of
    1 : sWoTag := 'Mo';
    2 : sWoTag := 'Di';
    3 : sWoTag := 'Mi';
    4 : sWoTag := 'Do';
    5 : sWoTag := 'Fr';
    6 : begin
          sWoTag := 'Sa';
          lbDate.Font.Style := [fsBold];
          lbDay.Font.Style := [fsBold];
          lbFeld.Color := clWebBISQUE
        end;
    7 : begin
          sWoTag := 'So';
          lbDate.Font.Style := [fsBold];
          lbDay.Font.Style := [fsBold];
          lbFeld.Color := clWebBISQUE
        end;
  end;
  if (EmptyStr <> Feiertage.IstFeiertag(ADate)) then begin
    lbDate.Font.Style := [fsBold];
    lbDay.Font.Style := [fsBold];
    lbFeld.Color := clWebBISQUE;
    lbDate.Font.Color := clRed;
    lbDay.Font.Color := clRed;
    lbCount.Left := 50;
    lbCount.Width := 55;
    lbCount.Alignment := taLeftJustify;
    lbCount.Font.Color := clRed;
    lbCount.Font.Size := 7;
    lbCount.Top := 1;
    lbCount.Caption := Feiertage.IstFeiertag(ADate);
  end;
  if Feiertage.IstFerientag(ADate) then begin
    lbFeld.Color := clYellow;
  end;
end;

var
      i : Integer;
begin
  For i := Trunc(StrToDate('01.01.2016')) to Trunc(StrToDate('31.12.2016')) do begin
    ProcessOneDay(i);
  end;
  // oder ab heute für 365 Tage
  For i := Trunc(Now) to Trunc(Now + 365) do begin
    ProcessOneDay(i);
  end;
end;