RetourForum Delphi
Nouveau compte - Se connecter - Perdu votre mot de passe?Recherche: Utilisateur - Message

Index > Forum général > [Résolu] ListBox, mouseWheel Up et DownNouveau post - Répondre
systmd
visiteur
Question [Résolu] ListBox, mouseWheel Up et Down message: éditerle 10/01/13 à 19h51

Bonsoir,

Pour pallier le manque du mouseWheel Up et Down de la ListBox, j'ai fait ceci.
Le problème est que lorsque la scrollbar verticale est présente, je n'arrive pas à garder ma ligne sélectionner à l'écran, même en bricolant TopIndex.

 

code


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    List1: TListBox;
    GboxChoix: TGroupBox;
    List2: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure ListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure GboxChoixMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure List1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure List2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1      : TForm1;
  List1Select,
  List2Select : Boolean;
implementation

{$R *.DFM}

procedure TForm1.ListDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with (Control as TListBox).Canvas do
  begin
    Font.Color:=clBlack; // Couleur de fonte
    if odSelected in State then
      Brush.Color:=clYellow  // Fond jaune pour l'Item sélectionné
    else
      Brush.Color:=clWhite;  // Fond blanc pour les autres

    FillRect(Rect); // Remplit le rectangle de l'Index sur canvas avec Brush.color
    TextOut(Rect.Left, Rect.Top,  (Control as TListBox).Items[Index]); // Texte de l'Item
  end;
end;

procedure TForm1.GboxChoixMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  List1Select:=False;
  List2Select:=False;
end;

procedure TForm1.List1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  List1Select:=True;
end;

procedure TForm1.List2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  List2Select:=True;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var i,j :Integer;
begin
if List1Select =True then
    begin
    List1.SetFocus;
    I:= List1.ItemIndex-1;
    If I<0 then I:=0;
    List1.ItemIndex:=I;
    List1.TopIndex := I-4;
    Label1.Caption := List1.Items[List1.itemindex];
    end;

if List2Select =True then
    begin;
    List2.SetFocus;
    j:= List2.ItemIndex-1;
    If j<0 then j:=0;
    List2.ItemIndex:=j;
    Label2.Caption := List2.Items[List2.itemindex];
    end;
end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var i,j :Integer; 
begin
if List1Select =True then
    begin
    List1.SetFocus;
    I:= List1.ItemIndex+1;
    If I>List1.Count-1 then I:=List1.Count-1;
    List1.ItemIndex:=I;
    List1.TopIndex := I-4;
    Label1.Caption := List1.Items[List1.itemindex];
    end;

if List2Select =True then
    begin;
    List2.SetFocus;
    j:= List2.ItemIndex+1;
    If j>List2.Count-1 then j:=List2.Count-1;
    List2.ItemIndex:=j;
    Label2.Caption := List2.Items[List2.itemindex];
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List1.ItemIndex:=4;
  List2.ItemIndex:=2;
end;

end.

systmd
visiteur
Message Re: ListBox, mouseWheel Up et Down message: éditerle 10/01/13 à 22h29

Pour tester, j'ai rajouté
 

code


ShowScrollBar(List1.Handle, SB_VERT, False);
ShowScrollBar(List2.Handle, SB_VERT, False);


pour masquer la scrollbar dans
 

quote


procedure TForm1.FormCreate(Sender: TObject);
procedure TForm1.FormMouseWheelDown....
procedure TForm1.FormMouseWheelUp(Send ...


ça fonctionne, mais j'ai des scintillements et j'aimerai garder la scrollbar verticale

systmd
visiteur
Message Re: ListBox, mouseWheel Up et Down message: éditerle 10/01/13 à 23h23

Il y a sûrement de l'optimisation à faire, mais ça fonctionne pour le momment

 

code


procedure TForm1.GboxChoixMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  List1Select:=False;
  List2Select:=False;
  if List1.Count >8 then
    ShowScrollBar(List1.Handle, SB_VERT, True);
  if List2.Count >8 then
    ShowScrollBar(List2.Handle, SB_VERT, True);
end;

procedure TForm1.List1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  List1Select:=True;
end;

procedure TForm1.List2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  List2Select:=True;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var i,j :Integer;
begin
if List1Select =True then
    begin
    List1.SetFocus;
    I:= List1.ItemIndex-1;
    If I<0 then I:=0;
    List1.ItemIndex:=I;
    List1.TopIndex := I-4;
    Label1.Caption := List1.Items[List1.itemindex];
    ShowScrollBar(List1.Handle, SB_VERT, False);
    end;

if List2Select =True then
    begin;
    List2.SetFocus;
    j:= List2.ItemIndex-1;
    If j<0 then j:=0;
    List2.ItemIndex:=j;
    List2.TopIndex := j-4;
    Label2.Caption := List2.Items[List2.itemindex];
    ShowScrollBar(List2.Handle, SB_VERT, False);
    end;

end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var i,j :Integer; 
begin
if List1Select =True then
    begin
    List1.SetFocus;
    I:= List1.ItemIndex+1;
    If I>List1.Count-1 then I:=List1.Count-1;
    List1.ItemIndex:=I;
    List1.TopIndex := I-4;
    Label1.Caption := List1.Items[List1.itemindex];
    ShowScrollBar(List1.Handle, SB_VERT, False);
    end;

if List2Select =True then
    begin;
    List2.SetFocus;
    j:= List2.ItemIndex+1;
    If j>List2.Count-1 then j:=List2.Count-1;
    List2.ItemIndex:=j;
    List2.TopIndex := j-4;
    Label2.Caption := List2.Items[List2.itemindex];
    ShowScrollBar(List2.Handle, SB_VERT, False);
    end;
   
end;

ZeuS-[SFX]
visiteur
Message Re: [Résolu] ListBox, mouseWheel Up et Down message: éditerle 11/01/13 à 12h05

Salut systmd, pallier le manque de la molette c'est à dire ? Tu veux scroller sans que la listbox ait réellement le focus ?
Où par rapport au code que je le lis j'ai l'impression que tu change la sélection avec le scroll ?

systmd
visiteur
Message Re: ListBox, mouseWheel Up et Down message: éditerle 11/01/13 à 12h55

Bonjour ZeuS-[SFX],
- je veux pouvoir scroller l'item selectionner,Soit en utilisant la scrollbar soit en utilisant la molette en se positionnant au-dessus de la listbox.
- La sélection doit rester dans le cadre (Visible)
- Le Focus c'est pour éviter de faire scroller les 2 ListBox en même temps vu que les OnMouseWheelUp et OnMouseWheelDown sont pris sur la Form.

Le seul moyen que j'ai trouvé pour le momment, c'est de masquer la scrollbar au momment de l'utilisation de la molette et de la faire réapparaitre à la perte du focus.

Mais je trouve mon code un peu tiré par les cheveux.
L'idéal serait de surcharger le composant TListBox de StdCtrls
en ajoutant les événements OnMouseWheelUp,OnMouseWheelDown,OnMouseWheel

Columbo
visiteur
Message Re: ListBox, mouseWheel Up et Down message: éditerle 11/01/13 à 19h34

Bonjour,

Une proposition :

1. Tu ajoutes Math à tes uses.
2. Tu ajoutes un composant ApplicationEvents sur ta fiche et tu crées le gestionnaire d'événement OnMessage.
3. Tu renseignes l'événement OnMessage comme suit :
 

code



var Control: TWincontrol;
    Delta: integer;
begin
    if Msg.Message=WM_MOUSEWHEEL then
    begin
          Control:=FindControl(WindowFromPoint(Mouse.CursorPos));
          if Control is TListBox then
          with TListBox(Control) do
          begin
              Delta:=TopIndex-ItemIndex;
              ItemIndex:=Min(Items.Count-1, Max(0, ItemIndex-Sign(Msg.wParam)));
              TopIndex:=ItemIndex+Min(0, Delta);
              Handled:=true;
          end;
    end;
end;

systmd
visiteur
Message Re: ListBox, mouseWheel Up et Down message: éditerle 11/01/13 à 20h54

Bonsoir Columbo,

Parfait,c'est exactement ça.
Reste plus qu'a potasser pour voir comment ça marche Clin d'oeil

Merci

Index > Forum général > [Résolu] ListBox, mouseWheel Up et DownNouveau post - Répondre
 page 1 sur 1