هماهنگ کردن 2 تا listview

[mossaferin]

سلام

فرض کنید که دوتا listview داریم با تعداد ایتم های برابر

چگونه میشه کاری کرد که وقتی اسکرول بار هر کدام را تغییر میدهیم ، هر دو باهم تغییر کنند ؟


اگر کامپوننتی هم باشه که این امکان رو داشته باشه ، عالیه

[mossaferin]

هیچ کسی ، هیچ نظری نداره ؟

[مصطفی ساتکی]

این هم کدش

type
TForm2 = class(TForm)
ListView1: TListView;
ListView2: TListView;
procedure FormCreate(Sender: TObject);
private
public
WndMethod : TWndMethod;

procedure Wporc(var Msg : TMessage);
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
WndMethod := ListView1.WindowProc;
ListView1.WindowProc := wporc;
end;

procedure TForm2.Wporc(var Msg: TMessage);
begin
WndMethod(Msg);
if Msg.Msg = WM_VSCROLL then
SendMessage(ListView2.Handle,Msg.Msg, Msg.WParam,Msg.LParam);

end;

[مصطفی ساتکی]

این هم برای همزمان کردن هر دو

unit Unit2;

interface

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

type
TForm2 = class(TForm)
Button1: TButton;
ListView1: TListView;
ListView2: TListView;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
WndMethod ,WndMethod2 : TWndMethod;
FShowHoriz: Boolean;
FShowVert: Boolean;
b : Boolean;
procedure Wporc(var Msg : TMessage);
procedure Wporc2(var Msg : TMessage);
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
b := False;
WndMethod := ListView1.WindowProc;
WndMethod2 := ListView2.WindowProc;
ListView1.WindowProc := wporc;
ListView2.WindowProc := wporc2;
end;

procedure TForm2.Wporc(var Msg: TMessage);
begin
WndMethod(Msg);
if b =false then
begin

b := True;
if Msg.Msg = WM_VSCROLL then
SendMessage(ListView2.Handle,Msg.Msg, Msg.WParam,Msg.LParam);
b := False;
end;


end;

procedure TForm2.Wporc2(var Msg: TMessage);
begin
WndMethod2(Msg);
begin
b := True;

if Msg.Msg = WM_VSCROLL then
SendMessage(ListView1.Handle,Msg.Msg, Msg.WParam,Msg.LParam);
b := False;
end;

end;

end.

[mossaferin]

ممنون از توجه شما

کار زیبایی انجام دادی، ولی دوتا اشکال داره
1- در صورتی که از دستگیره اسکرول بار برای جابجایی استفاده کنیم ، کار نمی کنه
2- وقتی هم مثلا کلید سمت چپ ماوس رو روی page اسکرول بار پایین نگه میداریم ، یکی سریعتر حرکت میکنه و در نتیجه هماهنگی از بین میره یعنی هردو بالا میرن ولی نه مثل هم (یکی رو ایتم 100 یکی رو 170)

راه دیگه ای وجود داره ؟

[مصطفی ساتکی]

این کد کاملش


unit Unit2;

interface

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

type
TForm2 = class(TForm)
ListView1: TListView;
ListView2: TListView;
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
WndMethod1 ,WndMethod2 : TWndMethod;
b : Boolean;
preNpos1,PreNpos2 : Integer;
procedure Wporc1(var Msg : TMessage);
procedure Wporc2(var Msg : TMessage);
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Memo1.Lines.Count > 100 then
Memo1.Lines.Clear;
if Msg.hwnd = ListView1.Handle then

Memo1.Lines.Add(format('err:%d',[Msg.message]));
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ListView1.WindowProc := WndMethod1;

ListView2.WindowProc := WndMethod2;

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
preNpos1 := 0;
PreNpos2 := 0;
b := False;
WndMethod1 := ListView1.WindowProc;
WndMethod2 := ListView2.WindowProc;
ListView1.WindowProc := wporc1;
ListView2.WindowProc := wporc2;
end;

procedure TForm2.Wporc1(var Msg: TMessage);
var npos : WPARAM;
begin
WndMethod1(Msg);

if b = False then

if (Msg.Msg = WM_VSCROLL) then
begin
b := true;
SendMessage(ListView2.Handle,Msg.Msg,Msg.WParam ,0);
npos := GetScrollPos(ListView1.Handle,SB_VERT);
SetScrollPos(ListView2.Handle, SB_VERT, npos, True);
b := False;
end
else begin
b := True;
npos := GetScrollPos(ListView1.Handle,SB_VERT);
if npos <> preNpos1 then
begin
SetScrollPos(ListView2.Handle, SB_VERT, npos, True);
preNpos1 := npos;
end;
b := False;
end;

end;

procedure TForm2.Wporc2(var Msg: TMessage);
var npos : WPARAM;
begin
WndMethod2(Msg);

if b = False then

if (Msg.Msg = WM_VSCROLL) then
begin
b := true;
SendMessage(ListView1.Handle,Msg.Msg,Msg.WParam ,0);
npos := GetScrollPos(ListView2.Handle,SB_VERT);
SetScrollPos(ListView1.Handle, SB_VERT, npos, True);
b := False;
end
else begin
b := True;
npos := GetScrollPos(ListView2.Handle,SB_VERT);
if npos <> preNpos2 then
begin
SetScrollPos(ListView1.Handle, SB_VERT, npos, True);
preNpos2 := npos;
end;
b := False;
end;

end;

end.

[mossaferin]

با سلام و تشکر

کد شما با این اصلاح جدید هر دو اسکرول بار باهم حرکت می کردن ولی همچنان دیتا اسکرول نمی شد که من با کمی تغییر این قضیه رو حل کردم ( کد زیر )
ولی باز هم یه مشکل کوچیک داره که ، وقتی که اسکرول بالا میاد کاملا هماهنگه ، ولی موقع پایین رفتن چند تایی عقب میمونه که نمیدونم اشکالش کجاست



unit Unit2;

interface

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

type
TForm2 = class(TForm)
ListView1: TListView;
ListView2: TListView;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
WndMethod1 ,WndMethod2 : TWndMethod;
b : Boolean;
procedure Wporc1(var Msg : TMessage);
procedure Wporc2(var Msg : TMessage);
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Memo1.Lines.Count > 100 then
Memo1.Lines.Clear;
if Msg.hwnd = ListView1.Handle then
Memo1.Lines.Add(format('err:%d',[Msg.message]));
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ListView1.WindowProc := WndMethod1;
ListView2.WindowProc := WndMethod2;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
b := False;
WndMethod1 := ListView1.WindowProc;
WndMethod2 := ListView2.WindowProc;
ListView1.WindowProc := wporc1;
ListView2.WindowProc := wporc2;
end;

procedure TForm2.Wporc1(var Msg: TMessage);
var npos : WPARAM;
begin
WndMethod1(Msg);

if b = False then
if (Msg.Msg = WM_VSCROLL) then
begin
b := True;
npos := GetScrollPos(ListView1.Handle,SB_VERT);
SetScrollPos(ListView2.Handle, SB_VERT, npos, True);
ListView2.Items.Item[npos].MakeVisible(true);
b := False;
end;

end;

procedure TForm2.Wporc2(var Msg: TMessage);
var npos : WPARAM;
begin
WndMethod2(Msg);

if b = False then
if (Msg.Msg = WM_VSCROLL) then
begin
b := True;
npos := GetScrollPos(ListView2.Handle,SB_VERT);
SetScrollPos(ListView1.Handle, SB_VERT, npos, True);
ListView1.Items.Item[npos].MakeVisible(true);
b := False;
end;

end;

procedure TForm2.FormShow(Sender: TObject);
var
i:integer;
begin
ListView1.Items.Clear;
ListView2.Items.Clear;
for i:=1 to 1000 do
begin
with ListView1.Items.Add do
begin
Caption := 'test';
SubItems.Add(inttostr(i));
end;
with ListView2.Items.Add do
begin
Caption :='new';
SubItems.Add(inttostr(i));
end;
end;
end;


end.
به هر حال من یه کامپوننت به نام Easylistview که رایگان و سورس بازهم هست پیدا کردم که این کار رو انجام میده

خود کامپوننت
http://www.mustangpeak.net/download/components/easylistviewsetup.exe
کتابخانه های مورد نیاز
http://www.mustangpeak.net/download/components/mustangpeakcommonlib.exe
فایلهای مثال
http://www.mustangpeak.net/download/easylistviewdemo.zip


البته اگه بشه که از listview خود دلفی استفاده کرد بهتره ، چون کار با اون کامپوننت کمی مشکله