« ■Delphi Hour in Tokyo にネットから参加しました。 | トップページ | ■TMS Advanced ToolBars & Menusアップデート »

☆ListBoxのlbOwnerDrawVariableの不思議?

ListBoxの各アイテム毎の高さを変えて表示するには、StyleプロパティをlbOwnerDrawVariableに設定し、OnDrawItem、OnMeasureItemイベントの処理を書きます。 しかしそれだけでは OnMeasureItem が発生せず、なぜかMultiSelectをTrueにする必要があるようです。 高さが可変なのと複数行選択には、関連がなさそうなのですけど仕様なのでしょうか。 いつもMultiSelectがTrueの状態で使っていたので、今まで気付きませんでした。

又、アイテムの高さには制限があるようです。これについて少し調べてみました。 下記のようなプログラムを作成して、どこまできちんと描画されているかを確認しました。

ボタンを押すとフォントのサイズが1つ大きくなり、再描画するようにしています。

Lb1


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure SetSample;
var
  I :Integer;
begin
  with Form1 do
  begin
    ListBox1.Font.Size := ListBox1.Font.Size + 1;
    Edit1.Text := IntToStr(ListBox1.Font.Size);

    Memo1.Lines.Clear;
    ListBox1.Items.Clear;
    for I := 0 to 80 do
      ListBox1.Items.Add(IntToStr(I));
    ListBox1.ItemIndex := 0;
  end;
end;

function GetRowCount(Index: Integer): Integer;
begin
  Result := Index mod 30;
end;

function GetFontHeight: Integer;
begin
  with Form1 do
  Result := Abs(Trunc((-ListBox1.Font.Size *
    ListBox1.Font.PixelsPerInch) / 72)) + 4;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Font.Size := 7;
  SetSample;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetSample;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  I, J, Row: Integer;
begin
  // 行がわかりやすいように色を変えます
  if Index mod 2 = 0 then
  begin
    ListBox1.Canvas.Brush.Color := clwhite;
    ListBox1.Canvas.Font.Color := clBlue;
  end
  else
  begin
    ListBox1.Canvas.Brush.Color := $00D3F8FF;
    ListBox1.Canvas.Font.Color := clBlack;
  end;

  ListBox1.Canvas.FillRect(Rect);
  Row := GetRowCount(Index+1);
  for I := 0 to Row - 1 do
  begin
    J := Rect.Top + GetFontHeight * I;
    ListBox1.Canvas.TextOut(Rect.Left, J, Format('Item%d',[Index+1]));
  end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  Height := GetFontHeight * GetRowCount(Index+1) ;
  Memo1.LInes.Add(Format('%d---%d',[Index+1, Height]) );
end;

end.

[Font.Size := 8 の場合] 252の高さまで、正常に表示されています。

Lb2


[Font.Size := 9 の場合] 256の高さで、アイテムは表示すらされていません。

Lb3


[Font.Size := 10 の場合] 255の高さまで、正常に表示されています。

Lb4


他のサイズも同じように調べ、その結果からわかったことは、OnMeasureItemのHeightは256未満でないと、 この処理では描画できないということです。 (256の場合には、表示すらされていません。)
でもlbOwnerDrawFixedの場合は、ItemHeightに256を入れても問題なく動作しているんですよね。
可変高さで、全ての項目を表示したい場合には、ListBoxをあきらめてStringGridを使うか、最終行に「省略されています」というような表示が必要に なりますね。

|

« ■Delphi Hour in Tokyo にネットから参加しました。 | トップページ | ■TMS Advanced ToolBars & Menusアップデート »