(SOLVED) StringGrid merge cell example problem

[xinyiman]

Hi guys, I took the example of lazarus to understand how to merge cells in lazarus. And I tried to modify it a bit for my needs.

If you execute the attachment you will see that in column 12 and in row 13 there is a merge of a cell, but the text does not appear correctly on all merge, but only in cell [12,13]

If you open the file mcgrid.pas you will see that I put the text in the function DrawCell and I'm interested in setting the text so because I have to make custom cells.

Who explains where I'm wrong?

[wp]

The demo in the examples folder is based upon the almost unused grid option, goColSpanning. If set, the method DefaultDrawCell calls CalcCellExtent which is empty in the standard CustomDrawGrid, but fires the event OnMergeCells of the demo. CalcCellExtend defines the size of a cell - this size is used in all subsequent drawing commands.

DefaultDraw is called from the grid's DrawCell. But you override this method without calling the inherited method. Therefore, your cells cannot be merged.

I don't know what you want to achieve. If you want to merge some predefined cells you must override  CalcCellExtent.

[xinyiman]

Sorry, but I did not understand, I overridden the method. In fact, the cells unites them, but I can not make them see the text as I want. Look at the mcgrid.pas file and you will see that the override is there. Other ideas? Otherwise if you can make the example work, tell me what you have changed or attach the example so I understand.

I forgot to mention that I'm doing the tests on carbon widgets.

[wp]

Ah, I did not look carefully enough - you DID call inherited, sorry.

One problem is still that DrawCell is too early: DrawCell calls DefaultDrawCell, DefaultDrawCell calls CalcCellExtent. Because DefaultDrawCell does not have the rect as a var parameter DrawCell does not get to know that the rectangle has been changed. You must call CalcCellExtent again before painting your special cell text. Or you stuff your code into the method DrawTextCell method which has the correct rectangle size as a parameter.

The other problem is that that this will draw only the top/left cell. At first I thought this is due to clipping. But no: the rest of the merged cell block is successively over-painted when the other cells of the block are drawn. The code in the example project is not very efficient, it avoids this issue by simply drawing the same cell in tiles again and again. You inhibited this by checking only the top/left cell indexes - if you extend this to allow also the other cells of the merged block your code will work:

Now tested:

Code: Pascal  [Select][+][-]

1. procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
2.   aState: TGridDrawState);
3. var
4.   appStyle : TTextStyle;
5. begin
6.   inherited DrawCell(aCol, aRow, aRect, aState);
7.  
8.   if (aCol in [12..13]) and (aRow in [13..15]) then  // <-- CHANGED: allow all cells within merged block
9.   begin
10.         appStyle := Canvas.TextStyle;
11.         appStyle.Wordbreak:=true;
12.         appStyle.SingleLine:=false;
13.         appStyle.Alignment:=taLeftJustify;
14.  
15.         Canvas.Font.Name := 'Courier New';
16.         Canvas.Font.Color := clBlack; //clSilver;
17.         Canvas.Font.Style := [];
18.         Canvas.Font.Height := 12;
19.  
20.         CalcCellExtent(aCol, aRow, aRect);   // <-- NEW: get total merged cell block rectangle
21.  
22.         Canvas.TextRect(aRect, aRect.Left + 4, aRect.Top, 'hello' + System.LineEnding + 'world' + System.LineEnding + 'My test' ,appStyle);
23.   end;
24.  
25. end;

[xinyiman]

Thank you. One more thing, if I change the text slightly by adding the line

appStyle.Layout: = tlTop; // <- ADDED

the text disappears. Why? Layout is vertical position? Correct?

Code: Pascal  [Select][+][-]

1.     procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
2.       aState: TGridDrawState);
3.     var
4.       appStyle : TTextStyle;
5.     begin
6.       inherited DrawCell(aCol, aRow, aRect, aState);
7.      
8.       if (aCol in [12..13]) and (aRow in [13..15]) then  
9.       begin
10.          appStyle := Canvas.TextStyle;
11.          appStyle.Wordbreak:=true;
12.          appStyle.SingleLine:=false;
13.          appStyle.Alignment:=taLeftJustify;
14.          appStyle.Layout:=tlTop; //<-- ADDED
15.      
16.             Canvas.Font.Name := 'Courier New';
17.             Canvas.Font.Color := clBlack; //clSilver;
18.             Canvas.Font.Style := [];
19.             Canvas.Font.Height := 12;
20.      
21.             CalcCellExtent(aCol, aRow, aRect);  
22.      
23.             Canvas.TextRect(aRect, aRect.Left + 4, aRect.Top, 'hello' + System.LineEnding + 'world' + System.LineEnding + 'My test' ,appStyle);
24.       end;
25.      
26.     end;
27.  
28.  
29.  
30.  

[wp]

Cannot confirm on Windows and Linux Mint with both gtk2 and qt. Maybe one more mac issue?

Please run the appended code (a simple form, about 500x300 pixels, with the following OnPaint handler):

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormPaint(Sender: TObject);
2.  
3.   procedure DrawAll(ACanvas: TCanvas; R: TRect; dx, dy: Integer; C: TColor);
4.   var
5.     ts: TTextStyle;
6.   begin
7.     with Canvas do begin
8.       Font.Color := C;
9.       ts := TextStyle;
10.       ts.Alignment := taLeftJustify;
11.         ts.Layout := tlTop;
12.         TextRect(R, R.Left+dx, R.Top+dy, 'Left/Top', ts);
13.         ts.Layout := tlCenter;
14.         TextRect(R, R.Left+dx, R.Top+dy, 'Left/Center', ts);
15.         ts.Layout := tlBottom;
16.         TextRect(R, R.Left+dx, R.Top+dy, 'Left/Bottom', ts);
17.  
18.       ts.Alignment := taCenter;
19.         ts.Layout := tlTop;
20.         TextRect(R, R.Left+dx, R.Top+dy, 'Center/Top', ts);
21.         ts.Layout := tlCenter;
22.         TextRect(R, R.Left+dx, R.Top+dy, 'Center/Center', ts);
23.         ts.Layout := tlBottom;
24.         TextRect(R, R.Left+dx, R.Top+dy, 'Center/Bottom', ts);
25.       ts.Alignment := taRightJustify;
26.         ts.Layout := tlTop;
27.         TextRect(R, R.Left+dx, R.Top+dy, 'Right/Top', ts);
28.         ts.Layout := tlCenter;
29.         TextRect(R, R.Left+dx, R.Top+dy, 'Right/Center', ts);
30.         ts.Layout := tlBottom;
31.         TextRect(R, R.Left+dx, R.Top+dy, 'Right/Bottom', ts);
32.     end;
33.   end;
34.  
35. var
36.   R: TRect;
37.  
38. begin
39.   R := Rect(0, 0, Width, Height);
40.   InflateRect(R, -Width div 8, -Height div 8);
41.   with Canvas do begin
42.     Brush.Color := clWhite;
43.     FillRect(R);
44.     DrawAll(Canvas, R, 0, 0, clBlack);
45.     //DrawAll(Canvas, R, 16, 16, clRed);
46.   end;
47. end;

A screenshot of the painted form on Windows is attached, on Linux I get the same.

BTW: I always wondered what the x,y parameters in the Canvas.TextRect procedure are doing. To see it uncomment the second DrawAll line in above code: x and y define the text anchor but only if Alignment is taLeftJustify and Layout is tlTop.

[xinyiman]

This is correct. But the problem is stringgrid canvas not form canvas

Cannot confirm on Windows and Linux Mint with both gtk2 and qt. Maybe one more mac issue?

Please run the appended code (a simple form, about 500x300 pixels, with the following OnPaint handler):

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormPaint(Sender: TObject);
2.  
3.   procedure DrawAll(ACanvas: TCanvas; R: TRect; dx, dy: Integer; C: TColor);
4.   var
5.     ts: TTextStyle;
6.   begin
7.     with Canvas do begin
8.       Font.Color := C;
9.       ts := TextStyle;
10.       ts.Alignment := taLeftJustify;
11.         ts.Layout := tlTop;
12.         TextRect(R, R.Left+dx, R.Top+dy, 'Left/Top', ts);
13.         ts.Layout := tlCenter;
14.         TextRect(R, R.Left+dx, R.Top+dy, 'Left/Center', ts);
15.         ts.Layout := tlBottom;
16.         TextRect(R, R.Left+dx, R.Top+dy, 'Left/Bottom', ts);
17.  
18.       ts.Alignment := taCenter;
19.         ts.Layout := tlTop;
20.         TextRect(R, R.Left+dx, R.Top+dy, 'Center/Top', ts);
21.         ts.Layout := tlCenter;
22.         TextRect(R, R.Left+dx, R.Top+dy, 'Center/Center', ts);
23.         ts.Layout := tlBottom;
24.         TextRect(R, R.Left+dx, R.Top+dy, 'Center/Bottom', ts);
25.       ts.Alignment := taRightJustify;
26.         ts.Layout := tlTop;
27.         TextRect(R, R.Left+dx, R.Top+dy, 'Right/Top', ts);
28.         ts.Layout := tlCenter;
29.         TextRect(R, R.Left+dx, R.Top+dy, 'Right/Center', ts);
30.         ts.Layout := tlBottom;
31.         TextRect(R, R.Left+dx, R.Top+dy, 'Right/Bottom', ts);
32.     end;
33.   end;
34.  
35. var
36.   R: TRect;
37.  
38. begin
39.   R := Rect(0, 0, Width, Height);
40.   InflateRect(R, -Width div 8, -Height div 8);
41.   with Canvas do begin
42.     Brush.Color := clWhite;
43.     FillRect(R);
44.     DrawAll(Canvas, R, 0, 0, clBlack);
45.     //DrawAll(Canvas, R, 16, 16, clRed);
46.   end;
47. end;

A screenshot of the painted form on Windows is attached, on Linux I get the same.

BTW: I always wondered what the x,y parameters in the Canvas.TextRect procedure are doing. To see it uncomment the second DrawAll line in above code: x and y define the text anchor but only if Alignment is taLeftJustify and Layout is tlTop.

[xinyiman]

appStyle.Layout: = tlTop; is a problem only in merged cell block.

[wp]

Seing your signature saying that you are using Laz 1.2.6 I compiled your demo with the Laz 1.2 which I still have on my disk - no issue here either. So, I don't know what you are doing wrong. TextStyle.Layout := tlTop definitely is working even in merged blocks.

[xinyiman]

Sorry, the signature is old and I forgot to change it.
I use version 1.8.0 of 2018-01-17 FPC version 3.0.4.
SVN Revision: 57048M
i386-darwin-carbon

[wp]

Please post again the exact project in which you are seing the Layout=tlTop issue. The only significant difference is that you are using darwin-carbon widgetset and I am using Win, gtk2 and qt.

[xinyiman]

This is my code. Comment the line

appStyle.Layout: = tlTop;

 and you will see that the text is seen correctly

[wp]

No issue here - see screenshot.

• What happens if you shift the text down a bit (use "aRect.Top + 4" instead of "aRect.Top" in Canvas.TextRect)?
• What happens if you turn off Clipping (add "appstyle.Clipping := false")?
• What happens if you use tlBottom and tlCenter?

[xinyiman]

With the top + 4 nothing changes.
With tlBottom and tlCenter it works and the text is seen.

If I use tlTop without appstyle.Clipping: = false does not work
however if I use tlTop with appstyle.Clipping: = false then it works fine.

Thank you so much wp you're an angel