Discussion :

[pey]

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

[LadyWasky]

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 :

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, 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.

[LadyWasky]

J'avais oublié la gestion de la roulette de souris

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
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.

[pey]

J'avais laissé cette question d ecôté mis j'y reviens et merci pour la résolution de ce problème

pey