☆２つのListViewを同期させる(その２)

データを比較して、見やすく表示できないかという相談があり、以前、ListViewを同期させるプログラムを書いてるからすぐにできるよっと言ってしまったものの、私のプログラム Windows 7 pro 32bit, Delphi XE2 proの環境で全く役に立たないではないですか(>_<) 当時作ったプログラムは、問題なく動作していることからプログラム環境の問題なんでしょうね。 ということで、再び同期のプログラムにトライすることになりました。下記のコードで一応動いているようですが、あまり検証していないため変なところがあるかも知れません。でも全く役に立たないコードよりましだと思いますので、一応載せておきますね。

サブクラスには、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

☆ListViewでのグループ表示

ListViewのアイテムをグループ表示させるサンプルを見つけたので試してみました。

uses commctrl;

type
  TLVGROUP = record
    cbSize: UINT;
    mask: UINT;
    pszHeader: LPWSTR;
    cchHeader: Integer;
    pszFooter: LPWSTR;
    cchFooter: Integer;
    iGroupIdL: Integer;
    stateMask: UINT;
    state: UINT;
    uAlign: UINT;
  end;

  tagLVITEMA = packed record
    mask: UINT;
    iItem: Integer;
    iSubItem: Integer;
    state: UINT;
    stateMask: UINT;
    pszText: PAnsiChar;
    cchTextMax: Integer;
    iImage: Integer;
    lParam: lParam;
    iIndent: Integer;
    iGroupId: Integer;
    cColumns: UINT;
    puColumns: PUINT;
  end;
  TLVITEMA = tagLVITEMA;

const
  LVM_ENABLEGROUPVIEW = LVM_FIRST + 157;
  LVM_INSERTGROUP = LVM_FIRST + 145;
  LVIF_GROUPID = $0100;
  LVGF_HEADER = $00000001;
  LVGF_ALIGN = $00000008;
  LVGF_GROUPID = $00000010;
  LVGA_HEADER_LEFT = $00000001;


procedure TForm1.FormCreate(Sender: TObject);
var
  LvGroup: TLVGROUP;
  LvItemA: TLVITEMA;
  LI: TListItem;
  I: Integer;
  S: PWideChar;
begin
  ListView1.Items.BeginUpdate;
  try
    // 初期設定
    ListView1.ViewStyle := vsReport;
    ListView1.Columns.Add.Caption := 'Musician';
    ListView1.Columns[0].Width := 250;

    // 項目
    LI := ListView1.Items.Add;
    LI.Caption := 'Deep Purple';
    LI := ListView1.Items.Add;
    LI.Caption := 'The Beatles';
    LI := ListView1.Items.Add;
    LI.Caption := 'Yngwie J. Malmsteen';
    LI := ListView1.Items.Add;
    LI.Caption := 'Sarah Vaughan';
    LI := ListView1.Items.Add;
    LI.Caption := 'Miles Davis';
    SendMessage(ListView1.Handle, LVM_ENABLEGROUPVIEW, 1, 0);

    // グループ
    for I := 0 to 1 do
    begin
      FillChar(LvGroup, SizeOf(TLVGROUP), 0);
      LvGroup.cbSize := SizeOf(TLVGROUP);
      LvGroup.mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;
      if I = 0 then
        S := 'Jazz'
      else
        S := 'Rock';
      LvGroup.pszHeader := S;
      LvGroup.cchHeader := Length(LvGroup.pszHeader);
      LvGroup.iGroupIdL := I;
      LvGroup.uAlign := LVGA_HEADER_LEFT;
      SendMessage(ListView1.Handle, LVM_INSERTGROUP, 0, Longint(@LvGroup));
    end;

    // グループの設定
    for I := 0 to ListView1.Items.Count - 1 do
    begin
      FillChar(LvItemA, SizeOf(TLvItemA), 0);
      LvItemA.mask := LVIF_GROUPID;
      LvItemA.iItem := I;
      if I < 3 then
        LvItemA.iGroupId := 1
      else if I < 5 then
        LvItemA.iGroupId := 0;
      SendMessage(ListView1.Handle, LVM_SETITEM, 0, Longint(@LvItemA))
    end;
  finally
    ListView1.Items.EndUpdate;
  end;
end;

Vistaでは更に拡張機能が使えそうです。下記のMSDNのリンクをご覧下さい。

SwissDelphiCenter.ch
...display the items in a listview control display as a group (XP)?
http://www.swissdelphicenter.ch/en/showcode.php?id=1782

MSDN
Windows と C++
Windows Vista コントロールの拡張
http://msdn2.microsoft.com/ja-jp/magazine/cc163384.aspx

☆ListViewのヘッダー高さを取得する。

ViewStyleがvsReportの場合のヘッダー高さを取得します。

マクロを使った処理

uses
  CommCtrl, Types;

function GetListViewHeaderHeight(ListView: TListView): Integer;
var
  Header_Handle: THandle;
  Rect: TRect;
begin
  Result := 0;
  Header_Handle := LISTVIEW_GETHEADER(ListView.Handle);
  if (ListView.Columns.Count > 0) then
  begin
    Header_GetItemRect(Header_Handle, 0, @Rect);
    Result := Rect.Bottom - Rect.Top;
  end;
end;

GetWindowPlacementを使った処理
変数名を変えたり、マクロで処理させていますが、基本的に下記サイトにある処理のままです(^^;

uses
  CommCtrl;

// ヘッダーの高さを取得します。
function GetListViewHeaderHeight(ListView: TListView): Integer;
var
  Header_Handle: HWND;
  WindowPlacement: TWindowPlacement;
begin
  Header_Handle := ListView_GetHeader(ListView.Handle);
  FillChar(WindowPlacement, SizeOf(WindowPlacement), 0);
  WindowPlacement.Length := SizeOf(WindowPlacement);
  GetWindowPlacement(Header_Handle, @WindowPlacement);
  Result  := WindowPlacement.rcNormalPosition.Bottom -
    WindowPlacement.rcNormalPosition.Top;
end;

[参考にしたサイト]

delphiDabbler.com
How to use the TListView OnCustomDrawXXX events
http://www.delphidabbler.com/articles?article=16

☆ListViewで選択行を削除する。

次のような処理で簡単に削除できます。

while ListView1.SelCount > 0 do
  ListView1.Selected.Delete;

このとき処理の内容によっては、次のようにOnChangeを無効にしないとエラーになったり、時間がかかったりすることがあります。又、アイテム数によっては、BeginUpdate～EndUpdateを使わないと処理が遅いです。

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListView1.Items.BeginUpdate;
  ListView1.OnChange := nil;
  try
    while ListView1.SelCount > 0 do
      ListView1.Selected.Delete;
  finally
    ListView1.OnChange := ListView1Change;
    ListView1.Items.EndUpdate;
  end;
end;

☆ListViewの項目並び替え

ListViewのカラムクリック時に項目の並び替えをするサンプルです。

// ソート用コールバック関数
function Sort(Item1,Item2: TListItem; Index: Integer): Integer; stdcall;
var
  S1, S2: String;
begin
  if Index = 0 then
    begin
      S1 := Item1.Caption;
      S2 := Item2.Caption;
    end
  else
    begin
      S1 := Item1.SubItems[Index-1];
      S2 := Item2.SubItems[Index-1];
    end;
  // 昇順  ascending order
  Result := AnsiCompareText(S1, S2);
  // 降順  descending order
  //Result := -Result;
end;     

procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  ListView1.CustomSort(@Sort, Column.Index);
end;

☆ListViewのヘッダーの色を変える。

ヘッダー(ViewStyleがvsReportのカラム部分)の色を変えたいと思い、 いろいろ探してみましたが、サンプルを見つけることができませんでした。 仕方がないので、いろいろと試行錯誤した結果、ほぼ期待通りの動作になったので、 書いておきますね。

※ListViewとして実際に使っていないので、いろいろと問題があるかも知れません。又、カラムをクリックした時、文字の再描画ができていないので、文字が沈まないという雑な作りです(^^;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    Header_Handle: HWND;
    procedure DrawColumns;
  public
  end;

  function NewHeaderWndProc(hWnd: HWND; Msg: UINT;
    WParam: wPARAM; lParam: LPARAM): LRESULT;  stdcall;

var
  Form1: TForm1;
  FOldHeaderWndProc: TFNWndProc;

implementation

{$R *.dfm}

uses
  ComObj, CommCtrl, GraphUtil;

function NewHeaderWndProc(hWnd: HWND; Msg: UINT;
  wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  Result := CallWindowProc(FOldHeaderWndProc, hWnd, Msg, wParam, lParam);
  case Msg of
    WM_PAINT: Form1.DrawColumns;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Header_Handle := ListView_GetHeader(ListView1.Handle);

  FOldHeaderWndProc := TFNWndProc(SetWindowLong(Header_Handle,
    GWL_WNDPROC, Longint(@NewHeaderWndProc)));
end;

procedure TForm1.DrawColumns;
var
  Header_Rect, Column_Rect, OutofColumns_Rect: TRect;
  I, X, W1, W2, CW: Integer;
  Canvas: TCanvas;
  Column: TListColumn;
  dwFormat: DWORD;
begin
  if Header_Handle = 0 then Exit;

  // Header領域を取得します。
  Windows.GetClientRect(Header_Handle, Header_Rect);

  // 境界の幅を取得します。
  W1 := GetSystemMetrics(SM_CXBORDER);
  W2 := GetSystemMetrics(SM_CXFIXEDFRAME) - W1;

  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetDC(Header_Handle);

    // カラムの描画
    X := 0;
    for I := 0 to ListView1.Columns.Count - 1 do
    begin
      Column := ListView1.Columns[I];
      CW := ListView1.Columns[I].Width;

      // 背景の描画
      Column_Rect := Rect(X+W1, W1, X+CW-W2, Header_Rect.Bottom-W2);
      GradientFillCanvas(Canvas, clWhite, $00CAC4C6, Column_Rect, gdVertical);
      SetBkMode(Canvas.Handle, TRANSPARENT);

      // 文字の描画
      Canvas.Font.Color := clBlack;

      dwFormat := DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS;
      case Column.Alignment of
        taRightJustify: dwFormat := dwFormat or DT_RIGHT;
        taCenter      : dwFormat := dwFormat or DT_CENTER;
      else
        dwFormat := dwFormat or DT_LEFT;
      end;
      InflateRect(Column_Rect, -4, 0);
      DrawText(Canvas.Handle, PChar(Column.Caption), -1, Column_Rect, dwFormat);
      X := X + CW;
    end;

    // Columnより右の部分の描画
    OutofColumns_Rect := Rect(X+W1, W1, Header_Rect.Right, Header_Rect.Bottom-W2);
    GradientFillCanvas(Canvas, clWhite, $00CAC4C6, OutofColumns_Rect, gdVertical);
  finally
    Canvas.Free;
  end;
end;

end.

☆ListViewの背景に画像を描画する。

DelphiFAQ.comを見ていたら、（ちょっと前の記事ですが）ListViewの背景に画像を描画する方法が載っていたので、早速試してみました。 DelphiFAQ.comでは、派生コンポーネントを使う方法で紹介されていましたが、こちらではサブクラスを使って実現したいと思います。 サブクラスには、前にも使わせて頂いたMr.XRAYさんところにあるHalbowさんのサブクラス化コンポーネントを使わせて頂きました。

注意すべき点は次の通りです。
１．ComObjを忘れない。
　　忘れてもコンパイルできますが、実行時にはエラーになります。
　　こういうエラーは原因がなかなかわからないですしね。
　　って、実は私自身がはまっていました(笑)
２．ListView1.DoubleBuffered を設定する。
　　ちらつきを抑えることができます。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    SubClass1: TSubClass;
    procedure ImageDraw;
  public
    procedure SubClass1MessageAfter(Sender: TObject;
      var Message: TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// ComObjがなくてもコンパイルはできますが、
// 実行時にエラーになります。
uses
  ComObj, CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // これを設定しないとちらつきます。
  ListView1.DoubleBuffered := True;

  // サブクラスの設定
  SubClass1:= TSubClass.Create(Self);
  SubClass1.TargetControl := ListView1;
  SubClass1.OnMessageAfter := SubClass1MessageAfter;

  // 背景画像の描画
  ImageDraw;
end;

procedure TForm1.SubClass1MessageAfter(Sender: TObject;
  var Message: TMessage);
begin
  if Message.Msg = WM_ERASEBKGND then
    ListView1.DefaultHandler(Message);
end;

procedure TForm1.ImageDraw;
var
  LVBKImage: TLVBKImage;
  S: String;
begin
  S := 'c:\windows\サポテック織り.bmp';

  LVBKImage.ulFlags := LVBKIF_SOURCE_URL or LVBKIF_STYLE_TILE;
  LVBKImage.hbm := 0;
  LVBKImage.pszImage := PChar(S);
  LVBKImage.cchImageMax := 0;
  LVBKImage.xOffsetPercent := 0;
  LVBKImage.yOffsetPercent := 0;
  // マクロを使ってみます。
  ListView_SetTextBkColor(ListView1.Handle, CLR_NONE);
  ListView_SetBkImage(ListView1.Handle, @LVBKImage);
end;

end.

DelphiFAQ.com
Putting a background image on a ListView (Delphi 7)

Delphi Library [Mr.XRAY]
サブクラス化コンポーネント

MSDN
ListView_SetBkImage Macro
LVBKIMAGE Structure
ListView_SetTextBkColor Macro

☆ListViewのDrag＆Drop

ViewStyleがvsReportに設定されたListViewのDrag&Dropの処理です。
ListViewは、Ctrl＋左クリックで飛び飛び選択？Shift＋左クリックで範囲選択？を行えますね。
ということで次の２点を考慮した処理にしたいと思います。

１．複数選択されたアイテムを扱える。
２．他のListViewへのDrag&Dropができる。(同じアイテムを表示している場合)
　　※自アプリ内に限ります。他アプリではOLE Drag&Drop処理が必要です。

通常DropTargetがnilの場合には、処理させないことが多いんじゃないかと思います。しかし今回は、他のListViewへのDrag&Dropも考慮するので、nilの場合には最後に追加する形で処理させたいと思います。

ListView1DragOver、ListView1DragDropは、ListView1、ListView2共に設定しておいて下さい。

procedure MakeSampleData(ListView: TListView);
var
  Column: TListColumn;
  ListItem: TListItem;
  I: Integer;
  S,S1,S2,S3: String;
begin
  ListView.ViewStyle := vsReport;

  // Columnの設定
  for I := 0 to 2 do
  begin
    Column := ListView.Columns.Add;
    case I of
      0: S := 'name';
      1: S := 'address';
      2: S := 'telephone';
    end;
    Column.Caption := S;
    Column.Width := 100;
  end;

  // ListItemの設定
  for I := 0 to 6 do
  begin
    ListItem := ListView.Items.Add;
    case I of
      0: begin
          S1 := '(1) hiderin';
          S2 := 'kyoto';
          S3 := '075-xxx-xxxx';
         end;
      1: begin
          S1 := '(2) yuki';
          S2 := 'tokyo';
          S3 := '03-xxxx-xxxx';
         end;
      2: begin
          S1 := '(3) picasso';
          S2 := 'barcelona';
          S3 := '932-xxx-xxx';
         end;
      3: begin
          S1 := '(4) momo';
          S2 := 'kobe';
          S3 := '078-xxx-xxxx';
         end;
      4: begin
          S1 := '(5) john';
          S2 := 'newyork';
          S3 := '212-xxx-xxxx';
         end;
      5: begin
          S1 := '(6) taro';
          S2 := 'fukuoka';
          S3 := '092-xxx-xxxx';
         end;
      6: begin
          S1 := '(7) jun';
          S2 := 'sapporo';
          S3 := '011-xxx-xxxx';
         end;
    end;

    ListItem.Caption := S1;
    ListItem.SubItems.Add(S2);
    ListItem.SubItems.Add(S3);
  end;
  ListView.DragMode := dmAutomatic;
  ListView.MultiSelect := True;
  
  // ドラッグ中のイメージをさせない---なんか中途半端で嫌なので(^^;
  ListView.ControlStyle := ListView.ControlStyle - [csDisplayDragImage];
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // アイテムを作成します。
  MakeSampleData(ListView1);
  MakeSampleData(ListView2);
end;

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := True;
end;

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  I: Integer;
begin
  for I := 0 to (Source as TListView).SelCount -1 do
  begin
    if ((Sender as TListView).DropTarget = nil) then
      // 追加
      (Sender as TListView).Items.Add.Assign((Source as TListView).Selected)
    else
      // 挿入
      (Sender as TListView).Items.Insert(
        (Sender as TListView).DropTarget.Index).Assign(
        (Source as TListView).Selected);

    (Source as TListView).Selected.Delete;
  end;
end;

Drag&Drop時に隠れているアイテムをスクロール表示させるには、TreeViewで行った方法がそのまま使えます。 ぜひ実装してより実用的なものにして下さい。

参考
☆TreeViewのDrag＆Drop

☆２つのListViewを同期させる

サブアイテム数が多くて見づらいデータがあったので２つのListViewを同期させようと思い、サンプルを作ってみました。 サブクラスにはコードを見やすくするため、次のコンポーネントを使わせて頂きました。（ユニットのまま使ってるけど）

SubClassUnit
http://homepage2.nifty.com/Mr_XRAY/Halbow/Notes/N004.html

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ListView2: TListView;
    procedure FormCreate(Sender: TObject);
  private
    procedure SubClass1MessageAfter(Sender: TObject;
      var message: TMessage);
    procedure SubClass2MessageAfter(Sender: TObject;
      var message: TMessage);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ListView2Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
  public
    SubClass1: TSubClass;
    SubClass2: TSubClass;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  // ListView1の設定
  ListView1.ViewStyle := vsreport;
  ListView1.Columns.Add.Caption := 'ListView1';
  ListView1.Columns[0].Width := 200;
  ListView1.Height := 150;
  ListView1.HideSelection := False;

  // ListView2の設定
  ListView2.ViewStyle := vsreport;
  ListView2.Columns.Add.Caption := 'ListView2';
  ListView2.Columns[0].Width := 200;
  ListView2.Height := 150;
  ListView2.HideSelection := False;

  // テストデータの設定
  for I := 0 to 100 do
  begin
    ListView1.Items.Add.Caption := 'Item1_'+IntToStr(I);
    ListView2.Items.Add.Caption := 'Item2_'+IntToStr(I);
  end;

  // OnChangeの設定
  ListView2.Onchange := ListView2change;
  ListView1.Onchange := ListView1change;

  // サブクラスの設定
  SubClass1:= TSubClass.Create(Self);
  SubClass1.TargetControl := ListView1;
  SubClass1.OnMessageAfter := SubClass1MessageAfter;

  // サブクラスの設定
  SubClass2:= TSubClass.Create(Self);
  SubClass2.TargetControl := ListView2;
  SubClass2.OnMessageAfter := SubClass2MessageAfter;
end;

procedure TForm1.SubClass1MessageAfter(Sender: TObject;
  var message: TMessage);
var
  I, J, K: Integer;
begin
  if message.Msg = 48206  then // 48206って何？
  begin
    if (ListView1.TopItem <> nil) and (ListView2.TopItem <> nil) then
    begin
      I := ListView1.TopItem.Index;
      J := ListView2.TopItem.Index;
      K := ListView1.VisibleRowCount;
      if I <> J then
      begin
        if I > J then
          ListView2.Scroll(0, K + ABS(J-I))
        else
          ListView2.Scroll(0, (I-J)-K);
      end;
    end;
  end;
end;

procedure TForm1.SubClass2MessageAfter(Sender: TObject;
  var message: TMessage);
var
  I, J, K: Integer;
begin
  if message.Msg = 48206 then
  begin
    if (ListView1.TopItem <> nil) and (ListView2.TopItem<>nil) then
    begin
      I := ListView2.TopItem.Index;
      J := ListView1.TopItem.Index;
      K := ListView1.VisibleRowCount;
      if I <> J then
      begin
        if I > J then
          ListView1.Scroll(0, K + ABS(J-I))
        else
          ListView1.Scroll(0, (I-J)-K);
      end;
    end;
  end;
end;

procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  ListView2.OnChange := nil;
  try
    if ListView1.Selected <> nil 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 ListView2.Selected <> nil then
      ListView1.Items[ListView2.ItemIndex].Selected := True;
  finally
    ListView1.OnChange := ListView1Change;
  end;
end;

end.

ソースの表示には、Hiroshi HorieさんのSource Converter1.20を使わせて頂きました。 Source Converter1.20はとても見やすいHTMLに変換してくれますので、行間が広いのは、ココログの設定のせいだと思います。→CSSを修正しました。

☆ListView.TopItemへの設定

[ Delphi7 ] ListViewの最上段に表示される項目をプログラム上で設定する必要があり、TopItemを使おうとしたのですが、これは読み込み専用プロパティでした。そこで次のような処理をしました。

var
　ListItem: TListItem;
　Pt: TPoint;
begin
　ListItem := ListView1.Selected;　//最上段に表示したい項目

　Pt := ListView1.TopItem.Position;
　Pt.y := ListItem.Position.y - Pt.y;
　ListView1.Scroll(0, Pt.y);
end;

※ListViewのViewStyleは、vsReportです。