TIA
Reid
It synchronizes two listboxes but you could change the code to work with
many listboxes.
tom
"Reid" <rsi...@networld.com> wrote in message news:3b4cd1c3_2@dnews...
Reid
"tom" <t...@swissdelphicenter.ch> wrote in message news:3b4d46f5_2@dnews...
You catch the window messages that make the listbox scroll and pass them on to
the other listboxes. As it turns out this involves a bit more than passing on
the WM_VSCROLL and WM_HSCROLL messages the scrollbars generate when you
manipulate them with the mouse. The listboxes also can be scrolled using the
keyboard and (typically MS) they don't do that by sending scroll messages to
themselves when they get the keys. So we also have to pass on the key
messages. The following unit implements a TListbox descendent that will
automatically sync with all other listboxes of the same class sitting on the
same parent. Save the unit to a file PBSyncListbox.pas and install it in the
component palette with Component->Install component. You can use the standard
dclusr package to install the component into. This should get you a new
palette tab named PBGoodies, on which you can find the component.
unit PBSyncListbox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TSyncKind = (skBoth, skVScroll, skHScroll, skNone);
TPBSyncListbox = class(TListbox)
private
FInSync: Boolean;
FSyncKind: TSyncKind;
Procedure WMVScroll( Var Msg: TMessage ); message WM_VSCROLL;
Procedure WMHScroll( Var Msg: TMessage ); message WM_HSCROLL;
Procedure WMKeyDown( Var Msg: TMessage ); message WM_KEYDOWN;
Procedure WMKeyUp ( Var Msg: TMessage ); message WM_KEYUP;
Procedure WMChar ( Var Msg: TMessage ); message WM_CHAR;
protected
Procedure Sync( msg, wparam: Integer; lparam: longint ); virtual;
public
Procedure DoSync( msg, wparam: Integer; lparam: longint ); virtual;
published
property SyncKind: TSyncKind read FSyncKind write FSyncKind default
skBoth;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PBGoodies', [TPBSyncListbox]);
end;
{ TPBSyncListbox }
procedure TPBSyncListbox.DoSync(msg, wparam, lparam: Integer);
begin
If FSyncKind = skNone Then Exit;
FInSync := True;
try
Perform( msg, wparam, lparam );
finally
FInSync := False;
end;
end;
procedure TPBSyncListbox.Sync(msg, wparam, lparam: Integer);
var
i: Integer;
begin
If Assigned( Parent ) Then
For i:= 0 To Parent.Controlcount-1 Do
If (Parent.Controls[i] Is TPBSyncListbox)
and not (Parent.Controls[i] = Self)
Then
TPBSyncListbox( Parent.Controls[i] ).DoSync( msg, wparam, lparam );
end;
procedure TPBSyncListbox.WMChar(var Msg: TMessage);
begin
If not FInSync and (FSyncKind <> skNone) Then
Sync( WM_CHAR, msg.wparam, msg.lparam );
inherited;
end;
procedure TPBSyncListbox.WMHScroll(var Msg: TMessage);
begin
If not FInSync and (FSyncKind In [skBoth, skHScroll]) Then
Sync( WM_HSCROLL, msg.wparam, msg.lparam );
inherited;
end;
procedure TPBSyncListbox.WMKeyDown(var Msg: TMessage);
begin
If not FInSync and (FSyncKind <> skNone) Then
Sync( WM_KEYDOWN, msg.wparam, msg.lparam );
inherited;
end;
procedure TPBSyncListbox.WMKeyUp(var Msg: TMessage);
begin
If not FInSync and (FSyncKind <> skNone) Then
Sync( WM_KEYUP, msg.wparam, msg.lparam );
inherited;
end;
procedure TPBSyncListbox.WMVScroll(var Msg: TMessage);
begin
If not FInSync and (FSyncKind In [skBoth, skVScroll]) Then
Sync( WM_VSCROLL, msg.wparam, msg.lparam );
inherited;
end;
end.
If you want to play with this create a new project, add PBSyncListbox to its
Uses clause, add an OnCreate event handler and modify it like
procedure TForm1.FormCreate(Sender: TObject);
var
i, k, x: Integer;
lb: TPBSyncListbox;
begin
x:= 8;
For i:= 1 To 4 Do Begin
lb:= TPBSyncListbox.Create(self);
lb.Parent := self;
lb.SetBounds( x, 8, lb.Width, lb.Height );
if i=3 then lb.Synckind := skNone;
Inc(x, lb.width+8 );
For k:= 1 To 20 Do
lb.Items.Add( format('%s: Item %d, a bit long',[Chr(k-1+Ord('a')),k] ));
lb.Perform( LB_SETHORIZONTALEXTENT, lb.Width*2, 0);
End;
end;
This create 4 of these listboxes in code, the 3rd of which will not be
sync'ed with the others since its SyncKind is set to skNone. The others will
sync both vertical and horizontal scrolls.
Peter Below (TeamB) 10011...@compuserve.com)
No e-mail responses, please, unless explicitly requested!
Note: I'm unable to visit the newsgroups every day at the moment,
so be patient if you don't get a reply immediately.
Reid
"Peter Below (TeamB)" <10011...@compuXXserve.com> wrote in message
news:VA.0000749...@antispam.compuserve.com...