stringgrid - rahmen um mehrere Zellen

[eddy]

Hallo Leute,

ich stelle gleichartige Daten in einem StringGrid dar. Dabei bilden 5 Spalten und 3 Zeilen jeweils eine Gruppe von Daten.
Je nach Datenmenge werden 2 bis 8 Gruppen nebeneinander und 2 bis 20 Gruppen untereinander dargestellt.

Ich möchte jetzt um jede Gruppe (= 5 Spalten und 3 Zeilen) einen Rahmen zeichnen, komme aber nicht weiter.

Kann mir jemand weiter helfen?

eddy

[taaktaak]

Moin, Moin.
Wo kommst du nicht weiter?
Bist du schon dabei das im OnDrawCell zu realisieren?

[eddy]

Hallo taaktaak,

in OnDrawCell wird von mir der Text (meist nur 1 bis 3 Zeichen) sowie die Hintergrundfarbe gezeichnet.
Mit

Delphi-Quellcode:

   (sender as TStringgrid).canvas.pen.color:=clRed;
   (sender as TStringgrid).canvas.Rectangle(rect.left,rect.top,rect.Right,rect.bottom);

ist es mir auch gelungen, um jede einzelne Zelle einen Rahmen zu zeichnen.

Ich möchte aber nicht um jede Zelle einen Rahmen, sondern um eine Gruppe von 5 * 3 Zellen soll ein Rahmen gezeichnet werden.

eddy

[taaktaak]

Moin eddy.
Vielleicht zum "Warmlesen" mal folgenden Link. Da geht es zwar um das Verbinden von Zellen, aber die Aufgabe um mehrere Zellen einen Rahmen zu zeichnen ist der dort diskutierten Problematik sehr ähnlich.

[eddy]

Hallo Leute,

im Test habe ich das Problem folgendermaßen gelöst:

Delphi-Quellcode:

unit sgrahmen1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, Buttons, ExtCtrls, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    sg: TStringGrid;
    mitRahmen: TCheckBox;
    procedure sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure FormActivate(Sender: TObject);
    procedure mitRahmenClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
const
  rb = 4;   // Rahmenbreite
var
  rc : TRect;
begin
  // die mittleren 9 Felder sollen einen roten Rahmen erhalten
  if mitRahmen.Checked then begin
    if (acol = 0) or (arow = 0) or (acol = sg.ColCount-1) or (arow = sg.RowCount-1)
      then sg.Canvas.Brush.Color := clLime
      else sg.Canvas.Brush.Color := clRed;
    sg.Canvas.FillRect(Rect);

    rc := Rect;
    // Felder mit Rahmen an der Oberkante
    if (arow = 1) and (acol > 0) and (acol < sg.ColCount - 1)
      then rc.Top := Rect.Top + rb;

    // Felder mit Rahmen an der Unterkante
    if (arow = sg.RowCount - 2) and (acol > 0) and (acol < sg.ColCount - 1)
      then rc.Bottom := Rect.Bottom - rb;

    // Felder mit Rahmen an der linken Seite
    if (acol = 1) and (arow > 0) and (arow < sg.RowCount - 1)
      then rc.Left := Rect.Left + rb;

    // Felder mit Rahmen an der rechten Seite
    if (acol = sg.ColCount - 2) and (arow > 0) and (arow < sg.RowCount - 1)
      then rc.Right := Rect.Right - rb;

    // Rot mit Aqua überschreiben, wenn ...
    // ... rc <> Rect
    if (rc.Top <> Rect.Top) or (rc.Bottom <> Rect.Bottom) or (rc.Left <> Rect.Left) or (rc.Right <> Rect.Right)
      // oder es sich um die mittleren Felder handelt
      or (arow > 1) and (arow < sg.RowCount - 2) and (acol > 1) and (acol < sg.ColCount - 2)
    then begin
      sg.Canvas.Brush.Color := clAqua;
      sg.Canvas.FillRect(rc);
    end;

  end
  else begin
    if (acol = 0) or (arow = 0) or (acol = sg.ColCount-1) or (arow = sg.RowCount-1)
      then sg.Canvas.Brush.Color := clGreen
      else sg.Canvas.Brush.Color := clYellow;
    sg.Canvas.FillRect(Rect);
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  sg.FixedCols := 0;
  sg.FixedRows := 0;
  sg.ColCount := 7;
  sg.RowCount := 7;
  sg.DefaultColWidth := 60;
  sg.DefaultRowHeight := 60;
  sg.Width := sg.ColCount * (sg.DefaultColWidth + 2);
  sg.Height := sg.RowCount * (sg.DefaultRowHeight + 2);
end;

procedure TForm1.mitRahmenClick(Sender: TObject);
begin
  sg.Repaint;
end;

end.

Falls jemand eine weniger aufwändige Lösung hat, wären ein paar Zeilen Quelltext zum Probieren nicht schlecht.

mfg
eddy