TStringGrid: über mehrere Zellen schreiben

[hoika]

Hallo,

und hier der fertige Code
(fixed Row Teil von mir, Rest Internet)

Der Code im FormActivate ist notwenig.

Delphi-Quellcode:

unit Unit8;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ExtCtrls;

type
  TForm8 = class(TForm)
    Grid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Grid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormActivate(Sender: TObject);
  private
    FMergedCells: array of TRect;
  public
    { Public-Deklarationen }
  end;

var
  Form8: TForm8;

implementation

{$R *.dfm}

procedure TForm8.FormCreate(Sender: TObject);
begin
  Grid1.Col:= 1;

  SetLength(FMergedCells, 2);
  FMergedCells[0] := Rect(1,1,2,1);
  Grid1.Cells[1,1] := 'This text spans over 2 cells';

  FMergedCells[1] := Rect(3,1,4,1);
  Grid1.Cells[3,1] := 'This text spans over 2 cells';
  Grid1.Cells[1,2] := 'A regular cell';
  Grid1.Cells[1,3] := 'A regular cell';

//  Grid1.ColWidths[0]:= -1;
  Grid1.Col:= 0;
  Grid1.Refresh;
end;

procedure TForm8.Grid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

  function IsCellMerged(Point: TPoint; Rect: TRect): Boolean;
  begin
    Inc(Rect.Right);
    Inc(Rect.Bottom);
    Result := PtInRect(Rect, Point);
  end;

var
  Index     : Integer;
  I         : Integer;
  LargeRect : TRect;
  CellSpan  : TRect;
  Grid      : TStringGrid;
begin
  Grid:= Sender as TStringGrid;

  for I := 0 to Length(FMergedCells) - 1 do
  begin
    CellSpan := FMergedCells[I];

    if IsCellMerged(Point(ACol, ARow), CellSpan) then
    begin
      Grid.DefaultDrawing:= False;

      // Calculate rect of whole merged cell
      LargeRect := Classes.Rect(
        Grid.CellRect(CellSpan.Left, CellSpan.Top).TopLeft,
        Grid.CellRect(CellSpan.Right, CellSpan.Bottom).BottomRight);

      Inc(Rect.Right, Grid.GridLineWidth);
      Inc(Rect.Bottom, Grid.GridLineWidth);

      Index := SaveDC(Grid.Canvas.Handle);
      try
        Grid.Canvas.Refresh;

        IntersectClipRect(Grid.Canvas.Handle, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);

        // Draw the merged cell, but only the part that is supposed to be drawn
        // by this particular event call.
        Grid.Canvas.FillRect(LargeRect);
        Grid.Canvas.TextRect(LargeRect, LargeRect.Left + 2, LargeRect.Top + 2,
          Grid.Cells[FMergedCells[I].Left, FMergedCells[I].Top]);
      finally
        RestoreDC(Grid.Canvas.Handle, Index);
        Grid.Canvas.Refresh;
      end;

      Exit;
    end;
  end;

  if ACol<Grid.FixedCols then
  begin
    Grid.Canvas.Brush.Color:= Grid.FixedColor;
    Grid.Canvas.FillRect(Rect);
  end;

  Grid.DefaultDrawing:= True;
end;

procedure TForm8.FormActivate(Sender: TObject);
begin
  Grid1.Refresh;
  Grid1.Col:= 1;
end;

end.

Heiko