Recent

Author Topic: [Solved] TDrawGrid gdPushed not working  (Read 1422 times)

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
[Solved] TDrawGrid gdPushed not working
« on: January 19, 2018, 07:02:26 pm »
Hi, attached is this code using TDrawGrid, I want to change the color (bgc: TColor) to clGray when the cell is pushed (mouse down).

Code: Pascal  [Select][+][-]
  1.   if gdPushed in aState then
  2.     bgc := clGray;    

Mouse over (gdHot) is working fine as you can test, but pushed is not working.

Maybe I'm missing a setting or two. All the settings are set by code, I'm not using the object inspector.

Thanks.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, Math, Types;
  9.  
  10. const
  11.   PANEL_BUTTON_WIDTH = 100;
  12.   PANEL_BUTTON_HEIGHT = 65;
  13.   PANEL_MIN_COLS = 4;
  14.   PANEL_MIN_ROWS = 3;
  15.  
  16. type
  17.  
  18.   { TForm1 }
  19.  
  20.   TForm1 = class(TForm)
  21.     DrawGrid1: TDrawGrid;
  22.     procedure DrawGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
  23.       aRect: TRect; aState: TGridDrawState);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure FormResize(Sender: TObject);
  26.   private
  27.  
  28.   public
  29.  
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.  
  35. implementation
  36.  
  37. {$R *.lfm}
  38.  
  39. { TForm1 }
  40.  
  41. procedure TForm1.FormResize(Sender: TObject);
  42. begin
  43.   DrawGrid1.ColCount := Max(Width div PANEL_BUTTON_WIDTH, PANEL_MIN_COLS);
  44.   DrawGrid1.RowCount := Max(Height div PANEL_BUTTON_HEIGHT, PANEL_MIN_ROWS);
  45. end;
  46.  
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. begin
  49.   DrawGrid1.HeaderHotZones := [gzNormal];
  50.   DrawGrid1.HeaderPushZones := [gzNormal];
  51.   DrawGrid1.Options := [goHeaderPushedLook, goHeaderHotTracking];
  52.   DrawGrid1.DefaultDrawing := False;
  53.   DrawGrid1.BorderStyle := bsNone;
  54.   DrawGrid1.FixedCols := 0;
  55.   DrawGrid1.FixedRows := 0;
  56.   DrawGrid1.GridLineWidth := 0;
  57.   DrawGrid1.DefaultColWidth := PANEL_BUTTON_WIDTH;
  58.   DrawGrid1.DefaultRowHeight := PANEL_BUTTON_HEIGHT;
  59. end;
  60.  
  61. procedure TForm1.DrawGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
  62.   aRect: TRect; aState: TGridDrawState);
  63. var
  64.   bgc: TColor;
  65.   grid_canvas: TCanvas;
  66. begin
  67.   grid_canvas := TDrawGrid(Sender).Canvas;
  68.  
  69.   if gdHot in aState then
  70.     bgc := clGreen
  71.   else
  72.     bgc := clMoneyGreen;
  73.  
  74.   if (aRow = 0) then
  75.   begin
  76.     if gdHot in aState then
  77.       bgc := clBlue
  78.     else
  79.       bgc := clSkyBlue;
  80.   end;
  81.  
  82.   if gdPushed in aState then
  83.     bgc := clGray;
  84.  
  85.   grid_canvas.Brush.Color := clWhite;
  86.   grid_canvas.FillRect(ARect);
  87.   grid_canvas.Brush.Color := bgc;
  88.   grid_canvas.FillRect(ARect.Left + 4, ARect.Top + 4, ARect.Right - 4, ARect.Bottom - 4);
  89. end;
  90.  
  91. end.        
« Last Edit: January 19, 2018, 07:50:31 pm by lainz »

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: TDrawGrid gdPushed not working
« Reply #1 on: January 19, 2018, 07:32:23 pm »
gdPushed is related to header cells only. You set FixedRows := 0 therefore you don't see it. Try set it to 1 and the top row will be gray on click.
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: TDrawGrid gdPushed not working
« Reply #2 on: January 19, 2018, 07:41:59 pm »
gdPushed is related to header cells only. You set FixedRows := 0 therefore you don't see it. Try set it to 1 and the top row will be gray on click.

Hi, well I set it to 1 and did not work.

Is strange because there is a setting for that, not only the headers:

Code: Pascal  [Select][+][-]
  1. DrawGrid1.HeaderHotZones := [gzNormal];
  2. DrawGrid1.HeaderPushZones := [gzNormal];
  3. DrawGrid1.Options := [goHeaderPushedLook, goHeaderHotTracking];

Is the same setting for push and hot.

Hot works and Push does not.

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: TDrawGrid gdPushed not working
« Reply #3 on: January 19, 2018, 07:50:11 pm »
"Fixed", is not as it should work according to the provided settings as I explained in my message above, but I don't have a reason to fill a bug in the bugtracker.

Adding this line OnResize (preventing errors when changing fixed rows):
Code: Pascal  [Select][+][-]
  1. ...
  2.   r := Max(Height div PANEL_BUTTON_HEIGHT, PANEL_MIN_ROWS);
  3.   if (r > DrawGrid1.FixedRows) then
  4.   begin
  5.     DrawGrid1.RowCount := r;
  6.     DrawGrid1.FixedRows := r;
  7.   end
  8.   else
  9.   begin
  10.     DrawGrid1.FixedRows := r;
  11.     DrawGrid1.RowCount := r;
  12.   end;
  13. ...

And removing this line:
Code: Pascal  [Select][+][-]
  1. ...
  2. //DrawGrid1.HeaderPushZones := [gzNormal];
  3. ...
« Last Edit: January 19, 2018, 07:54:15 pm by lainz »

 

TinyPortal © 2005-2018