TListBox scrolled?

[NeoXan]

Moin,

wie bekomme ich heraus ob eine TListbox gerade gescrollt wird (oben & unten) und wie kannn ich dann eine andere TListBox auch scrollen, so dass sie immer die gleiche Position haben?

mfg
NeoXan

[Chegga]

Hi,

wenn ich es richtig verstanden habe,
meinst du vielleicht sowas:

Delphi-Quellcode:

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  case ListBox1.ItemIndex of
   0: ListBox2.ItemIndex := 0;
   1: ListBox2.ItemIndex := 1;
   2: ListBox2.ItemIndex := 2;
//  .     .       .        .
//  .     .       .        .
//  .     .       .        .
  end;
end;

Oder?

MfG Marc

[Khabarakh]

Zitat von Chegga:

Delphi-Quellcode:

case ListBox1.ItemIndex of
   0: ListBox2.ItemIndex := 0;
   1: ListBox2.ItemIndex := 1;
   2: ListBox2.ItemIndex := 2;
//  .     .       .        .

Wie wäre es mit
Listbox2.ItemIndex:=Listbox1.ItemIndex ?
ItemIndex ist aber der markierte Eintrag, hier müsste man TopIndex verwenden.
Listbox2.TopIndex:=Listbox1.TopIndex Ich habe aber leider kein geeignetes Event gefunden, versuch es mal mit einem Timer oder vielleicht Messages.

[Chegga]

Zitat von Khabarakh:

ItemIndex ist aber der markierte Eintrag, hier müsste man TopIndex verwenden.
Listbox2.TopIndex:=Listbox1.TopIndex

Hm...

Kompromiss:

Delphi-Quellcode:

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  Listbox2.TopIndex := Listbox1.ItemIndex;
end;

MfG Marc

[Sharky]

Hai ihr zwei,

es wurde doch nach dem Scrollen gefragt und nicht nach dem selektieren eines Items.

[NeoXan]

Zitat von Sharky:

Hai ihr zwei,
es wurde doch nach dem Scrollen gefragt und nicht nach dem selektieren eines Items.

richtig

Möglich wäre es doch irgendwie mit WM_blablub zu überprüfen, ob gerade z.B. nach unten gescrollt wird und dann die andere Listbox um die gleiche Anzahl an px Scrollen?!

[Khabarakh]

Zitat von Sharky:

Hai ihr zwei,

es wurde doch nach dem Scrollen gefragt und nicht nach dem selektieren eines Items.

TopIndex liefert den obersten sichtbaren Eintrag, dafür muss er nicht selektiert sein, also ist meine Code-Zeile schon richtig. Man muss sie nur noch an einer geeigneten Stelle einfügen.

Wenns jemand immer noch nicht glauben will :

[Jens Schumann]

Hallo,
das ist dank der OOP eigentlich kein Problem. Ich habe sowas mal für TSrcollbox benötigt.
D.h. wenn eine TScrollbox gescrollt wird soll die andere (oder mehrere) synchron mitscrollen.
Hier kommt der Source für die TScrollBox. Sollte sich leicht auf eine TListbox übertragen lassen.

Delphi-Quellcode:

unit ScrollBoxEx;

interface

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

Const
  CM_SCROLLBOXEXVERTSCROLL  = WM_USER+512;
  CM_SCROLLBOXEXHORIZSCROLL = WM_USER+513;

type

  TScrollEvent = procedure (Sender : TObject; Position : Integer) of Object;

  TScrollBoxEx = class(TScrollBox)
  private
    FOnVScroll      : TScrollEvent;
    fOnHScroll      : TScrollEvent;
    FGroupIndex     : Integer;
    FWallpaper      : TBitmap;
    FCanvas         : TControlCanvas;
    procedure SetGroupIndex(const Value: Integer);
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure CMSCROLLBOXEXVERTSCROLL(var Message: TMessage); message CM_SCROLLBOXEXVERTSCROLL;
    procedure CMSCROLLBOXEXHORIZSCROLL(var Message: TMessage); message CM_SCROLLBOXEXHORIZSCROLL;
    procedure SetWallpaper(const Value: TBitmap);
    procedure PaintTileWallpaper(CanvasHandle: THandle; WndRect : TRect);
    { Private-Deklarationen }
  protected
    { Protected-Deklarationen }
    procedure PaintWindow(DC: HDC); override;
  public
    { Public-Deklarationen }
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy; override;
  published
    { Published-Deklarationen }
    property GroupIndex : Integer read FGroupIndex write SetGroupIndex default 0;
    property Wallpaper  : TBitmap read FWallpaper write SetWallpaper;
    property OnHScroll  : TScrollEvent read fOnHScroll write fOnHScroll;
    property OnVScroll  : TScrollEvent read fOnVScroll write fOnVScroll;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Mycomps', [TScrollBoxEx]);
end;

{ TScrollBoxEx }

constructor TScrollBoxEx.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FWallpaper:=TBitmap.Create;
  FCanvas:=TControlCanvas.Create;
  FCanvas.Control:=Self;
  FGroupIndex:=0;
  fOnVScroll:=Nil;
end;

destructor TScrollBoxEx.Destroy;
begin
  FWallpaper.Free;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TScrollBoxEx.SetGroupIndex(const Value: Integer);
begin
  FGroupIndex := Value;
end;

procedure  TScrollBoxEx.WMHScroll(var Message: TWMHScroll);
var
  Msg: TMessage;
begin
  inherited;
  If Assigned(fOnHScroll) then
    fOnHScroll(Self,Message.Pos);
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_SCROLLBOXEXHORIZSCROLL;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure  TScrollBoxEx.WMVScroll(var Message: TWMVScroll);
var
  Msg: TMessage;
begin
  inherited;
  If Assigned(fOnVScroll) then
    fOnVScroll(Self,Message.Pos);
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_SCROLLBOXEXVERTSCROLL;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure TScrollBoxEx.CMSCROLLBOXEXVERTSCROLL(var Message: TMessage);
var
  Sender: TScrollBoxEx;
begin
  inherited;
  If FGroupIndex<=0 then Exit;
  if Message.WParam = FGroupIndex then
  begin
    Sender := TScrollBoxEx(Message.LParam);
    if Sender <> Self then
    begin
    VertScrollBar.Position:=Sender.VertScrollBar.Position;
    end;
  end;
end;

procedure TScrollBoxEx.CMSCROLLBOXEXHORIZSCROLL(var Message: TMessage);
var
  Sender: TScrollBoxEx;
begin
  inherited;
  If FGroupIndex<=0 then Exit;
  if Message.WParam = FGroupIndex then
  begin
    Sender := TScrollBoxEx(Message.LParam);
    if Sender <> Self then
    begin
    HorzScrollBar.Position:=Sender.HorzScrollBar.Position;
    end;
  end;
end;

procedure TScrollBoxEx.SetWallpaper(const Value: TBitmap);
begin
  FWallpaper.Assign(Value);
  Invalidate;
end;

procedure TScrollBoxEx.PaintTileWallpaper(CanvasHandle: THandle; WndRect : TRect);
var
  Row                 : Integer;
  Col                 : Integer;
begin
  For Row := 0 to (WndRect.Bottom div FWallpaper.Height)+1 do
    For Col := 0 to (WndRect.Right div FWallpaper.Width)+1 do
      BitBlt(CanvasHandle,
             Col * FWallpaper.Width,
             Row * FWallpaper.Height,
             FWallpaper.Width,
             FWallpaper.Height,
             FWallpaper.Canvas.Handle,
             0,
             0,
             SRCCOPY);
end;

procedure TScrollBoxEx.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  Try
    FCanvas.Handle := DC;
    If (FWallpaper.Width>0) and (FWallPaper.Height>0) then
      PaintTileWallpaper(FCanvas.Handle,ClientRect);
  Finally
    FCanvas.Handle := 0;
    FCanvas.UnLock;
  end;
end;

end.

Wichtig ist das abfangen der Botschaften WM_HSCROLL und WM_VSCROLL

Delphi-Quellcode:

procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

In innerhalb der Implementation passiert folgendes:

Delphi-Quellcode:

procedure  TScrollBoxEx.WMHScroll(var Message: TWMHScroll);
var
  Msg: TMessage;
begin
  inherited; // Vorfahren aufrufen
  If Assigned(fOnHScroll) then 
    fOnHScroll(Self,Message.Pos); // Event abfeuern
  if (FGroupIndex <> 0) and (Parent <> nil) then 
  begin
    Msg.Msg := CM_SCROLLBOXEXHORIZSCROLL; // Messagewert setzen
    Msg.WParam := FGroupIndex; // den GroupIndex in wParam
    Msg.LParam := Longint(Self); // Wichtig Referenz auf sich selbst in lParam schreiben
    Msg.Result := 0;
    Parent.Broadcast(Msg); // Mit der Methode BroadCast des Parents die Botschafte an alle
                           // TWinControls senden, die den gleichen Parent haben.
                           // Habe ich bei TSpeedbutton angekupfert.
  end;
end;

Ist die Botschaft abgeschickt, wird sie durch folgende Methode verarbeitet.

Delphi-Quellcode:

...
procedure CMSCROLLBOXEXHORIZSCROLL(var Message: TMessage); message CM_SCROLLBOXEXHORIZSCROLL;
...
procedure TScrollBoxEx.CMSCROLLBOXEXHORIZSCROLL(var Message: TMessage);
var
  Sender: TScrollBoxEx;
begin
  inherited;
  If FGroupIndex<=0 then Exit;  // Wenn kein GroupIndex definiert Methode sofort verlassen
  if Message.WParam = FGroupIndex then // Wenn in wParam der gleiche GroupIndex steht dann 
  begin
    Sender := TScrollBoxEx(Message.LParam);
    if Sender <> Self then // Hat der Sender die Botschaft empfangen ? Wenn ja ignorieren
    begin
    HorzScrollBar.Position:=Sender.HorzScrollBar.Position; // Scrollbarposition setzen
    // Bei TListbox könnte hier ItemIndex gesetzt werden.
    end;
  end;
end;

[NeoXan]

...puuuh....ok, und jetzt das ganze nochmal für einen Neuling

[Stevie]

In diesem Thread gibt's auch was zu dem Thema...