TStringGrid scalić rysunek komórki

Question

Ten link/pic pokazuje, co próbuję osiągnąć z TStringGrid.

Ten link/fot pokaż co mój kod poniżej skutkuje.

unit Unit1; 

interface 

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

type 
    TForm1 = class(TForm) 
    StringGrid: TStringGrid; 
    procedure FormCreate(Sender: TObject); 
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); 
    private 
    public 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
const 
    cProdWidth = 70; 
    cCountWidth = 45; 
    cWeightWidth = 55; 
var 
    Index: Integer; 
    Col, Row: Integer; 
begin 
    StringGrid.ColCount := 10; 
    StringGrid.RowCount := 2; 
    StringGrid.Cells[1, 0] := 'Shoulder'; 
    StringGrid.ColWidths[1] := cProdWidth; 
    StringGrid.Cells[4, 0] := 'Barrel'; 
    StringGrid.ColWidths[4] := cProdWidth; 
    StringGrid.Cells[7, 0] := 'Leg'; 
    StringGrid.ColWidths[7] := cProdWidth; 

    StringGrid.Cells[0, 1] := 'Carcass Prod'; 
    StringGrid.ColWidths[0] := cProdWidth; 
    StringGrid.Cells[1, 1] := 'Product'; 
    StringGrid.Cells[2, 1] := 'Count'; 
    StringGrid.ColWidths[2] := cCountWidth; 
    StringGrid.Cells[3, 1] := 'Weight %'; 
    StringGrid.ColWidths[3] := cWeightWidth; 
    StringGrid.Cells[4, 1] := 'Product'; 
    StringGrid.Cells[5, 1] := 'Count'; 
    StringGrid.ColWidths[5] := cCountWidth; 
    StringGrid.Cells[6, 1] := 'Weight %'; 
    StringGrid.ColWidths[6] := cWeightWidth; 
    StringGrid.Cells[7, 1] := 'Product'; 
    StringGrid.Cells[8, 1] := 'Count'; 
    StringGrid.ColWidths[8] := cCountWidth; 
    StringGrid.Cells[9, 1] := 'Weight %'; 
    StringGrid.ColWidths[9] := cWeightWidth; 
    StringGrid.Invalidate; 
end; 

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); 
var 
    CellText: String; 
begin 
    if (ACol > 0) 
    then begin 
      CellText := StringGrid.Cells[ACol, ARow]; 
      if ((ARow = 0) and (ACol in [1, 4, 7])) 
      then begin 
        // Attempt to merge 3 cells into one 
        Rect.Right := StringGrid.ColWidths[ACol] + StringGrid.ColWidths[ACol + 1] + StringGrid.ColWidths[ACol + 2]; 
        StringGrid.Canvas.Brush.Color := clWindow; 
        StringGrid.Canvas.Brush.Style := bsSolid; 
        StringGrid.Canvas.Pen.Style := psClear; 
        StringGrid.Canvas.FillRect(rect); 
        DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); 
       end; 
      if (ACol in [1,2,3,7,8,9]) 
      then begin 
        StringGrid.Canvas.Brush.Color := clWebLinen; 
        StringGrid.Canvas.FillRect(Rect); 
       end 
      else StringGrid.Canvas.Brush.Color := clWindow; 
      if (ARow > 0) 
      then StringGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top, CellText); 
     end; 
end; 

end. 

a to mój zawartość pliku unit1.dfm.

object Form1: TForm1 
    Left = 0 
    Top = 0 
    Caption = 'Form1' 
    ClientHeight = 371 
    ClientWidth = 606 
    Color = clBtnFace  
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCreate = FormCreate 
    PixelsPerInch = 96 
    TextHeight = 13 
    object StringGrid: TStringGrid 
    Left = 0 
    Top = 0 
    Width = 606 
    Height = 371 
    Align = alClient 
    ColCount = 1 
    FixedCols = 0 
    RowCount = 1 
    FixedRows = 0 
    TabOrder = 0 
    OnDrawCell = StringGridDrawCell 
    ExplicitLeft = 160 
    ExplicitTop = 88 
    ExplicitWidth = 320 
    ExplicitHeight = 120 
    end 
end 

Problem wydaje się być z kodem wtopienie się w StringGridDrawCell tuż poniżej komentarzu //Attempt to merge 3 cells into one.

Jestem pewna, że ​​to chyba coś oczywistego, ale w moim życiu tego nie widzę.

UWAGA: Jeśli ktoś mógłby zamienić linki w osadzone obrazy, które byłyby mile widziane, ponieważ nie mam wystarczającej reputacji, aby publikować obrazy.

Answer 1

Spróbuj tego:

unit Unit1; 

interface 

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

type 
    TForm1 = class(TForm) 
    StringGrid: TStringGrid; 
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; 
     Rect: TRect; State: TGridDrawState); 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
const 
    cProdWidth = 70; 
    cCountWidth = 45; 
    cWeightWidth = 55; 
    cNoSelection: TGridRect = (Left: -1; Top: -1; Right: -1; Bottom: -1); 
begin 
    StringGrid.ColCount := 10; 
    StringGrid.RowCount := 3; 
    StringGrid.FixedRows := 2; 

    StringGrid.RowHeights[0] := StringGrid.Canvas.TextHeight('Shoulder') + 4; 
    StringGrid.RowHeights[1] := (StringGrid.Canvas.TextHeight('Carcass Product') + 4) * 2; 

    StringGrid.ColWidths[0] := cProdWidth; 
    StringGrid.ColWidths[1] := cProdWidth; 
    StringGrid.ColWidths[2] := cCountWidth; 
    StringGrid.ColWidths[3] := cWeightWidth; 
    StringGrid.ColWidths[4] := cProdWidth; 
    StringGrid.ColWidths[5] := cCountWidth; 
    StringGrid.ColWidths[6] := cWeightWidth; 
    StringGrid.ColWidths[7] := cProdWidth; 
    StringGrid.ColWidths[8] := cCountWidth; 
    StringGrid.ColWidths[9] := cWeightWidth; 

    StringGrid.Cells[1, 0] := 'Shoulder'; 
    StringGrid.Cells[4, 0] := 'Barrel'; 
    StringGrid.Cells[7, 0] := 'Leg'; 

    StringGrid.Cells[0, 1] := 'Carcass'#10'Product'; 
    StringGrid.Cells[1, 1] := 'Product'; 
    StringGrid.Cells[2, 1] := 'Count'; 
    StringGrid.Cells[3, 1] := 'Weight %'; 
    StringGrid.Cells[4, 1] := 'Product'; 
    StringGrid.Cells[5, 1] := 'Count'; 
    StringGrid.Cells[6, 1] := 'Weight %'; 
    StringGrid.Cells[7, 1] := 'Product'; 
    StringGrid.Cells[8, 1] := 'Count'; 
    StringGrid.Cells[9, 1] := 'Weight %'; 

    StringGrid.Cells[0, 2] := '22-110'; 
    StringGrid.Cells[1, 2] := '22-120'; 
    StringGrid.Cells[2, 2] := '2'; 
    StringGrid.Cells[3, 2] := '35'; 
    StringGrid.Cells[4, 2] := '22-130'; 
    StringGrid.Cells[5, 2] := '1'; 
    StringGrid.Cells[6, 2] := '25'; 
    StringGrid.Cells[7, 2] := '22-140'; 
    StringGrid.Cells[8, 2] := '2'; 
    StringGrid.Cells[9, 2] := '40'; 

    StringGrid.Selection := cNoSelection; 
    StringGrid.Invalidate; 
end; 

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; 
    Rect: TRect; State: TGridDrawState); 
var 
    CellText: String; 
begin 
    Rect := StringGrid.CellRect(ACol, ARow); 

    if ARow = 0 then 
    begin 
    case ACol of 
     1, 4, 7: begin 
     Rect.Right := Rect.Right + StringGrid.GridLineWidth; 
     end; 
     2, 5, 8: begin 
     Rect.Left := Rect.Left - StringGrid.GridLineWidth; 
     Rect.Right := Rect.Right + StringGrid.GridLineWidth; 
     end; 
     3, 6, 9: begin 
     Rect.Left := Rect.Left - StringGrid.GridLineWidth; 
     end; 
    end; 
    case ACol of 
     0, 4..6: begin 
     StringGrid.Canvas.Brush.Color := clWindow; 
     end; 
     1..3, 7..9: begin 
     StringGrid.Canvas.Brush.Color := clWebLinen; 
     end; 
    end; 
    end else 
    begin 
    if (State * [gdSelected, gdRowSelected]) <> [] then 
     StringGrid.Canvas.Brush.Color := clHighlight 
    else 
     StringGrid.Canvas.Brush.Color := clWindow; 
    end; 

    StringGrid.Canvas.Brush.Style := bsSolid; 
    StringGrid.Canvas.Pen.Style := psClear; 
    StringGrid.Canvas.FillRect(Rect); 

    StringGrid.Canvas.Brush.Style := bsClear; 
    StringGrid.Canvas.Pen.Style := psSolid; 
    StringGrid.Canvas.Pen.Color := clWindowText; 

    if ARow = 0 then 
    begin 
    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top); 
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Top); 

    case ACol of 
     0, 1, 4, 7: begin 
     StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top); 
     StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom); 
     end; 
    end; 

    if ACol = 9 then 
    begin 
     StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top); 
     StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom); 
    end; 

    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom); 
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Bottom); 
    end 
    else if ARow = 1 then 
    begin 
    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top); 
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Top); 

    case ACol of 
     1..9: begin 
     StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top); 
     StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom); 
     end; 
    end; 

    if ACol = 9 then 
    begin 
     StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top); 
     StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom); 
    end; 

    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom-1); 
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Bottom-1); 
    end 
    else begin 
    case ACol of 
     1..9: begin 
     StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top); 
     StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom); 
     end; 
    end; 

    if ACol = 9 then 
    begin 
     StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top); 
     StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom); 
    end; 
    end; 

    if (State * [gdSelected, gdRowSelected]) <> [] then 
    begin 
    StringGrid.Canvas.Brush.Color := clHighlight; 
    StringGrid.Canvas.Font.Color := clHighlightText; 
    end else 
    begin 
    StringGrid.Canvas.Brush.Color := clWindow; 
    StringGrid.Canvas.Font.Color := clWindowText; 
    end; 
    StringGrid.Canvas.Brush.Style := bsClear; 

    if ARow = 0 then 
    begin 
    case ACol of 
     1..3: begin 
     Rect.TopLeft := StringGrid.CellRect(1, 0).TopLeft; 
     Rect.BottomRight := StringGrid.CellRect(3, 0).BottomRight; 
     CellText := StringGrid.Cells[1, 0]; 
     end; 
     4..6: begin 
     Rect.TopLeft := StringGrid.CellRect(4, 0).TopLeft; 
     Rect.BottomRight := StringGrid.CellRect(6, 0).BottomRight; 
     CellText := StringGrid.Cells[4, 0]; 
     end; 
     7..9: begin 
     Rect.TopLeft := StringGrid.CellRect(7, 0).TopLeft; 
     Rect.BottomRight := StringGrid.CellRect(9, 0).BottomRight; 
     CellText := StringGrid.Cells[7, 0]; 
     end; 
    end; 

    Rect.Inflate(-2, -2); 
    DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS); 
    end 
    else if ARow = 1 then 
    begin 
    CellText := StringGrid.Cells[ACol, ARow]; 
    Rect.Inflate(-2, -2); 
    if ACol = 0 then 
     DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_WORDBREAK or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS) 
    else 
     DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_BOTTOM or DT_END_ELLIPSIS); 
    end 
    else begin 
    CellText := StringGrid.Cells[ACol, ARow]; 
    Rect.Inflate(-2, -2); 
    case ACol of 
     0..1, 4, 7: begin 
     DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); 
     end; 
     2..3, 5..6, 8..9: begin 
     DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_RIGHT or DT_VCENTER or DT_END_ELLIPSIS); 
     end; 
    end; 
    end; 
end; 

end. 

object Form1: TForm1 
    Left = 0 
    Top = 0 
    Caption = 'Form1' 
    ClientHeight = 371 
    ClientWidth = 606 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCreate = FormCreate 
    PixelsPerInch = 96 
    TextHeight = 13 
    object StringGrid: TStringGrid 
    Left = 0 
    Top = 0 
    Width = 606 
    Height = 371 
    Align = alClient 
    ColCount = 1 
    FixedCols = 0 
    RowCount = 1 
    FixedRows = 0 
    Options = [goRangeSelect, goRowSelect] 
    TabOrder = 0 
    OnDrawCell = StringGridDrawCell 
    end 
end 

Answer 2

Istnieją inne elementy StringGrid zdolne do łączenia komórek. Na przykład, this one których pisałem sam (pobierz źródła: NLDStringGrid + NLDSparseList) z możliwie tego wyniku:

var 
    R: TRect; 
begin 
    NLDStringGrid1.Columns.Add; 
    NLDStringGrid1.Columns.Add; 
    NLDStringGrid1.Cells[1, 1] := 'Sample test'#13#10'Second line'; 
    NLDStringGrid1.Columns[1].MultiLine := True; 
    NLDStringGrid1.AutoRowHeights := True; 
    SetRect(R, 2, 2, 3, 3); 
    NLDStringGrid1.MergeCells(TGridRect(R), True, True); 
    NLDStringGrid1.ColWidths[2] := 40; 
    NLDStringGrid1.Cells[2, 2] := 'Sample test'#13#10'Second line'; 
end; 

Answer 3

Głównym problemem jest to, że następujący fragment kodu, który rysuje tło komórki z clWebLinen kolor jest zawsze uruchamiany po kodzie, który scala komórkę.

if (ACol in [1,2,3,7,8,9]) 
    then begin 
     StringGrid.Canvas.Brush.Color := clWebLinen; 
     StringGrid.Canvas.FillRect(Rect); 
     end; 

Nie działa ten kod na komórki mają być połączone, wraz z uruchomieniem kodu seryjnej dla każdej komórki w seryjnej (np. 1,2,3. Nie tylko 1) rozwiązuje większość problemów.

Ostatni fragment wyśrodkowuje tekst w scalonych komórkach, co można osiągnąć, zmieniając DT_LEFT na DT_CENTER.

DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS); 

Poniżej znajduje się pełne rozwiązanie.

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); 
const 
    cGridLineWidth = 1; 
    cGroupCount = 3; 
var 
    CellText: String;  
    ProdCol: Integer; 
    CountCol: Integer; 
    WeightCol: Integer; 
    Found: Boolean; 
begin 
    if ((ARow = 0) and (ACol > 0)) 
    then begin 
      ProdCol := 1; 
      CountCol := 2; 
      WeightCol := 3; 
      Found := False; 
      while (not Found) do 
      begin 
       if ((ACol = ProdCol) or (ACol = CountCol) or (ACol = WeightCol)) 
       then begin 
         Found := True; 
         if (ACol = ProdCol) 
         then begin 
           Rect.Right := Rect.Right + StringGrid.ColWidths[CountCol] + cGridLineWidth + StringGrid.ColWidths[WeightCol] + cGridLineWidth; 
          end 
         else if (ACol = CountCol) 
         then begin 
           Rect.Right := Rect.Right + StringGrid.ColWidths[WeightCol] + cGridLineWidth; 
           Rect.Left := Rect.Left - cGridLineWidth - StringGrid.ColWidths[ProdCol]; 
          end 
         else begin 
           Rect.Left := Rect.Left - cGridLineWidth - StringGrid.ColWidths[CountCol] - cGridLineWidth - StringGrid.ColWidths[ProdCol]; 
          end; 
         CellText := StringGrid.Cells[ProdCol, ARow]; 
         if (ACol in [1,2,3,7,8,9]) 
         then StringGrid.Canvas.Brush.Color := clWebLinen 
         else StringGrid.Canvas.Brush.Color := clWindow; 
         StringGrid.Canvas.Brush.Style := bsSolid; 
         StringGrid.Canvas.Pen.Style := psClear; 
         StringGrid.Canvas.FillRect(rect); 
         StringGrid.Canvas.Pen.Style := psSolid; 
         DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS); 
        end; 
       ProdCol := ProdCol + cGroupCount; 
       CountCol := CountCol + cGroupCount; 
       WeightCol := WeightCol + cGroupCount; 
      end; 
     end 
    else begin 
      CellText := StringGrid.Cells[ACol, ARow]; 
      if (ACol in [1,2,3,7,8,9]) 
      then StringGrid.Canvas.Brush.Color := clWebLinen 
      else StringGrid.Canvas.Brush.Color := clWindow; 
      if (ARow = 0) 
      then Exit; 
      StringGrid.Canvas.FillRect(Rect); 
      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER); 
     end; 
end;