1 unit mainform;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
9   Grids, mcGrid;
10 
11 type
12   { TForm1 }
13 
14   TForm1 = class(TForm)
15     ImageList1: TImageList;
16     procedure FormCreate(Sender: TObject);
17   private
18     Grid: TMCStringGrid;
19     procedure DrawCellTextHandler(Sender: TObject; ACol, ARow: Integer;
20       ARect: TRect; AState: TGridDrawState; AText: String; var Handled: Boolean);
21     procedure MergeCellsHandler(Sender: TObject; ACol, ARow: Integer;
22       var ALeft, ATop, ARight, ABottom: Integer);
23 
24   public
25 
26   end;
27 
28 var
29   Form1: TForm1;
30 
31 implementation
32 
33 {$R *.lfm}
34 
35 { TForm1 }
36 
37 procedure TForm1.FormCreate(Sender: TObject);
38 begin
39   // Create an instance of TStringGridEx at runtime for testing
40   Grid := TMCStringGrid.Create(Self);
41   Grid.Parent := self;
42   Grid.Align := alClient;
43   Grid.RowCount := 20;
44   Grid.ColCount := 10;
45   Grid.Cells[1, 0] := 'Merged';
46   Grid.Cells[3, 0] := 'Single';
47   Grid.Cells[1, 1] := 'combined';
48   Grid.Cells[3, 1] := 'abc';
49   Grid.Cells[4, 1] := 'bold';
50   Grid.Cells[5, 1] := 'Image';
51   Grid.Cells[2, 7] := 'Image';
52   Grid.Cells[2, 3] := 'This is a long text' + LineEnding + 'with line break.';
53   Grid.Cells[0, 2] := 'Vertical text';
54   Grid.Cells[0, 6] := 'Centered';
55   Grid.OnDrawCellText := @DrawCellTextHandler;
56   Grid.OnMergeCells := @MergeCellsHandler;
57   Grid.Options := Grid.Options + [goColSpanning, goEditing, goDrawFocusSelected];
58   if Grid.DefaultRowHeight < ImageList1.Height + 4 then
59     Grid.DefaultRowHeight := ImageList1.Height + 4
60 end;
61 
62 { This event handler takes care of painting the cell text. Normally it is not
63   needed for merged cells, but it implements here vertical text direction,
64   line breaks etc. }
65 procedure TForm1.DrawCellTextHandler(Sender: TObject; ACol, ARow: Integer;
66   ARect: TRect; AState: TGridDrawState; AText: String; var Handled: Boolean);
67 var
68   ts: TTextStyle;
69   x, y: Integer;
70   w, h, ppi: Integer;
71 begin
72   Handled := True;
73   if (ACol in [2..4]) and (ARow in [3..5]) then
74   begin
75     // Word-wrapped text
76     ts := Grid.Canvas.TextStyle;
77     ts.SingleLine := false;
78     ts.Wordbreak := true;
79     x := ARect.Left + varCellPadding;
80     y := ARect.Top + varCellPadding;
81     Grid.Canvas.TextRect(ARect, x, y, AText, ts);
82   end else
83   if (ACol = 0) and (ARow in [2..5]) then
84   begin
85     // Vertical text
86     Grid.Canvas.Font.Orientation := 900;
87     x := (ARect.Left + ARect.Right - Grid.Canvas.TextHeight('Tg')) div 2;
88     y := ARect.Bottom - varCellPadding;
89     Grid.Canvas.TextOut(x, y, AText);
90     Grid.Canvas.Font.Orientation := 0;
91   end else
92   if (ACol = 0) and (ARow = 6) then
93   begin
94     // Centered text
95     ts := Grid.Canvas.TextStyle;
96     ts.Alignment := taCenter;
97     ts.Layout := tlCenter;
98     x := 0;  // is ignored for centered Alignment ...
99     y := 0;  // ... and Layout
100     Grid.Canvas.TextRect(ARect, x, y, AText, ts);
101   end else
102   if (ACol = 4) and (ARow = 1) then
103   begin
104     // Bold text
105     Grid.Canvas.Font.Style := [fsBold];
106     x := ARect.Left + varCellPadding;
107     y := ARect.Top + varCellPadding;
108     Grid.Canvas.TextOut(x, y, AText);
109     Grid.Canvas.Font.Style := [];
110   end else
111   if (ACol = 5) and (ARow = 1) then
112   begin
113     // Cell with image
114     ppi := Grid.Font.PixelsPerInch;
115     w := ImageList1.WidthForPPI[ImageList1.Width, ppi];
116     h := ImageList1.HeightForPPI[ImageList1.Height, ppi];
117     x := ARect.left + varCellPadding;
118     y := (ARect.Top + ARect.Bottom - h) div 2;
119     ImageList1.DrawForPPI(Grid.Canvas, x, y, 0, ImageList1.Width, ppi, Grid.GetCanvasScaleFactor);
120     inc(x, w + varCellPadding);
121     y := (ARect.Top + ARect.Bottom - Grid.Canvas.TextHeight('Tg')) div 2;
122     Grid.Canvas.TextOut(x, y, AText);
123   end else
124     Handled := false;
125 end;
126 
127 { This is the event handler defining the merged block. In this example we
128   assume that the cells defined by columns 2..3 and rows 3..5 are will be merged }
129 procedure TForm1.MergeCellsHandler(Sender: TObject; ACol, ARow: Integer;
130   var ALeft, ATop, ARight, ABottom: Integer);
131 begin
132   // Define a merged block which is a single row heigh
133   if (ACol in [1..2]) and (ARow = 1) then begin
134     ALeft := 1;
135     ARight := 2;
136   end else
137   // Define a merged block covering several columns and rows (for the word-wrap text)
138   if (ACol in [2..3]) and (ARow in [3..5]) then begin
139     ALeft := 2;
140     ARight := 3;
141     Atop := 3;
142     ABottom := 5;
143   end;
144   // Define a merged block in the column headers
145   if (ACol in [1..2]) and (ARow = 0) then begin
146     ALeft := 1;
147     ARight := 2;
148   end else
149   // Define a merged block in the row headers (for the vertical text)
150   if (ACol = 0) and (ARow in [2..5]) then begin
151     ATop := 2;
152     ABottom := 5;
153   end else
154   // Merge the next two cells adjacent to cell with text 'Image'
155   if (ACol > 1) and (Grid.Cells[ACol-1, ARow] = 'Image') then begin
156     ALeft := ACol;
157     ARight := ALeft + 1;
158   end else
159   if (ACol > 2) and (Grid.Cells[ACol-2, ARow] = 'Image') then begin
160     ALeft := ACol - 1;
161     ARight := ALeft + 1;
162   end;
163 end;
164 
165 end.
166 
167