☆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を同期させる

サブアイテム数が多くて見づらいデータがあったので２つの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を修正しました。