Eigener Kalender bauen

[nahpets]

Naja, Datum ist 'ne Zahl, ginge also z. B. in 'ner For-Schleife:

Delphi-Quellcode:

procedure ProcessOneDay(ADate: TDate; var ADateLabel: TLabel; var ADayLabel: TLabel; var ACountLabel: TLabel; var AFeld: TPanel??);
begin
  Case DayOfWeek(ADate) of
    1 : ADayLabel.Caption := 'Mo';
    2 : ADayLabel.Caption := 'Di';
    3 : ADayLabel.Caption := 'Mi';
    4 : ADayLabel.Caption := 'Do';
    5 : ADayLabel.Caption := 'Fr';
    6 : begin 
          ADayLabel.Caption := 'Sa';
          ADateLabel.Font.Style := [fsBold];
          ADayLabel.Font.Style := [fsBold];
          AFeld.Color := clWebBISQUE
        end;
    7 : begin 
          ADayLabel.Caption := 'So';
          ADateLabel.Font.Style := [fsBold];
          ADayLabel.Font.Style := [fsBold];
          AFeld.Color := clWebBISQUE
        end;
  end;
  if (EmptyStr <> Feiertage.IstFeiertag(ADate)) then begin
    ADateLabel.Font.Style := [fsBold];
    ADayLabel.Font.Style := [fsBold];
    AFeld.Color := clWebBISQUE;
    ADateLabel.Font.Color := clRed;
    ADayLabel.Font.Color := clRed;
    ACountLabel.Left := 50;
    ACountLabel.Width := 55;
    ACountLabel.Alignment := taLeftJustify;
    ACountLabel.Font.Color := clRed;
    ACountLabel.Font.Size := 7;
    ACountLabel.Top := 1;
    ACountLabel.Caption := Feiertage.IstFeiertag(ADate);
  end;
  if Feiertage.IstFerientag(ADate) then begin
    AFeld.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, DateLabel, DayLabel, CountLabel, Feld);
  end;
end;

[Dumpfbacke]

Zitat von nahpets:

Naja, Datum ist 'ne Zahl, ginge also z. B. in 'ner For-Schleife:

Delphi-Quellcode:

var
      i : Integer;
begin
  For i := Trunc(StrToDate('01.01.2016')) to Trunc(StrToDate('31.12.2016')) do begin
    ProcessOneDay(i, DateLabel, DayLabel, CountLabel, Feld);
  end;
end;

Das Problem liegt nicht beim Datum, sondern bei den Label. Ich habe ja für jeden Tag z.B. ein anders Label auf der Frorm liegen. Jan1Tag, Jan2Tag, Jan3Tag usw. ein StrToTLabel gibt es ja leider nicht denn sonst würde ich mir das String zusammenbauen und dann in ein TLabel umwandeln.

Tanja

[Benedikt Magnus]

Zitat von Dumpfbacke:

Das Problem liegt nicht beim Datum, sondern bei den Label. Ich habe ja für jeden Tag z.B. ein anders Label auf der Frorm liegen. Jan1Tag, Jan2Tag, Jan3Tag usw. ein StrToTLabel gibt es ja leider nicht denn sonst würde ich mir das String zusammenbauen und dann in ein TLabel umwandeln.

Tanja

Du könntest die Tags der Labels nutzen (Tags = Tag), sie in einer Liste/Array zusammenfassen (Index = Tag) oder mit FindComponent arbeiten.

[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;

[nahpets]

Delphi-Quellcode:

function StrToLabel(sName : String) : TLabel;
var
        myCompo : TComponent;
begin
  Result := Nil;
  myCompo := FindComponent(Format('lb%s',[sName])); // oder welche Namenskonvention auch immer.
  if Assigned(myCompo) then begin
    if myCompo is tLabel then Result := myCompo;
  end;
end;

[nahpets]

Hab' gerade nochmal ein bisserl rumgesucht und noch was gefunden, was für die bisherige Namensvergabe der Komponenten passen könnte:

Delphi-Quellcode:

procedure ProcessOneDay(ADate: TDate);
var
          fFormatSettings : TFormatSettings;
          sName : String;   
          lbDate : TLabel;
          lbDay : TLabel;
          lbFeld : TLabel;
          lbCount : TLabel;
begin
  GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT,fFormatSettings);
  sName := FormatDateTime('mmmd',ADate,fFormatSettings);
  lbDate := FindComponent(sName);
  if not Assigned(lbDate) then Exit; // oder 'ne Fehlermeldung
  lbDay  := FindComponent(Format('%sTag',[sName]));
  if not Assigned(lbDay) then Exit; // oder 'ne Fehlermeldung
  lbFeld := FindComponent(Format('Feld%s',[sName]));
  if not Assigned(lbFeld) then Exit; // oder 'ne Fehlermeldung
  lbCount := FindComponent(Format('%sAnzahl',[sName]));
  if not Assigned(lbCount) then Exit; // oder 'ne Fehlermeldung
  Case DayOfWeek(ADate) of
    6,7 : begin
          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;