Einzelnen Beitrag anzeigen

Benutzerbild von Lannes
Lannes

Registriert seit: 30. Jan 2005
Ort: Münster
745 Beiträge
 
Delphi 3 Professional
 
#4

Re: Stringgrid-Zelle doppelt füllen

  Alt 21. Dez 2005, 10:54
Hallo,

das ist doch mal eine schöne Aufgabe

Falls ich deine Erklärung richtig interpretiert habe müssten doch,
wenn B und C nicht zusammenfallen,
in den Zeilen zwei Einträge vorhanden sein:
Code:
---------------------
| B |    | C |    |
---------------------
|    | BC |    |    |
---------------------
das stimmt aber nicht mit Deinem Beispiel-Bild überein.

Ist aber nicht so wichtig,
das grundsätzliche Vorgehen wird glaube ich aus dem Beispiel-Code ersichtlich.
Hab jetzt aber nicht mehr viel Zeit um ihn umfassend zu kommentieren.
Zum Grundsätzlichen:
OnDrawCell wird dann ausgelöst wenn eine Zelle neu gezeichnet werden muss,
also wenn etwas hineingeschrieben wurde.
ACol bzw. ARow ist die Zelle die aktuell gezeichnet wird.
Delphi-Quellcode:
var
  Form1: TForm1;
  B,C : array [0..4] of Integer;
implementation

{$R *.DFM}
//Beispiel-Daten erzeugen und ins Grid setzen.
procedure TForm1.FormCreate(Sender: TObject);
var z : integer;
begin
  randomize;
for z := 0 to 4 do
  begin
  B[z] := random(4);
  C[z] := random(4);
  end;
for z := 0 to 4 do
  begin
  StringGrid1.Cells[B[z],z] := StringGrid1.Cells[B[z],z]+'B';
  StringGrid1.Cells[C[z],z] := StringGrid1.Cells[C[z],z]+'C';
  end;
end;
//wird für jede Zelle die gezeichnet werden muss, ausgelöst
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var sH,sW,CellsH,CellsW : Integer;
begin
  with StringGrid1 do
  if Cells[ACol,ARow] <> 'then
    begin
    Canvas.FillRect(Rect);//vorhandenen Eintrag übermalen
    sH := Canvas.TextHeight('B');
    sW := Canvas.TextHeight(Cells[ACol,ARow]);
    CellsH := RowHeights[ARow];
    CellsW := ColWidths[ACol];
    if Cells[ACol,ARow] = 'Bthen
      begin
      Canvas.Pen.Color := clGreen;
      Canvas.Brush.Color := clGreen;
      Canvas.Ellipse(Rect.Left+10,Rect.Top+10,
                     Rect.Left+40,Rect.Top+40);
      Canvas.TextOut(Rect.Left+Round((CellsW/2)-(sW/2)),
                     Rect.Top+Round((CellsH/2)-(sH/2)),
                     Cells[ACol,ARow]);
      end;
    if Cells[ACol,ARow] = 'Cthen
      begin
      Canvas.Pen.Color := clRed;
      Canvas.Brush.Color := clRed;
      Canvas.Ellipse(Rect.Left+10,Rect.Top+10,
                     Rect.Left+40,Rect.Top+40);
      Canvas.TextOut(Rect.Left+Round((CellsW/2)-(sW/2)),
                     Rect.Top+Round((CellsH/2)-(sH/2)),
                     Cells[ACol,ARow]);
      end;
    if Cells[ACol,ARow] = 'BCthen
      begin
      Canvas.Pen.Color := clGreen;
      Canvas.Brush.Color := clGreen;
      Canvas.Pie(Rect.Left+10,Rect.Top+10,
                 Rect.Left+40,Rect.Top+40,
                 Rect.Left+40,Rect.Top+25,
                 Rect.Left+10,Rect.Top+25);
      Canvas.Pen.Color := clRed;
      Canvas.Brush.Color := clRed;
      Canvas.Pie(Rect.Left+10,Rect.Top+10,
                 Rect.Left+40,Rect.Top+40,
                 Rect.Left+10,Rect.Top+25,
                 Rect.Left+40,Rect.Top+25);
      Canvas.Brush.Style := bsClear;//sonst Texthintergrund rot
      Canvas.TextOut(Rect.Left+Round((CellsW/2)-(sW/2)),
                     Rect.Top+Round((CellsH/2)-(sH/2)),
                     Cells[ACol,ARow]);
      end;
    end;
end;
der Code ist sicher noch verbesserungswürdig,
z.B. Teile in Funktionen auslagern...
MfG Lannes
(Nichts ist nicht Nichts) and ('' <> nil ) and (Pointer('') = nil ) and (@('') <> nil )
  Mit Zitat antworten Zitat