Discussion :

[ZonZorg]

Petit probleme: j'ai une fiche avec un stringgrid contenant des boutons, dans un premier temps la barre vertical fonctionnait mal
j'ai trouvé en mettant un Stringgrid1TopLeftChanged dans mon stringgrid
mais ce que je ne comprend pas c'est pourquoi dans cette exemple la ligne entre accolades n'affiche pas correctement les boutons {R := StringGrid1.CellRect(ACol, ARow) ... {}
alors que la ligne R := StringGrid1.CellRect(ACol, 0); ... fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;
 
type
  TForm1 = class(TForm)
    Stringgrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Stringgrid1TopLeftChanged(Sender: TObject);
private
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
  FPrevTopRow: Integer;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  R: TRect;
  I,ACol,Arow: Integer;
  Bouton: TButton;
begin
   StringGrid1.RowCount:=14;
   FPrevTopRow := 0;
   for ACol := 0 to StringGrid1.colCount - 1 do
   begin
     R := StringGrid1.CellRect(ACol, 0); inc(R.Left,StringGrid1.GridLineWidth); inc(R.top,StringGrid1.GridLineWidth);
     for Arow := 0 to StringGrid1.RowCount - 1 do
     begin
{     R := StringGrid1.CellRect(ACol, arow); inc(R.Left,StringGrid1.GridLineWidth); inc(R.top,StringGrid1.GridLineWidth);{}
      Bouton := TButton.Create(StringGrid1);
      I:=Acol+arow*StringGrid1.colCount;
      Bouton.BoundsRect := R;
      Bouton.Top := R.Top;
      Bouton.Left := R.Left;
      Bouton.Height := R.Bottom - R.Top;
      Bouton.Width := R.Right - R.Left;
      Bouton.Caption:=format('[%u,%u]:%u]',[R.Left,R.top,I]);
      Bouton.Tag :=I;
//    Bouton.OnClick := Boutonclick;
      Bouton.Parent := StringGrid1;
//    StringGrid1.Objects[Acol,Arow] := Bouton;
      OffsetRect(R, 0, StringGrid1.DefaultRowHeight + StringGrid1.GridLineWidth);
     end;
  end;
end;
 
procedure TForm1.Stringgrid1TopLeftChanged(Sender: TObject);
var I: Integer;
  Shift: Integer;
  S:TStringGrid;
begin
  S:=(Sender as TStringGrid);
  Shift := (S.TopRow - FPrevTopRow) * (S.DefaultRowHeight + S.GridLineWidth);
  for I := 0 to S.ControlCount - 1 do S.Controls[I].Top := S.Controls[I].Top - Shift;
  FPrevTopRow := S.TopRow;
end;
 
end.

la fiche:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
object Form1: TForm1
  Left = 350
  Top = 110
  Width = 344
  Height = 154
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Stringgrid1: TStringGrid
    Left = 16
    Top = 16
    Width = 300
    Height = 85
    Color = clBtnFace
    ColCount = 3
    DefaultColWidth = 93
    DefaultRowHeight = 16
    FixedCols = 0
    RowCount = 14
    FixedRows = 0
    GridLineWidth = 0
    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking]
    ScrollBars = ssVertical
    TabOrder = 0
    OnTopLeftChanged = Stringgrid1TopLeftChanged
  end
end

j'aurai voulu faire ceci dans une seule boucle for i:=0 to StringGrid1.colCount*StringGrid1.rowCount-1; et R:= StringGrid1.CellRect(I mod StringGrid1.colCount,I div StringGrid1.colCount);

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
procedure TForm1.FormCreate(Sender: TObject);
var
  R: TRect;
  I,ACol,Arow: Integer;
  Bouton: TButton;
begin
   StringGrid1.RowCount:=14;
   FPrevTopRow := 0;
   for i:=0 to StringGrid1.colCount*StringGrid1.rowCount-1 do
   begin
   R:= StringGrid1.CellRect(I mod StringGrid1.colCount,I div StringGrid1.colCount); inc(R.Left,StringGrid1.GridLineWidth); inc(R.top,StringGrid1.GridLineWidth);{}
      Bouton := TButton.Create(StringGrid1);
      Bouton.BoundsRect := R;
      Bouton.Top := R.Top;
      Bouton.Left := R.Left;
      Bouton.Height := R.Bottom - R.Top;
      Bouton.Width := R.Right - R.Left;
      Bouton.Caption:=format('[%u,%u]:%u]',[R.Left,R.top,I]);
      Bouton.Tag := I;
//    Bouton.OnClick := Boutonclick;
      Bouton.Parent := StringGrid1;
//    StringGrid1.Objects[Acol,Arow] := Bouton;
      OffsetRect(R, 0, StringGrid1.DefaultRowHeight + StringGrid1.GridLineWidth);
     end;
end;

si qqu'un a une idée. le premier code fonctionne Merci de vos réponses (écrit en delphi 7)

[Andnotor]

pourquoi dans cette exemple la ligne entre accolades n'affiche pas correctement les boutons R := StringGrid1.CellRect(ACol, ARow) alors que la ligne R := StringGrid1.CellRect(ACol, 0); fonctionne

Parce que CellRect n'est cohérent que pour les cellules visibles.

Mais quelle idée d'utiliser une StringGrid juste pour positionner des boutons, pourquoi pas une ScrollBox ?

[Invité]

Il est possible de créer les boutons uniquement pour les cellules visibles et travailler comme le mode virtuelle en Listbox ou Listview pour afficher les données,, c'est DrawDrid qui convient le plus.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
procedure TForm1.FormCreate(Sender: TObject);
begin
   StringGrid1.RowCount := 14;
   Stringgrid1TopLeftChanged(nil);
end;
 
procedure TForm1.Stringgrid1TopLeftChanged(Sender: TObject);
var
 Bouton: TButton;
 x,y: Integer;
 R: TRect;
begin
 with Stringgrid1 do
 for y:= 0 to 4  do
 begin
   for x := 0 to ColCount-1 do
   begin
      Bouton := TButton(Objects[x, y]);
      if Bouton  = nil then
      begin
        R := CellRect(x, y);
        inflateRect(R, -GridLineWidth,-GridLineWidth);
        Bouton := TButton.Create(StringGrid1);
        Bouton.BoundsRect := R;
        Bouton.Parent := StringGrid1;
        Objects[x, y] := Bouton;
     end;
     Bouton.Tag := (TopRow + y) * ColCount + x;
     Bouton.Caption := format('%u',[Bouton.Tag]);
   end;
 end;
end;

[ZonZorg]

Merci de vos Réponses effectivement je ne connaissais pas le composant scrollbox pour mettre des boutons.
par contre dans la solution proposé par rMist2024
le Bouton.OnClick := Boutonclick; ne fonctionne pas

[ShaiLeTroll]

Pour ma part, je dessine les boutons et je gère le clique via le clic dans la TStringGrid
Voir le sujet TStringGrid et TButton dans une cellule - Event Onclick, vous découvrirez la raison pour laquelle le Click ne fonctionne pas sans le relai de WM_COMMAND et comme la TStringGrid ne défile pas réellement, utilisé un TButton est finalement pas plus pratique que de le dessiner

Pour le Button au look Sympa, il faut selon le thème VCL, soit c'est DrawFrameControl pour le thème OS soit c'est DrawElement

Désolé, je ne l'ai pas pour un Bouton mais pour une caser à cocher,
TStringGridSLTAssistant.DrawCellCheckBox utilise StyleServices.DrawElement au lieu de récupérer un des états de CheckBox, il faut récupérer un détail d'un des états de Button via StyleServices.GetElementDetails avec les valeurs de TThemedButton

Je vais vite bricoler une version TStringGridSLTAssistant.DrawCellButton à partir de TStringGridSLTAssistant.DrawCellCheckBox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
//------------------------------------------------------------------------------
procedure TStringGridSLTAssistant.DrawCellButton(ACol, ARow: Integer; const ACaption: string; AEnabled: Boolean; ABackgroundColor: TColor; AState: TGridDrawState);
const
  CSelected: array[TGridDrawingStyle] of TThemedGrid = (
    tgClassicCellSelected, tgCellSelected, tgGradientCellSelected);
var
  uState: UINT;
  tbState: TThemedButton;
  Details: TThemedElementDetails;
  StyleColor: TColor;
  Buffer: Vcl.Graphics.TBitmap;
  vRect, BufferRect: TRect;
  vText: string;
begin
  if StyleServices.Enabled then
  begin
    vRect := StringGrid.CellRect(ACol, ARow); // Rect Plus fiable que celui fourni par OnDrawCell !
 
    // J'utilise un Buffer temporaire pour dessiner le ThemedButton Button dans le TStringGrid
    Buffer := Vcl.Graphics.TBitmap.Create();
    try
      BufferRect := Rect(0, 0, vRect.Width, vRect.Height);
      Buffer.SetSize(BufferRect.Width, BufferRect.Height);
 
      if ABackgroundColor = clNone then
      begin
        // On dessine un fond normal assurant normalement un bon constrate avec le Button
        Details := StyleServices.GetElementDetails(tgCellNormal);
        StyleServices.GetElementColor(Details, ecFillColor, StyleColor);
      end
      else
        StyleColor := ABackgroundColor;
 
      // Même si la cellule est sélectionné, on laisse un fond neutre pour mieux voir le Button
      // Force un fond opaque pour cacher le texte !
      Buffer.Canvas.Brush.Color := StyleColor;
      Buffer.Canvas.Brush.Style := bsSolid;
      Buffer.Canvas.FillRect(BufferRect);
 
      if not AEnabled then
        tbState := tbPushButtonNormal
      else
        tbState := tbPushButtonDisabled;
 
      InflateRect(BufferRect, -1, -1);  // Pour ne pas superposer le button et le rectangle de sélection
 
      Details := StyleServices.GetElementDetails(tbState);
      StyleServices.DrawElement(Buffer.Canvas.Handle, Details, BufferRect, BufferRect);
 
      vText := ACaption;
      BufferRect.Left := BufferRect.Left + 2; // Pour ne pas superposer le texte
      Buffer.Canvas.Brush.Style := bsClear;
      Buffer.Canvas.TextRect(BufferRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter]);
 
      // Dessin final
      StringGrid.Canvas.Draw(vRect.Left, vRect.Top, Buffer);
    finally
      Buffer.Free();
    end;
  end
  else
  begin
    uState := 0;
 
    if not AEnabled then
      uState := uState or DFCS_INACTIVE;
 
    StringGrid.Canvas.FillRect(vRect);
    InflateRect(vRect, -1, -1);  // Pour ne pas superposer le button et le rectangle de sélection
    DrawFrameControl(StringGrid.Canvas.Handle, vRect, DFC_BUTTON, uState);
 
    vText := ACaption;
    vRect.Left := vRect.Left + 2; // Pour ne pas superposer le texte
    StringGrid.Canvas.Brush.Style := bsClear;
    StringGrid.Canvas.TextRect(vRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter]);
  end;
end;

Et pour le Click, suffit de le le gérer par le OnClick de la StringGrid et MouseToCell

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  SG: TStringGrid absolute Sender;
begin
  with TStringGridSLTAssistant.Create(Sender as TStringGrid) do
  try
    if (ACol >= SG.FixedCols) and (ARow >= SG.FixedRows) then
 
    DrawCellButton(ACol, ARow, Format('%d, %d', [ACol, ARow]), Odd(ACol));
  finally
    Free();
  end;
end;

Ayant bricoler cela en 5 minutes, c'est loin d'être parfait mais c'est une base de travail, ce code a été conçu pour XE2, là je l'ai testé en D10, il y a tellement de modification sur les Styles, il ne faut pas hésiter à lire le code des StyleHook de la VCL pour s'en inspirer.
On constate que CellRect retourne des résultats étranges lors du défilement, c'est le truc à travailler vers le Bas, curieusement, le défilement vers le haut ne pose aucun problème



C'est à cause de la cellule visible à moitié en bas de la StringGrid, en défilant vers le haut, aucun problème, c'est intéressant à analyser
En XE2 le Rect founir par OnDrawCell n'était pas terrible, et je lui préférais donc la fonction CellRect

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  SG: TStringGrid absolute Sender;
begin
  with TStringGridSLTAssistant.Create(Sender as TStringGrid) do
  try
    if (ACol >= SG.FixedCols) and (ARow >= SG.FixedRows) then
      DrawCellButton(ACol, ARow, Format('%d, %d', [ACol, ARow]), Odd(ACol))
    else
      DrawCellCheckBox(ACol, ARow, Odd(ARow));
  finally
    Free();
  end;
end;

[ShaiLeTroll]

D'une simplicité enfantine :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    procedure DrawCellButton(ARect: TRect; ACol, ARow: Integer; const ACaption: string; AEnabled: Boolean = True; ABackgroundColor: TColor = clNone; AState: TGridDrawState = []);

Alors le Rect fourni par OnDrawCell en D10 est toujours trop à droite, il manque le début (Left trop grand)
Mais la Hauteur correcte c'est l'autre, suffit de mixer les deux

Pour le Click soit on recalcule ce qui est cliquable soit on a tout gérer via Objects[], je recommande cette option, au chargement de la TStringGrid on stocke les Data dans Objects[] pour gérer le dessin et le clic

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure TForm1.StringGrid1Click(Sender: TObject);
var
  CP: TPoint;
  Col, Row: Integer;
  SG: TStringGrid absolute Sender;
begin
  if not (Sender is TStringGrid )then
    Exit;
 
  CP := Mouse.CursorPos;
  CP := SG.ScreenToClient(CP);
  SG.MouseToCell(CP.X, CP.Y, Col, Row);
 
  if (Col >= SG.FixedCols) and (Row >= SG.FixedRows) then
  begin
    if Odd(Col) then
      ShowMessage(Format('%d, %d', [Col, Row]));
  end;
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  SG: TStringGrid absolute Sender;
begin
  if not (Sender is TStringGrid) then
    Exit;
 
  with TStringGridSLTAssistant.Create(SG) do
  try
    if (ACol >= SG.FixedCols) and (ARow >= SG.FixedRows) then
      DrawCellButton(Rect, ACol, ARow, Format('%d, %d', [ACol, ARow]), Odd(ACol))
  finally
    Free();
  end;
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
//------------------------------------------------------------------------------
procedure TStringGridSLTAssistant.DrawCellButton(ARect: TRect; ACol, ARow: Integer; const ACaption: string; AEnabled: Boolean; ABackgroundColor: TColor; AState: TGridDrawState);
const
  CSelected: array[TGridDrawingStyle] of TThemedGrid = (
    tgClassicCellSelected, tgCellSelected, tgGradientCellSelected);
var
  uState: UINT;
  tbState: TThemedButton;
  Details: TThemedElementDetails;
  StyleColor: TColor;
  Buffer: Vcl.Graphics.TBitmap;
  vRect, BufferRect: TRect;
  vText: string;
begin
  vRect := StringGrid.CellRect(ACol, ARow); // Rect Plus fiable que celui fourni par OnDrawCell !
  vRect.Height := ARect.Height; // Sauf la Hauteur
 
  if StyleServices.Enabled then
  begin
    // J'utilise un Buffer temporaire pour dessiner le ThemedButton Button dans le TStringGrid
    Buffer := Vcl.Graphics.TBitmap.Create();
    try
      BufferRect := Rect(0, 0, vRect.Width, vRect.Height);
      Buffer.SetSize(BufferRect.Width, BufferRect.Height);
 
      if ABackgroundColor = clNone then
      begin
        // On dessine un fond normal assurant normalement un bon constrate avec le Button
        Details := StyleServices.GetElementDetails(tgCellNormal);
        StyleServices.GetElementColor(Details, ecFillColor, StyleColor);
      end
      else
        StyleColor := ABackgroundColor;
 
      // Même si la cellule est sélectionné, on laisse un fond neutre pour mieux voir le Button
      // Force un fond opaque pour cacher le texte !
      Buffer.Canvas.Brush.Color := StyleColor;
      Buffer.Canvas.Brush.Style := bsSolid;
      Buffer.Canvas.FillRect(BufferRect);
 
      if AEnabled then
        tbState := tbPushButtonNormal
      else
        tbState := tbPushButtonDisabled;
 
      InflateRect(BufferRect, -1, -1);  // Pour ne pas superposer le button et le rectangle de sélection
 
      Details := StyleServices.GetElementDetails(tbState);
      StyleServices.DrawElement(Buffer.Canvas.Handle, Details, BufferRect, BufferRect);
 
      vText := ACaption;
      BufferRect.Left := BufferRect.Left + 2; // Pour ne pas superposer le texte
      Buffer.Canvas.Brush.Style := bsClear;
      Buffer.Canvas.TextRect(BufferRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter]);
 
      // Dessin final
      StringGrid.Canvas.Draw(vRect.Left, vRect.Top, Buffer);
    finally
      Buffer.Free();
    end;
  end
  else
  begin
    uState := 0;
 
    if not AEnabled then
      uState := uState or DFCS_INACTIVE;
 
    StringGrid.Canvas.FillRect(vRect);
    InflateRect(vRect, -1, -1);  // Pour ne pas superposer le button et le rectangle de sélection
    DrawFrameControl(StringGrid.Canvas.Handle, vRect, DFC_BUTTON, uState);
 
    vText := ACaption;
    vRect.Left := vRect.Left + 2; // Pour ne pas superposer le texte
    StringGrid.Canvas.Brush.Style := bsClear;
    StringGrid.Canvas.TextRect(vRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter]);
  end;
end;