custom cell paint

FNC TMS FNC UI Pack
1

I would like to know if is it possible to insert a custom component in a cell of the TMSFNCgrid.

I have a component descenting from tcustomcomponent, is ti possible, and how to, display my own component in a cell?

Thank you,
Andrea
2

I forgot ot mention:

Lazarus 1.6.2 FPC 3.0.0
3

Hi, 


Sorry this is not possible, the grid only allows painting. There is currently no way to add interactive controls.
4

Ok thanks.

So is it possible to overload the painting method?
My own control should paint the cell taking into account the cell text.
How can I use my TOwnControl.Canvas and TMyOwnControl.Paint method inside tmsfncgrid?

5

Hi, 


Yes, you can return a custom cell class by overriding from TTMSFMXGridCell. then you can override the Draw method and use the AGraphics parameter to paint anything you like.

type
  TMyGridCell = class(TTMSFNCGridCell)
    procedure Draw(AGraphics: TTMSFNCGraphics; ADrawText: Boolean; ADrawBackGround: Boolean; ADrawBorder: Boolean); override;
  end;

procedure TForm2.TMSFNCGrid1GetCellClass(Sender: TObject; ACol, ARow: Integer;
  var CellClassType: TTMSFNCGridCellClass);
begin
  CellClassType := TMyGridCell;
end;

6

I tried but accessing AGraphics all the grid is painted out, not the single cell.

Below a small code sample.


procedure TMyGridCell.Draw(AGraphics: TTMSFNCGraphics; ADrawText: Boolean;
  ADrawBackGround: Boolean; ADrawBorder: Boolean);
var
  myDrawer: TMSDrawer;
begin
  myDrawer := TMSDrawer.Create();
  myDrawer.Width := AGraphics.Canvas.Width;
  myDrawer.Height := AGraphics.Canvas.Height;
  myDrawer.Draw(AGraphics.Canvas); // it draws on canvas
  inherited Draw(AGraphics, False, False, False);  
end;

all the grid (except fixed rows and columns) is painted out. I would like to paint a single cell separately.
What I am doing wrong?
7

You only need to return TMyGridCell for the cell you wish to custom paint.

the above code is returning a TMyGridCell for all cells.

procedure TForm1.TMSFNCGrid1GetCellClass(Sender: TObject; ACol, ARow: Integer;
  var CellClassType: TTMSFNCGridCellClass);
begin
  if (ACol = 3) and (ARow = 4) then
    CellClassType := TMyGridCell;
end;

8
Sorry, I forgot to mention but I did it

procedure TForm1.TMSFNCGrid1GetCellClass(Sender: TObject; ACol, ARow: Integer;
  var CellClassType: TTMSFNCGridCellClass);
begin
  if ACol = 1 then
    CellClassType := TMyGridCell;
end;

9

Can you post the full sample code you have meanwhile setup so we can investigate here what exactly is going wrong?

10
I cannot upload the full source, but here a sample that behave the same.
In this demo I am simply drwaing on AGraphics.Canvas

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  LCLTMSFNCGrid, LCLTMSFNCGridCell, LCLTMSFNCGraphics, LCLTMSFNCCustomGrid;

type

  { TForm1 }

  TForm1 = class(TForm)
    TMSFNCGrid1: TTMSFNCGrid;
    procedure TMSFNCGrid1GetCellClass(Sender: TObject; ACol, ARow: Integer;
      var CellClassType: TTMSFNCGridCellClass);
  private
    { private declarations }
  public
    { public declarations }
  end;

  { TMyGridCell }

  TMyGridCell = class(TTMSFNCGridCell)
     procedure Draw(AGraphics: TTMSFNCGraphics; ADrawText: Boolean; ADrawBackGround: Boolean; ADrawBorder: Boolean); override;
   end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.TMSFNCGrid1GetCellClass(Sender: TObject; ACol, ARow: Integer;
  var CellClassType: TTMSFNCGridCellClass);
begin
  if ACol = 1 then
    CellClassType:= TMyGridCell;
end;

{ TMyGridCell }

procedure TMyGridCell.Draw(AGraphics: TTMSFNCGraphics; ADrawText: Boolean;
  ADrawBackGround: Boolean; ADrawBorder: Boolean);
begin
  with AGraphics do
  begin
    Canvas.Line(0,0, Canvas.Width,Canvas.Height);
    Canvas.Line(0,Canvas.height,Canvas.width,0);
  end;
  inherited Draw(AGraphics, ADrawText, ADrawBackGround, ADrawBorder);
end;

end.

11

Hi, 


The coordinates for drawing are relative to the top, left coordinates of the grid. Also, you should use the AGraphics drawing functionality instead of using the canvas.

procedure TMyGridCell.Draw(AGraphics: TTMSFNCGraphics; ADrawText,
  ADrawBackGround, ADrawBorder: Boolean);
begin
  inherited;
  AGraphics.Stroke.Color := gcRed;
  AGraphics.Stroke.Kind := gskSolid;
  AGraphics.DrawLine(PointF(Left, Top), PointF(Left + Width, Top + Height));
end;

12

I already have a n object that draws what I need.

It can draw a canvas or eventually give a bitmap as result of a function.
I don't want to use AGraphics drawing functionalities but I woul like to use my custom drawer.
Any suggestion?


13

If you first call inherited Draw... and then call your drawing functionality using the Canvas, does it then work?

14
Like below? (Anyway same behaviour, a cross all over the grid)

procedure TMyGridCell.Draw(AGraphics: TTMSFNCGraphics; ADrawText: Boolean;
  ADrawBackGround: Boolean; ADrawBorder: Boolean);
begin
  inherited Draw(AGraphics, ADrawText, ADrawBackGround, ADrawBorder);
  with AGraphics do
  begin
    Canvas.Line(0,0, Canvas.Width,Canvas.Height);
    Canvas.Line(0,Canvas.height,Canvas.width,0);
  end;
end; 
15

As already explained, the coordinates (0, 0) are based on the grid and not on the grid cell. You can use the following code that should paint a line inside the grid cell:



procedure TMyGridCell.Draw(AGraphics: TTMSFNCGraphics; ADrawText: Boolean;
  ADrawBackGround: Boolean; ADrawBorder: Boolean);
begin
  inherited Draw(AGraphics, ADrawText, ADrawBackGround, ADrawBorder);
  with AGraphics do
  begin
    Canvas.Line(Left,Top, Left + Width,Left + Height);
    Canvas.Line(Left,Top + Height,Left + Width,Top);
  end;
16

Ok, in this way I can get a cross in every cell.

The only difference is that lazarus needs integer to be passed to Canvas.Line.

  inherited Draw(AGraphics, ADrawText, ADrawBackGround, ADrawBorder);
   with AGraphics do
   begin
     Canvas.Line(Trunc(Left),Trunc(Top), Trunc(Left + Width),Trunc(Top + Height));
     Canvas.Line(Trunc(Left),Trunc(Top + Height),Trunc(Left + Width),Trunc(Top));
   end; 

I will work on it.
Thank you.