comment capturer les événements générés par les clicks sur les boutons de défilement standard d'une Tlistbox?
Je sèche!
Merci d'avance
Pey
Version imprimable
comment capturer les événements générés par les clicks sur les boutons de défilement standard d'une Tlistbox?
Je sèche!
Merci d'avance
Pey
Il faut intercepter les messages WM_VSCROLL, il n'y a pas d'évènement standard permettant de le faire pour une TListBox.
De là, ça peut se faire soit en créant un composant dérivé de TListBox,
soit en remplaçant la méthode WndProc de la ListBox par ta propre méthode.
Comme ce n'est quand même pas évident à utiliser, ce serait bien que tu précise ce que tu cherches à récupérer comme information (la positions de la ScrollBar ? Le fait qui ai eu défilement et rien d'autre ?,etc...)
En tout cas voici un exemple, sur une fiche, j'ai mis une TListBox, et deux Labels :
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, StdCtrls, ExtDlgs, OleCtrls, SHDocVw; type TForm1 = class(TForm) ListBox1: TListBox; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } OldWndProc:procedure (var Message:TMessage) of object; procedure NewWndProc(var Message:TMessage); end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } //OnCreate de la fiche procedure TForm1.FormCreate(Sender: TObject); begin OldWndProc:=ListBox1.WindowProc; ListBox1.WindowProc:=NewWndProc; end; procedure TForm1.NewWndProc(var Message: TMessage); var VSCrollMsg:TWMVScroll; begin if Message.Msg=WM_VSCROLL then begin VSCrollMsg:=TWMVScroll(Message); case VSCrollMsg.ScrollCode of SB_BOTTOM:label1.Caption:='Scrolls to the lower right.'; SB_ENDSCROLL:label1.Caption:='Ends scroll.'; SB_LINEDOWN:label1.Caption:='Scrolls one line down.'; SB_LINEUP:label1.Caption:='Scrolls one line up.'; SB_PAGEDOWN:label1.Caption:='Scrolls one page down. '; SB_PAGEUP:label1.Caption:='Scrolls one page up.'; SB_THUMBPOSITION:begin label1.Caption:='Scrolls to the absolute position.'+#13#10 +'The current position is specified by the nPos parameter.'+#13#10 +'Position de la scrollbar : '+IntToStr(VSCrollMsg.Pos); end; SB_THUMBTRACK:begin label1.Caption:='Drags scroll box to the specified position.'+#13#10 +'The current position is specified by the nPos parameter.'+#13#10 +'Position de la scrollbar : '+IntToStr(VSCrollMsg.Pos); end; SB_TOP:label1.Caption:='Scrolls to the upper left.'; end; label2.Caption:='Position :'+IntToStr(GetScrollPos(ListBox1.Handle,SB_VERT)); end; OldWndProc(message); end; end.
J'avais oublié la gestion de la roulette de souris :aie:
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
79
80
81
82
83
84
85
86
87
88 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtDlgs, OleCtrls, SHDocVw; type TForm1 = class(TForm) ListBox1: TListBox; Label1: TLabel; Label2: TLabel; Memo1: TMemo; procedure FormCreate(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } OldWndProc:procedure (var Message:TMessage) of object; procedure NewWndProc(var Message:TMessage); end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } procedure TForm1.NewWndProc(var Message: TMessage); var VSCrollMsg:TWMVScroll; MouseWheel:TWMMouseWheel; Info1,Info2:string; begin if Message.Msg=WM_VSCROLL then begin Info1:=''; VSCrollMsg:=TWMVScroll(Message); case VSCrollMsg.ScrollCode of SB_BOTTOM:Info1:='Scrolls to the lower right.'; SB_ENDSCROLL:Info1:='Ends scroll.'; SB_LINEDOWN:Info1:='Scrolls one line down.'; SB_LINEUP:Info1:='Scrolls one line up.'; SB_PAGEDOWN:Info1:='Scrolls one page down. '; SB_PAGEUP:Info1:='Scrolls one page up.'; SB_THUMBPOSITION:begin Info1:='Scrolls to the absolute position.'+#13#10 +'The current position is specified by the nPos parameter.'+#13#10 +'Position de la scrollbar : '+IntToStr(VSCrollMsg.Pos); end; SB_THUMBTRACK:begin Info1:='Drags scroll box to the specified position.'+#13#10 +'The current position is specified by the nPos parameter.'+#13#10 +'Position de la scrollbar : '+IntToStr(VSCrollMsg.Pos); end; SB_TOP:Info1:='Scrolls to the upper left.'; end; label1.Caption:=info1; end; if Message.Msg=WM_Mousewheel then begin MouseWheel:=TWMMouseWheel(message); Info1:='On a utilisé la roulette de la souris :'; if (MK_CONTROL and MouseWheel.Keys)<>0 then Info1:=Info1+#13#10+'- the CTRL key is down.'; if (MK_LBUTTON and MouseWheel.Keys)<>0 then Info1:=Info1+#13#10+'- the left mouse button is down.'; if (MK_MBUTTON and MouseWheel.Keys)<>0 then Info1:=Info1+#13#10+'- the middle mouse button is down.'; if (MK_RBUTTON and MouseWheel.Keys)<>0 then Info1:=Info1+#13#10+'- the right mouse button is down.'; if (MK_SHIFT and MouseWheel.Keys)<>0 then Info1:=Info1+#13#10+'- the SHIFT key is down.'; label1.Caption:=info1; end; Info2:='Position :'+IntToStr(GetScrollPos(ListBox1.Handle,SB_VERT)); label2.Caption:=info2; OldWndProc(message); end; procedure TForm1.FormCreate(Sender: TObject); begin OldWndProc:=ListBox1.WindowProc; ListBox1.WindowProc:=NewWndProc; end; end.
J'avais laissé cette question d ecôté mis j'y reviens et merci pour la résolution de ce problème
pey