TStringGrid et TButton dans une cellule - Event Onclick

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Après un changement de PC juste avant le confinement, je me remets à Delphi après une longue absence sur cet environnement :P

Version de Delphi : 10.3.3 Rio Version Community.

Dans une StringGrid, j'essaie d'insérer un bouton dans une cellule ... Tout se passe bien : le bouton est visible dans la cellule concernée et réagit à la souris. Mais ... bien que j'ai affecté l'événement Onclick du bouton, celui-ci n'est jamais déclenché.

Si j'active l'événement OnClick de la StringGrid, il est actif dans la cellule du bouton uniquement si je clique dans la cellule mais en dehors du bouton .

Je pense que j'ai dû me planter quelque part mais je n'arrive pas à voir où ... ni pourquoi l'événement n'est pas déclenché !

Pour le moment, le test est réalisé en VCL.

Le code ... Il n'est certainement pas top mais c'est pour faire quelques tests ...:oops:
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 unit Unit4; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls; type TForm4 = class(TForm) StringGrid1: TStringGrid; procedure FormCreate(Sender: TObject); procedure StringGrid1Click(Sender: TObject); private { Déclarations privées } public procedure BOUTON_CLICK(Sender : TObject); end; var Form4: TForm4; implementation {$R *.dfm} procedure TForm4.BOUTON_CLICK(Sender: TObject); begin Showmessage('CLIC BOUTON'); end; procedure TForm4.FormCreate(Sender: TObject); var Bouton : TButton; Rect : TRect; begin Rect := StringGrid1.CellRect(2,2); Bouton := Tbutton.Create(nil); Bouton.Parent := StringGrid1; Bouton.Top := Rect.Top + 3; Bouton.Left := Rect.Left + 3; Bouton.Height := Rect.Bottom - Rect.Top - 10; Bouton.Width := Rect.Right - Rect.Left - 10; Bouton.Caption := 'BOUTON'; Bouton.Style := bsPushButton; Bouton.Enabled := True; Bouton.Visible := True; Bouton.OnClick := BOUTON_CLICK; StringGrid1.Objects[2,2] := Bouton; end; procedure TForm4.StringGrid1Click(Sender: TObject); begin Showmessage('CLIC STRINGGRID'); end; end.
La copie d'écran de la StringGrid où on voit bien le bouton présent pouvant être cliqué ...

Pièce jointe 555756

Si quelqu'un a une idée je suis preneur ... Je n'ai rien trouvé sur le net : ou alors j'ai mal cherché :oops::oops::(

Par avance merci.

Cdt

Laurent

14/04/2020, 08h46
ALWEBER

1 pièce(s) jointe(s)

Bonjour. Mauvaix choix ;)

Sauf erreur de ma part :

Pièce jointe 555878

Le parent du bouton est la fiche et pas le stringGrid même si visuellement cela semble être le cas
Donc choisir autre chose que le stringGrid
14/04/2020, 08h49
blonde

J'ai fait 2-3 tests pour voir

si tu passes comme parent pour le bouton la fenêtre elle-même, tu auras le comportement souhaité :

Code:

Bouton.Parent := self;

Si tu veux conserver la grille a, tant que parent de ton bouton, il faudra alors que tu utilises l'événement "onMouseUp"

1 pièce(s) jointe(s)

Bonjour,

dessiner un bouton dans une grille n'est en soit pas si difficile
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 procedure TForm109.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var r : Trect; begin if (Arow>0) AND (aCol=2) then begin r.Top:=Rect.Top+1; r.Bottom:=Rect.Bottom-1; r.Left:=Rect.Left+1; r.Right:=Rect.Right-1; DrawFrameControl((Sender as TStringGrid).Canvas.Handle,r,DFC_BUTTON,DFCS_BUTTONPUSH); // j'utilise la même astuce que pour dessiner une case à cocher comme ici https://www.developpez.net/forums/d1213980/environnements-developpement/delphi/debuter/cocher-dbcheckbox/#post6644294 (Sender as TStringGrid).Canvas.TextOut(R.Left+3, R.Top+3, 'Button'+ARow.toString); // j'avoue je n'ai pas fait beaucoup d'effort (centrage,couleur de fond, etc.) sur le textout end; end;
Bien sûr ce n'est qu'un dessin, pas un vrai TButton. Pour y attacher un évènement ce serait le onMousexxx ou un OnClick/OndblClick qui pourrait être utilisé pourvu de connaitre les coordonnées dans la grille ;)
Code:

1 2 3 4 5 procedure TForm109.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if StringGrid1.Col=2 then Showmessage('Click Button'+StringGrid1.Row.ToString); end;
[Edit]

Citation:

// j'avoue je n'ai pas fait beaucoup d'effort (centrage, couleur de fond, etc.) sur le textout
end;

voilà qui corrige le tir
Code:

1 2 3 R.Inflate(-2,-2); (Sender as TStringGrid).Canvas.Brush.Color:=clBtnFace; DrawText((Sender as TStringGrid).Canvas.Handle,Caption,Length(Caption),R,DT_CENTER OR DT_SINGLELINE OR DT_VCENTER);
Pièce jointe 555901

Citation:

Pour le moment, le test est réalisé en VCL.

en FMX cette partie serait totalement différente ;)

14/04/2020, 13h14
Invité

Bonjour à toutes et tous,

Avec tous mes remerciements pour vos réponses.

En fait, je souhaitais pouvoir mettre dans une cellule d'une StringGrid un bouton ayant un look "sympa" sans devoir tout gérer manuellement ;) Mais visiblement, sans passer par l'événement OnDrawCell cela ne semble pas possible.

La procédure que SergioMaster a donné fonctionnement parfaitement. Merci. :zoubi:

Toutefois, je n'arrive pas à comprendre pourquoi la création du bouton rattaché à une cellule telle que je l'ai faite ne permet pas de récupérer le click du bouton alors que le bouton est bien rattaché à la cellule ... ceci est sûrement dû à des oublis de notions élémentaires de ma part ! Il va falloir que je me replonge dans quelques cours ;) Comme le développement n'est plus mon quotidien depuis quelques années, j'ai sûrement oublié quelques bases !

Concernant FMX, il faut que je fasse quelques tests d'apprentissages et pour cela j'ai vu quelques tutoriaux assez fournis et détaillés sur le sujet, ainsi que le LiveBinding (n'est-ce pas Serge :D)

Bonne fin de journée.

Cdt

Laurent

1 pièce(s) jointe(s)

Une autre solution :

Pièce jointe 556028

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
 
unit ex08a;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Generics.Collections;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ScrollBox1: TScrollBox;
    procedure FormActivate(Sender: TObject);
    procedure aButtonClick(Sender: TObject);
  end;
 
var
  Form1: TForm1;
  Bprem: boolean = true;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.aButtonClick(Sender: TObject);
begin
  showmessage(TButton(Sender).Caption);
end;
 
procedure TForm1.FormActivate(Sender: TObject);
var
  Panel1: TPanel;
  i1, i2: integer;
  b1: boolean;
  Button1: TButton;
begin
  if not Bprem then
    exit;
  Bprem := false;
  for i1 := 0 to 7 do
  begin
    for i2 := 0 to 7 do
    begin
      Panel1 := TPanel.Create(self);
      Panel1.Parent := ScrollBox1;
      Panel1.Width := 100;
      Panel1.Height := 40;
      Panel1.BevelInner := bvRaised;
      Panel1.BevelOuter := bvnone;
      Panel1.left := i1 * 100;
      Panel1.top := i2 * 40;
      Panel1.ParentBackground := false;
      if i1 = 2 then
      begin
        Button1 := TButton.Create(self);
        Button1.Parent := Panel1;
        Button1.OnClick := aButtonClick;
        Button1.left := 10;
        Button1.top := 10;
        Button1.Width := 80;
        Button1.Height := 20;
        Button1.Caption := i2.ToString;
      end;
    end;
  end;
end;
 
end.

14/04/2020, 14h32
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
14/04/2020, 14h50
blonde

Citation:

Envoyé par inforock

Toutefois, je n'arrive pas à comprendre pourquoi la création du bouton rattaché à une cellule telle que je l'ai faite ne permet pas de récupérer le click du bouton alors que le bouton est bien rattaché à la cellule

J'ai la même interrogation, puisque le OnMouseup passe bien, pourquoi pas le OnClick ?

2 pièce(s) jointe(s)

Bon, j'ai trouvé ça dans une FAQ qui n'a jamais été publiée

Citation:

La TStringGrid n'est pas conçue initialement pour jouer le rôle de conteneur et par conséquent, ne réagit pas spécifiquement au message WMCommand.
Quand on clique sur un TButton, Windows envoie le message WM_COMMAND à son propriétaire qui, à son tour doit retourner un message CN_COMMAND au control pour qu'il puisse executer sa procedure click.

Après, ce même auteur (Pedro) propose de surclasser la stringgrid.

Voici ma propre version de ce surclassement
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 type TStringGrid = class(VCL.Grids.TStringGrid) private { Private declarations } Procedure WMCommand(var msg: TWMCommand); message WM_COMMAND; end; TForm1 = class(TForm) StringGrid1: TStringGrid; // la stringgrid est "surclassée" procedure TStringGrid.WMCommand(var msg: TWMCommand); begin If (msg.Ctl = InplaceEditor.Handle) Then inherited else If msg.Ctl <> 0 Then msg.result := SendMessage(msg.ctl, CN_COMMAND, TMessage(msg).wparam, TMessage(msg).lparam ); end;
et voilà, cela fera plaisir à blonde, pas de onmouseup ni onmousedown :whistle2:
Pièce jointe 556073
et le bouton du premier post fonctionne ;)
cependant je remarque que dès que l'on fait défiler la grille vers le bas, ce bouton a tendance à ne pas se redessiner comme il faut :weird:
Pièce jointe 556092

Citation:

Concernant FMX, il faut que je fasse quelques tests d'apprentissages et pour cela j'ai vu quelques tutoriaux assez fournis et détaillés sur le sujet, ainsi que le LiveBinding (n'est-ce pas Serge :D)

:oops: désolé si j'écris trop :lol: quoique j'ai 2 tutos qui sont sur le gril depuis au moins 6 mois et ne sont toujours pas publiés

14/04/2020, 16h59
blonde

Citation:

Envoyé par SergioMaster

et voilà, cela fera plaisir à blonde, pas de onmouseup ni onmousedown :whistle2:

:king: Merci, j'aime beaucoup cette solution, et l'explication qui va avec !
14/04/2020, 17h26
Invité

Bonsoir,

Je vous remercie pour l'ensemble de vos réponses / solutions / codes ... Je m'aperçois que je n'avais pas assez cherché par moi-même :?

Me reste maintenant à mettre en oeuvre tout cela (mais pas avant ce week-end. J'ai en charge un WMS et les journées sont bien chargées en ce moment ...)

@Serge : tes publications sont claires et agréables à lire ... On les aura quand les 2 tutos en attente de publication ? :mouarf::mouarf:

Bonne soirée

Cdt

Laurent
14/04/2020, 17h41
SergioMaster

Re,

Citation:

Envoyé par inforock

On les aura quand les 2 tutos en attente de publication ? :mouarf::mouarf:

Quand des utilisateurs avec des droits sur les forums de correction pourront s'y pencher :roll:
Sinon, ils sont en avant-première, en pdf avec exemples, à cette adresse https://github.com/Serge-Girard/AvisTechniques
Deux autres, dans les tuyaux, sont en cours de rédaction : un pavé sur TPath et les SVG (idem une avant-première, non terminé car j'ai grandement travaillé sur le chargement de fichiers SVG, à cette adresse https://github.com/Serge-Girard/TPath) et une comparaison entre TListBox et TListView.