TStringGrid: über mehrere Zellen schreiben

[hoika]

Hallo #,

der folgende Code versucht, Zelle 1,0 über 2 Zellen zu schreiben.
Das soll aber ohne DefaultDrawing=False gemacht werden.

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Grid.DefaultColWidth:= 28;
  Grid.Cells[1,0]:= 'Januar';
end;

procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  MyRect: TRect;
begin
  if (ACol=1) and
     (ARow=0) then
  begin
    Grid.DefaultDrawing:= False;
    MyRect.TopLeft:= Rect.TopLeft;
    MyRect.BottomRight:= Rect.BottomRight;
    MyRect.Right:= Rect.Right*2;

    Grid.Canvas.FillRect(MyRect);
    DrawText(Grid.Canvas.Handle, PChar(Grid.Cells[ACol,ARow]),
      Length(Grid.Cells[ACol,ARow]), MyRect, DT_LEFT);
  end
  else
  begin
    Grid.DefaultDrawing:= True;
  end;
end;

Klappt aber nicht so richtig ;(
Sieht einfach nur doof aus ... (siehe Screenshot)
Z.B, die weisse Line hinter "Januar"

Wie macht man das richtig ?


Heiko

[Keldorn]

Hallo

- Du mußt verhindern, daß die Zelle 2,0 neu gezeichnet wird, bzw dort die Zelle 1,0 erneut über die beiden Zellen zeichnen. Das was Du als weißen Strich siehst, ist der 3D-Rahmen der Zelle 2,0.
- MyRect.Right:= Rect.Right*2; würde ich nicht nehmen, das wird nicht immer funktionieren
- gugg Dir mal die Proc Frame3d an

Gruß Frank

[hoika]

Hallo,

bringt mich leider auch nicht so weiter ... ;(

Zitat:

daß die Zelle 2,0 neu gezeichnet wird, bzw dort die Zelle 1,0 erneut

OK,
if ACol=2 then
???

Zitat:

MyRect.Right:= Rect.Right*2;

ohne kommt immer in weisses Rechteck

Zitat:

Frame3d

Was nehme ich als Button-Farben ?


Heiko

[hoika]

Hallo,

sooooo,
jetzt sieht es so aus.

siehe Anhang

Delphi-Quellcode:

procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  MyRect : TRect;
  iCol   : Integer;
begin
  if ((ACol=1) or (ACol=2)) and
     (ARow=0) then
  begin
    Grid.DefaultDrawing:= False;

    if (ACol=2) then Exit;

    iCol:= 1;

    MyRect:= Grid.CellRect(iCol,ARow);

    MyRect.TopLeft:= Rect.TopLeft;
    MyRect.BottomRight:= Rect.BottomRight;
    MyRect.Right:= MyRect.Right*2;
//    MyRect.Right:= MyRect.Right+Grid.DefaultColWidth;

    Grid.Canvas.FillRect(MyRect);

//    Frame3D(Grid.Canvas, MyRect, clBtnFace, clBlack, MyRect.Right-MyRect.Left);

    MyRect.Left:= MyRect.Left+2;
    MyRect.Top:= MyRect.Top+2;

    DrawText(Grid.Canvas.Handle, PChar(Grid.Cells[iCol,ARow]),
      Length(Grid.Cells[iCol,ARow]), MyRect, DT_LEFT);

//    Frame3D(Grid.Canvas, MyRect, clBtnFace, clBlack, MyRect.Right-MyRect.Left);
  end
  else
  begin
    Grid.DefaultDrawing:= True;
  end;
end;

Aber das Frame3D erzeugt nur Müll ;(
Auch das ausgeklammerte MyRect.Right:= MyRect.Right+Grid.DefaultColWidth;
erzeugt nur Müll ;(

Hat denn keiner einen funktionierenden Quellcode ?? ;(


Heiko

[hoika]

Hallo,

naja, man muss nur den richtigen Suchbegriff kennen.
Zellen verbinden

Zellen verbinden


Heiko

[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

[Keldorn]

dein code geht aber nicht richtig, wenn Du colsizing aktiv hast.
auf die Schnelle würde ich das ändern in:

- die verbundene Zelle im Grid selber werden leider erst immer beim 2. Klick richtig gezeichnet.

Delphi-Quellcode:

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

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

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

  Grid:= Sender as TStringGrid;
//  Grid.DefaultDrawing:= False;    //im Formcreate

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

    if IsCellMerged(Point(ACol, ARow), CellSpan) then
    begin
      // Calculate rect of whole merged cell
      //--->> probelm ist hier, wenn Du scrollen mußt hast Du hier ein Problem
      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.

        if Arow<Grid.fixedrows then //nur für fixierte rows
          begin
            //uses extctrls, graphutil
            Grid.Canvas.Font.color:=clWindowText;
            Frame3D(Grid.Canvas,
                    LargeRect,
                    GetHighLightColor(Grid.FixedColor),
                    GetShadowColor(Grid.FixedColor),
                    1);
          end
         else
          begin
//            if ((IsCellMerged(Point(acol,arow),Cellspan)) and (IsCellMerged(Point(Grid.col,Grid.row),Cellspan))) or (gdSelected in State) then 
            //ist die aktuelle Zelle selektiert im Cellspan?
            if (IsCellMerged(Point(Grid.col,Grid.row),Cellspan)) then
              begin
                Grid.canvas.Brush.color:=clHighlight;
                Grid.canvas.Font.color :=clHighlightText;
              end
             else
              begin
                Grid.canvas.Brush.color:=Grid.color;
                Grid.canvas.Font.color :=clWindowText;
              end;
            Grid.Canvas.FillRect(LargeRect);
          end;

        Grid.Canvas.TextRect(LargeRect, LargeRect.Left + 2, LargeRect.Top + 2,
                             Grid.Cells[FMergedCells[I].Left, FMergedCells[I].Top]);

        if (IsCellMerged(Point(Grid.col,Grid.row),Cellspan)) then
          Grid.canvas.DrawFocusRect(LargeRect);


      finally
        RestoreDC(Grid.Canvas.Handle, Index);
        Grid.Canvas.Refresh;
      end;

      Exit;
    end;
  end;

  //sonst Zellen normal zeichnen
  if (acol<Grid.fixedcols) or (arow<Grid.fixedrows) then
    begin
      Grid.canvas.Brush.color:=grid.FixedColor;
      Grid.Canvas.FillRect(Rect);
      Frame3D(Grid.Canvas,
              Rect,
              GetHighLightColor(Grid.FixedColor),
              GetShadowColor(Grid.FixedColor),
              1);
      Grid.Canvas.TextRect(Rect,rect.Left+2,rect.Top+2,Grid.Cells[acol,arow]);
    end
   else
    begin
      if gdSelected in State then
        begin
          Grid.canvas.Brush.color:=clHighlight;
          Grid.canvas.Font.color :=clHighlightText;
        end
       else
        begin
          Grid.canvas.Brush.color:=grid.color;
          Grid.canvas.Font.color :=clWindowText;
        end;
      Grid.Canvas.FillRect(Rect);
      Grid.Canvas.TextRect(Rect,rect.Left+2,rect.Top+2,Grid.Cells[acol,arow]);
    end;
end;

procedure TForm3.Grid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
Var CellSpan  : TRect;
    i:integer;
    Grid:TStringGrid;
begin
  Grid:= Sender as TStringGrid;

  for I := 0 to Length(FMergedCells) - 1 do
  begin
    CellSpan := FMergedCells[I];
    if IsCellMerged(point(Grid.col,Grid.row),CellSpan) or
       IsCellMerged(point(acol,arow),CellSpan) then
      begin
        //besser wäre hier nicht das ganze Grid neuzuzeichnen, sondern nur die Cellspan
        grid.Repaint;
        exit;
      end;
    end;
end;

Probleme sind immer z.B.:
- wenn das Grid zu klein ist Scrollen
- Cursortasten, wenn die verbundenen Zellen keine fixierten sind

das Frame3d ist doch ganz einfach, mit gethighlight und getshadowcolor hast auch gleich die richtigen Farben, wenns mal nicht clbtnface die fixedcolor ist.

Gruß Frank

[hoika]

Hallo,

hmmmm,
also ich kann scrollen ... ;)

ColSizing jibbet nicht (in diesem Form).
Ich will nur in den fixed Rows was schreiben.

Mensch, wird das kompliziert ..


Heiko