Einzelnen Beitrag anzeigen

Benutzerbild von Fussel9
Fussel9

Registriert seit: 25. Mai 2009
322 Beiträge
 
Turbo Delphi für Win32
 
#3

Re: Aktuelles Datum Einfärben

  Alt 28. Dez 2009, 16:37
Ok, da immernoch keiner ne idee hat hier mal die kompletten zwei prozeduren, und ja ich weiß das ich da manches umständlicher hab als vielleicht nötig...

Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
var lauf: Integer;
    count,Zaehler: Integer;
    row: Integer;
    year: Word;
    month: Word;
    firstMonday: Word;
    day: Word;
begin
Zaehler:=0;
row:=1;
count:=0;
Tage:=DaysInMonth(date);
DecodeDate(date,year,month,firstMonday);
DecodeDate(LastDayOfWeekOfMonth(year,month,1),year,month,firstMonday);
while firstMonday > 7 do
  begin
    firstMonday:=firstMonday-7;
  end;
if not firstMonday > 7 then
  begin
    With Kalender do
      begin
        dec(firstMonday);
        Cells[firstMonday,0]:='Montag';
        inc(firstMonday);
      if not (firstMonday >= 7) then
        begin
        Cells[firstMonday,0]:='Dienstag';
        inc(firstMonday);
        end
      else
        begin
        ShowMessage('ELSE-HANDLER GREIFT BEI FALL: '+IntToStr(firstMonday)+'!');
        firstMonday:=0;
        Cells[firstMonday,0]:='Dienstag';
        inc(firstMonday);
        end;
      if not (firstMonday >= 7) then
        begin
        Cells[firstMonday,0]:='Mittwoch';
        inc(firstMonday);
        end
      else
        begin
        ShowMessage('ELSE-HANDLER GREIFT BEI FALL: '+IntToStr(firstMonday)+'!');
        firstMonday:=0;
        Cells[firstMonday,0]:='Mittwoch';
        inc(firstMonday);
        end;
      if not (firstMonday >= 7) then
        begin
        Cells[firstMonday,0]:='Donnerstag';
        inc(firstMonday);
        end
      else
        begin
        ShowMessage('ELSE-HANDLER GREIFT BEI FALL: '+IntToStr(firstMonday)+'!');
        firstMonday:=0;
        Cells[firstMonday,0]:='Donnerstag';
        inc(firstMonday);
        end;
      if not (firstMonday >= 7) then
        begin
        Cells[firstMonday,0]:='Freitag';
        inc(firstMonday);
        end
      else
        begin
        ShowMessage('ELSE-HANDLER GREIFT BEI FALL: '+IntToStr(firstMonday)+'!');
        firstMonday:=0;
        Cells[firstMonday,0]:='Freitag';
        inc(firstMonday);
        end;
      if not (firstMonday >= 7) then
        begin
        Cells[firstMonday,0]:='Samstag';
        inc(firstMonday);
        end
      else
        begin
        ShowMessage('ELSE-HANDLER GREIFT BEI FALL: '+IntToStr(firstMonday)+'!');
        firstMonday:=0;
        Cells[firstMonday,0]:='Samstag';
        inc(firstMonday);
        end;
      if not (firstMonday >= 7) then
        begin
        Cells[firstMonday,0]:='Sonntag';
        end
      else
        begin
        ShowMessage('ELSE-HANDLER GREIFT BEI FALL: '+IntToStr(firstMonday)+'!');
        firstMonday:=0;
        Cells[firstMonday,0]:='Sonntag';
        end;
      end;
  end;
DecodeDate(date,year,month,day);
for lauf := 1 to Tage do
begin
Inc(Zaehler);
  if count = 7 then
    begin
      count:=0;
      inc(row);
      Kalender.Cells[count,row]:=IntToStr(lauf);
      inc(count);
    end
  else
    begin
      Kalender.Cells[count,row]:=IntToStr(lauf);
      inc(count);
    end;
if EncodeDate(year,month,zaehler)=date then
  begin
    Kalender.objects[count,row]:=TObject(1); //<-Das Tuts nicht
  end;
end;
//DecodeDate(date,year,month,day); //<-Das war meine erste Idee funzt auch nicht
//Kalender.objects[day mod 7,day div 7]:=TObject(1); // da wird immer (gestern und heute) der 22te eingefärbt
end;

Delphi-Quellcode:
procedure TForm1.KalenderDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  (sender as TStringgrid).canvas.Brush.color:=(sender as TStringgrid).color;
  if integer(Kalender.objects[col,row])=1 then
  begin
    (sender as TStringgrid).canvas.Brush.color:=clInfoBk;
    (sender as TStringgrid).canvas.FillRect(rect);
    (sender as TStringgrid).canvas.TextOut(rect.left+2,rect.top+2,(sender as TStringgrid).Cells[col,row]);
  end;
end;
Vielleicht hilft das ja irgendwie....
Edit--> Hi, hab mal nen begin und end zur letzten prozedur hinzugefürt und bin einige male mit dem Debugger drüber Ergebnis: --> if integer(Kalender.objects[col,row]=1 then .... ist nicht erfüllt
  Mit Zitat antworten Zitat