☆２つのListViewを同期させる(その２)
データを比較して、見やすく表示できないかという相談があり、以前、ListViewを同期させるプログラムを書いてるからすぐにできるよっと言ってしまったものの、私のプログラム Windows 7 pro 32bit, Delphi XE2 proの環境で全く役に立たないではないですか(>_<)
当時作ったプログラムは、問題なく動作していることからプログラム環境の問題なんでしょうね。
ということで、再び同期のプログラムにトライすることになりました。下記のコードで一応動いているようですが、あまり検証していないため変なところがあるかも知れません。でも全く役に立たないコードよりましだと思いますので、一応載せておきますね。
サブクラスには、Mr.XRAYさん（Halbowさん）のサブクラス化コンポーネントを使わせて頂いています。
サブクラス化コンポーネント
SubClassUnit
http://mrxray.on.coocan.jp/Halbow/Notes/N004.html
サブクラスには、Mr.XRAYさん（Halbowさん）のサブクラス化コンポーネントを使わせて頂いています。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Controls, Vcl.Forms, Vcl.ComCtrls, Vcl.ExtCtrls,
Vcl.Buttons, Vcl.StdCtrls, SubClassUnit;
type
TForm1 = class(TForm)
Panel1: TPanel;
ListView1: TListView;
ListView2: TListView;
SubClass1: TSubClass;
SubClass2: TSubClass;
procedure FormCreate(Sender: TObject);
procedure ListView1Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure ListView2Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure SubClass1MessageAfter(Sender: TObject; var Message: TMessage);
procedure SubClass2MessageAfter(Sender: TObject; var Message: TMessage);
private
LV1, LV2: TListView;
function SetActiveListView: Boolean;
procedure SyncScroll(Value: Integer = 0);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// 生成
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
Self.KeyPreview := True;
// vsReportでの同期
ListView1.ViewStyle := vsReport;
ListView2.ViewStyle := vsReport;
// ListView1とListView2のHeightを同期させるために合わせる。
ListView2.Height := ListView1.Height;
// Sampleデータ
for I := 0 to 1000 do
begin
ListView1.Items.Add.Caption := 'Left'+IntToStr(I);
ListView2.Items.Add.Caption := 'Right'+IntToStr(I);
end;
ListView1.Items[0].Selected := True;
end;
// ListViewの設定をします。
function TForm1.SetActiveListView: Boolean;
begin
Result := False;
if (ActiveControl is TListView) and
(((ActiveControl as TListView) = ListView1) or
((ActiveControl as TListView) = ListView2)) then
begin
if (ActiveControl as TListView) = ListView1 then
begin
LV1 := ListView1;
LV2 := ListView2;
end
else
begin
LV2 := ListView1;
LV1 := ListView2;
end;
Result := True;
end;
end;
// スクロールさせます。
// Value: スクロール量（コントロールパネルのマウスで設定されているもの）
procedure TForm1.SyncScroll(Value: Integer = 0);
var
R: TRect;
I, J, K: Integer;
begin
if SetActiveListView and Assigned(LV1.TopItem) and Assigned(LV2.TopItem) then
begin
I := LV1.TopItem.Index;
J := LV2.TopItem.Index;
R := LV2.Items[0].DisplayRect(drBounds);
K := (I-J)+Value;
LV2.Scroll(0, K * (R.Bottom - R.Top));
end;
end;
// キーによる同期
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// Keyを押し続けている時に、表示を更新するため
FormKeyUp(Self, Key, Shift);
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
SyncScroll;
end;
// マウススクロールによる同期
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
var
Value: Integer;
begin
Value := Mouse.WheelScrollLines;
SyncScroll(Value);
end;
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
var
Value: Integer;
begin
Value := Mouse.WheelScrollLines;
SyncScroll(-Value);
end;
// サブクラス
procedure TForm1.SubClass1MessageAfter(Sender: TObject; var Message: TMessage);
begin
if message.Msg = WM_VSCROLL then
begin
if ActiveControl <> ListView1 then
ActiveControl := ListView1;
SyncScroll;
end;
end;
procedure TForm1.SubClass2MessageAfter(Sender: TObject; var Message: TMessage);
begin
if message.Msg = WM_VSCROLL then
begin
if ActiveControl <> ListView2 then
ActiveControl := ListView2;
SyncScroll;
end;
end;
// 選択項目を合わせます。
procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
ListView2.OnChange := nil;
try
if Assigned(ListView1.Selected) then
ListView2.Items[ListView1.ItemIndex].Selected := True;
finally
ListView2.OnChange := ListView2Change;
end;
end;
procedure TForm1.ListView2Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
ListView1.OnChange := nil;
try
if Assigned(ListView2.Selected) then
ListView1.Items[ListView2.ItemIndex].Selected := True;
finally
ListView1.OnChange := ListView1Change;
end;
end;
end.
サブクラス化コンポーネント
SubClassUnit
http://mrxray.on.coocan.jp/Halbow/Notes/N004.html
| 固定リンク
