Zwei ListBoxen gleichzeitig scrollen?

[Gina]

Hallochen,

wie kann man zwei nebeneinanderliegende ListBoxen miteinander verbinden, dass sie gleichzeitig scrollen?

Vielen Dank, Gina.

[toms]

Hallo,

Schaue mal hier.

[Chegga]

Hi,

ein bisschen Suchen hätte es mehr als getan.
*Klick*

MfG Marc

[sniper_w]

Hier etwas Konkretes:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TMyListBox = class(TListBox)
  private
    FRef : TCustomListBox;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Reference : TCustomListBox read FRef write FRef;
  end;
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    LBox : TMyListBox;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
 var a:integer;
begin
 Randomize;
  LBox := TMyListBox.Create(self);
  with LBox do
  begin
   Parent := Self;
   Visible := true;
   Top := 10;
   Left := 10;
   Width := 200;
   Height := 200;
   Reference := listbox1;
  end;

  for a:=0 to 100 do
  begin
   ListBox1.Items.Add(IntToStr(Random(100000)));
   LBox.Items.Add(IntToStr(Random(100000)));
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 LBox.Free;
end;

{ TMyListBox }

constructor TMyListBox.Create(AOwner: TComponent);
begin
  inherited;
  FRef := nil;
end;

procedure TMyListBox.WMHScroll(var Message: TWMHScroll);
begin
 inherited;
end;

procedure TMyListBox.WMVScroll(var Message: TWMVScroll);
begin
 inherited;
 if Assigned(FRef) then FRef.TopIndex := TopIndex;
end;

[Gina]

Hallo,

sorry, wenn ich mich erst so spät melde. Vielen lieben Dank erstmal für Eure antworten.

Ich habe bereits einiges ausprobiert. Das ist genau das, was ich gesucht habe. Allerdings funktioniert es nur, wenn ich mit der Maus auf den Scrollbalken klicke und diesen verschiebe. Nun möchte ich natürlich auch gerne, dass es auch beim Scrollen mit dem Mausrad funktioniert.

Leider kenne ich mich mit den Messages noch nicht so gut aus. Könnt ihr mir please erklären, auf welche Message ich da reagieren muss?

Herzlichen Dank, Gina.

[sniper_w]

Hier die notwendigen Änderungen:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TMyListBox = class(TListBox)
  private
    FRef : TCustomListBox;
    procedure WMMouseWheel(var Message: TWMMOUSEWHEEL); message WM_MOUSEWHEEL;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Reference : TCustomListBox read FRef write FRef;
  end;
//...
{ TMyListBox }

procedure TMyListBox.WMMouseWheel(var Message: TWMMOUSEWHEEL);
begin
inherited;
if Assigned(FRef) then FRef.TopIndex := TopIndex;
end;

[Gina]

Hallo,

sorry, ich hätte vielleicht noch dazu sagen sollen, für welche Variante ich mich entschieden habe...

http://www.delphipraxis.net/internal...=311415#311415

Zu dieser kleinen Komponente wollte ich gerne das Scrollen per Rad ergänzen, aber ich finde einfach nicht die richtigen Messages...

Hier mal mein bisheriger Code:

Delphi-Quellcode:

unit scrolllist;

interface

uses
  Messages, Classes, StdCtrls;

type
  ListScrollBox = class(TListBox)
  private
    FOnScroll: TScrollEvent;
    procedure WMMouseWheel(var Message: TWMMOUSEWHEEL); message WM_MOUSEWHEEL;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  published
    property OnScroll: TScrollEvent read FOnSCroll write FOnScroll;
  end;

  procedure Register;

implementation

uses Controls;

procedure ListScrollBox.WMMouseWheel(var Message: TWMMOUSEWHEEL);
begin
  if Message.WheelDelta > 0 then
    Perform(WM_VSCROLL, SB_LINEUP, 0) ---> hier bekomme ich eine Fehlermeldung wegen SB_LINEUP
  else
    Perform(WM_VSCROLL, SB_LINEDOWN, 0);  ---> hier bekomme ich eine Fehlermeldung wegen SB_LINEDOWN
  Message.Result := 0;
end;

procedure ListScrollBox.WMHScroll(var Message: TWMHScroll);
var
  ScrollPos: Integer;
begin
  inherited;
  ScrollPos := Message.Pos;
  if Assigned(FOnScroll) then
    if TScrollCode(Message.ScrollCode) in [scLineUp, scLineDown,
     scPageUp, scPageDown, scPosition, scTop, scBottom] then
      FOnScroll(Self, TScrollCode(Message.ScrollCode), ScrollPos);
end;

procedure ListScrollBox.WMVScroll(var Message: TWMVScroll);
var
  ScrollPos: Integer;
begin
  inherited;
  ScrollPos := Message.Pos;
  if Assigned(FOnScroll) then
    if TScrollCode(Message.ScrollCode) in [scLineUp, scLineDown,
     scPageUp, scPageDown, scPosition, scTop, scBottom] then
      FOnScroll(Self, TScrollCode(Message.ScrollCode), ScrollPos);
end;

procedure Register;
begin
  RegisterComponents('Samples',[ListScrollBox]);
end;

end.

Wo liegt mein Fehler please?

Tausend Dank, Gina.

[sniper_w]

Die Fehler kommt deswegen, weil du WINDOWS unit nicht eingebunden hast.

Delphi-Quellcode:

uses
  Messages, Classes, StdCtrls, [b]WINDOWS[/b] ;

[Gina]

Ach ich Dummerchen...

Danke dir ganz dolle, jetzt funktioniert es super... http://www.oschboard.de/images/smilies/37.gif

Liebe Grüße, Gina.