☆2つのListViewを同期させる(その2)
サブクラスには、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
| 固定リンク