Boutons dans un Stringgrid et rafraichissement ScrollBar

Version imprimable

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:

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:

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:

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)

24/11/2024, 11h57
Andnotor

Citation:

Envoyé par ZonZorg

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 ?

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:

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;

25/11/2024, 03h09
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

3 pièce(s) jointe(s)

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

Citation:

Envoyé par ShaiLeTroll

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:

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:

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;
Pièce jointe 662171

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

Pièce jointe 662172

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

Pièce jointe 662173
Code:

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;

1 pièce(s) jointe(s)

D'une simplicité enfantine :

Pièce jointe 662175

Code:

    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:

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:

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:

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;

1 pièce(s) jointe(s)

J'ai cru lire D7 plus haut, voici un patch pour la partie sans thème, je n'ai plus le code d'origine de mes assistants en D7 qui ont été migré en BCB et DXE2

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  else
  begin
    uState := DFCS_BUTTONPUSH;
 
    if not AEnabled then
      uState := uState or DFCS_INACTIVE or DFCS_FLAT; // Flat parce que DFCS_INACTIVE franchement on voit pas la différence, je pense qu'il faut soit même dessiné le texte en grisé pour donner l'effet disabled
 
    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;
    if not AEnabled then
      StringGrid.Canvas.Font.Color := clGrayText;
    StringGrid.Canvas.TextRect(vRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter]);
  end;

Pièce jointe 662190

25/11/2024, 11h25
Invité
Citation:

par contre dans la solution proposé par rMist2024
le Bouton.OnClick := Boutonclick; ne fonctionne pas

Ajouter csClickEvents dans le style du contrôle pour activer l'évènment Onclick malgré le fait que les deux autres OnMouseDown et OnMouseUp ne sont pas désactivés il semble que le StringGrid bloque cet evenement.
L'oublie pas la désactivation de DefaultDrawing actuellement ne sert a rien
Code:

1 2 Bouton.ControlStyle := Bouton.ControlStyle + [csClickEvents]; Bouton.OnClick := Boutonclick;
Code:

1 2 3 4 5 procedure TForm1.Boutonclick(Sender: TObject); begin with TButton(Sender) do Showmessagefmt('%d',[Tag]); end;
25/11/2024, 11h31
ShaiLeTroll

Si ControlStyle n'existe pas en D7, voir le surclassement proposé par SergioMaster pour gérer le WM_COMMAND comme évoqué plus haut.

Citation:

Si ControlStyle n'existe pas en D7

Oui cette propriété existe.. La première chose qui m'est venue à l'esprit, c'est d'aller vérifier cette propriété surtout celle du StringGrid.

Citation:

J'ai cru lire D7 plus haut, voici un patch pour la partie sans thème, je n'ai plus le code d'origine de mes assistants en D7 qui ont été migré en BCB et DXE2

Pour D7 on peut dessiner directement les boutons style windows via DrawThemeBackground, j'avais ce code qui date que je n'ai jamais utiliser dans un projet les styles ne m'interessent pas trop.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
function  DrawThemeBackground(hTheme: Thandle; hdc: HDC; iPartId, iStateId: Integer;
  const pRect: TRect; pClipRect: PRECT): HRESULT; stdcall;external 'uxtheme.dll';
 
function  OpenThemeData(hwnd: HWND; pszClassList: LPCWSTR): THandle; stdcall ;external 'uxtheme.dll';
function  CloseThemeData(hTheme: THandle): HRESULT; stdcall;external 'uxtheme.dll';
 
 
procedure DrawTheme(dc:HDC; iPartId, iStateId: integer; const R: TRect);
var
 h: THandle;
 s: WideString;
begin
 S := 'button';
 h := OpenThemeData(0, PWidechar(S));
 DrawThemeBackground(h, dc, iPartId, iStateId, R, nil);
 CloseThemeData(h);
end;

Exemple :

Code:

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
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
 h: integer;
begin
  h := canvas.Handle;
  DrawTheme(h,  1, 1, bounds(80 * 0, 10, 70, 30));
  //Hot
  DrawTheme(h,  1, 2, bounds(80 * 1, 10, 70, 30));
  //Pushed
  DrawTheme(h,  1, 3, bounds(80 * 2, 10, 70, 30));
  //Disabled
  DrawTheme(h,  1, 4, bounds(80 * 3, 10, 70, 30));
  //Fucused
  DrawTheme(h,  1, 5, bounds(80 * 4, 10, 70, 30));
 
//OptionButton
  //Normal
  DrawTheme(h,  2, 1, bounds(80 * 0, 50, 70, 30));
  //Hot
  DrawTheme(h,  2, 2, bounds(80 * 1, 50, 70, 30));
  //Pushed
  DrawTheme(h,  2, 3, bounds(80 * 2, 50, 70, 30));
  //Disabled
  DrawTheme(h,  2, 4, bounds(80 * 3, 50, 70, 30));
  //Fucused
  DrawTheme(h,  2, 5, bounds(80 * 4, 50, 70, 30));
 
//CheckButton
  //Normal
  DrawTheme(h,  3, 1, bounds(80 * 0, 70, 70, 30));
  //Hot
  DrawTheme(h,  3, 2, bounds(80 * 1, 70, 70, 30));
  //Pushed
  DrawTheme(h,  3, 3, bounds(80 * 2, 70, 70, 30));
  //Disabled
  DrawTheme(h,  3, 4, bounds(80 * 3, 70, 70, 30));
  //Fucused
  DrawTheme(h,  2, 5, bounds(80 * 4, 70, 70, 30));
 
end;

On peut aussi utiliser une ImageList pour garder les images qu'on veut dessiner selon le contexte. Récemment, j'ai créé une fiche pour organiser les filtres de recherche dans les fichiers pour les stocker et les activer ou désactiver.

https://i.ibb.co/6n3689L/flters.png

25/11/2024, 22h48
ShaiLeTroll

On est bien d'accord que D7 c'est pas DXE7 ?
C'est celui de 2002 et non celui de 2014 !
Je ne l'ai plus du tout d'installé
26/11/2024, 05h53
ZonZorg
oui c'est bien delphi borland 7
j'ai bien essayé Embarcadero Studio XE7
mais trop compliqué pour faire des programmes à la 'Papa'.
puis le composant scrollbox me va tres bien
Merci de vos messages si cela fait avancé l'exemple pour d'autres personnes.
Code:

1 2 Bouton.ControlStyle := Bouton.ControlStyle + [csClickEvents];
ok pour moi (merci rMist2024)

pour en revenir a mon exemple initial
donc le R := StringGrid1.CellRect(ACol, 0); (donne le rect visible);

en faisant un petit résumé j' arrive à ça (source de rMist2024)

Code:

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
 
procedure TForm1.boutononclick(Sender:Tobject);
Begin
       with TButton(Sender) do Showmessagefmt('%s',[caption]);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var x: Integer;
    R:Trect;
    Bouton: TButton;
begin
   StringGrid1.RowCount:=14;
   with Stringgrid1 do
   for X:= 0 to VisibleRowCount*ColCount-1 do
   begin
      R := CellRect(x mod ColCount, x div ColCount); inflateRect(R, -GridLineWidth,-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.Tag :=(x div ColCount) * ColCount + (x mod ColCount);
      Bouton.Caption:=format('%u',[Bouton.Tag]);
      Bouton.ControlStyle := Bouton.ControlStyle + [csClickEvents];
      Bouton.OnClick := boutononclick;
      Bouton.Parent := StringGrid1;
      Objects[x mod ColCount, x div ColCount] := Bouton;
  end;
end;
 
procedure TForm1.Stringgrid2TopLeftChanged(Sender: TObject);
var
 Bouton: TButton;
 x: Integer;
begin
 with (Sender as Tstringgrid) do
 for X:= 0 to VisibleRowCount*ColCount-1 do
   begin
      Bouton := TButton(Objects[x mod ColCount, x div ColCount]);
      Bouton.Tag := (TopRow + (x div ColCount)) * ColCount + (x mod ColCount);
      Bouton.Caption:=format('%d',[Bouton.Tag]);
   end;
end

il faut redéfinir la caption des boutons (StringGrid1TopLeftChanged)
et donc j'ai bien mon CellRect(x mod ColCount, x div ColCount); même si il n'est pas dessiné dans le stringgrid;

26/11/2024, 15h42
Invité

Citation:

On est bien d'accord que D7 c'est pas DXE7 ?

La première partie de ma réponse concerne D7 et la deuxième partie qui aborde le dessin des images à partir d'une image liste a été développée sous Delphi Tokyo (les glyphs des checkboxs ainsi les images de la deuxième colonne se trouvent dans une image liste)
26/11/2024, 15h48
Invité

Citation:

il faut redéfinir la caption des boutons (StringGrid1TopLeftChanged)

Il faut le faire après la fin de déplacement en mode asynchrone via Postmessage par exemple et pas directement dans la fonction StringGrid1TopLeftChanged
27/11/2024, 12h01
Andnotor
Citation:

Envoyé par ZonZorg

en faisant un petit résumé j' arrive à ça

Vraiment pas exceptionnel.
- Au défilement par molette ça donne quoi si le curseur est sur un bouton ?
- Et la navigation au clavier ?
- Qu'est-ce qui se passe si tu cliques dans une zone vide de la grille ? Qu'est-ce qui prend le focus ?