第28章 イメージリスト

Windows95 から始まる Win32 OSになってからすでに久しいが、Win16 の時代を知っている世代として、Win32 OSになってまず目に付くユーザインタフェースの変更は、あらゆるボタンや項目やメニューにアイコンが用いられていることだった。もちろん、Win16 のときにも DelphiTBitBtn のようにグリフを表示しているものもあった。 SystemImageList_0.gifしかし、スタートメニューやタスクバーのボタンやトレイのアイコン、エクスプローラのツリービューやリストビューなどのあらゆる項目に小さなアイコンが表示されているのは、当時としては新鮮な驚きを与えたものだった。Win32 で導入されたコモンコントロールにこのような同じサイズの多数の画像を組織的に管理するツールがイメージリストとして実装されたのも、このようなユーザインタフェースの変更による要請からだと思われる。デスクトップのショートカットやエクスプローラのツリービューやリストビューに描画される多くのアイコンは、シェルのシステムイメージリストが管理している。 右図は、この章の第5節で調べるシステムイメージリストが管理しているアイコンの最初の50個を描画したものである。
多くのコモンコントロールと違いイメージリストは、子ウィンドウではなく、ハンドルで管理されるオブジェクトとして実装されている。この点で、ペンやブラシ、フォント、ビットマップなどと似ている。この章では、イメージリストについて調べることにしよう。 リストビューやツリービュー、ツールバーなどは、内部にイメージリストをもつ複合コントロールであるので、これらのコモンコントロールを調べるまえにイメージリストについて調べる必要がある。

28−0 この章の内容

第28章 イメージリスト
28−1 イメージリストを使ってみる
28−2 その他の関数も試してみる
28−3 ドラグドロップによる画像の移動
28−4 イメージリストのラッパークラス
28−5 システムイメージリスト
28−6 画像移動機能を追加する
27−7 まとめ


| arrw18c.gif 前の章へ | 総目次へ | 次の章へ arrw18d.gif

28−1 イメージリストを使ってみる

イメージリストには2種類あって、普通のベタのビットマップを表示するような nonmasked のものと、矩形でないアイコンのように画像の縁取り(マスク)を対にして持つ masked のものである。いずれかを作成時に指定する。 イメージリストは、内部で多数の画像を一つにまとめた横長のビットマップとして保持しているらしい。各画像は、ゼロからはじまるインデックスで参照される。 リストボックスの項目のように、同じサイズの画像について追加、削除、交換、全クリア、などの操作が行える。さらに、デバイスコンテキストハンドルと座標を指定して個々の画像を描画する事もできる。イメージリストはウィンドウではないので、これまでのコモンコントロールとちがってメッセージによって遠隔操作するのではなく、ハンドルを指定して関数によって操作する。 以下に、イメージリストに関する関数を列挙する。(関数名とその機能だけをしめす。)

ImageList_Add             一つまたは複数の画像を追加
ImageList_AddMasked       マスク色を指定してマスクを作成させて追加
ImageList_BeginDrag       一つのイメージのドラグ動作を開始
ImageList_Copy            画像をコピーまたは交換
ImageList_Create          イメージリストを作成する
ImageList_Destroy         イメージリストを破棄する
ImageList_DragEnter       ドラグ中のイメージを描画(初期動作)
ImageList_DragLeave       ドラグ中のイメージを隠す(終期動作)
ImageList_DragMove        ドラグ中のイメージを移動しながら描画
ImageList_DragShowNolock  ドラグ中のイメージの描画のオン・オフ
ImageList_Draw            イメージを描画
ImageList_DrawEx          イメージの描画(拡張関数)
ImageList_DrawIndirect    イメージの描画(レコード型を使う)
ImageList_Duplicate       イメージリストの複製を作る
ImageList_EndDrag         ドラグ動作の終了
ImageList_GetBkColor      背景色の取得
ImageList_GetDragImage    ドラグ動作で一時的に作られるイメージリストの取得
ImageList_GetIcon         アイコンの作成・取得
ImageList_GetIconSize     現在の画像のサイズを取得
ImageList_GetImageCount   保持している画像の数を取得
ImageList_GetImageInfo    画像の情報を取得
ImageList_LoadImage       画像リソースをロードしてイメージリストを作成
ImageList_Merge           二つのイメージリストを結合して新しいイメージリストを作成
ImageList_Remove          画像の削除
ImageList_Replace         保持している画像を新しい画像と交換
ImageList_ReplaceIcon     保持しているアイコンを新しいアイコンと交換または追加
ImageList_SetBkColor      背景色の設定
ImageList_SetDragCursorImage   ドラグ中のカーソルのホットスポットを設定
ImageList_SetIconSize     画像をサイズを設定
ImageList_SetImageCount   保持する画像の数を予約
ImageList_SetOverlayImage   オーバーレイ画像の設定

ImageList_AddIcon         アイコンの追加
ImageList_ExtractIcon     イメージとマスクからアイコンを作成
ImageList_LoadBitmap      ビットマップリソースからロードしてイメージリストを作成
ImageList_RemoveAll       保持している全画像を破棄

この節では、これらのうちの幾つかを使用してイメージリストを作成し、それを使ってみよう。

イメージリストを作成する最も簡単な方法は ImageList_Create 関数を使うことである。

  function ImageList_Create(CX, CY: Integer; 
                             Flags: UINT;
                     Initial, Grow: Integer): HImageList; stdcall;
                     
  CX, CY : 保持する画像のサイズ
  Flags  : 下記のうちの組み合わせ
    const
      ILC_MASK                = $0001; //マスクを使用する
      ILC_COLOR               = $00FE; //デフォルト画像 ILC_COLOR4 と同等
      ILC_COLORDDB            = $00FE; 
      ILC_COLOR4              = $0004; //4ビット(16色)DIB
      ILC_COLOR8              = $0008; //8ビット(256色)DIB
      ILC_COLOR16             = $0010; //16ビットDIB
      ILC_COLOR24             = $0018; //24ビットDIB
      ILC_COLOR32             = $0020; //32ビットDIB

  Initial : 初期化のイメージ数(ゼロも可)
  Grow    : 追加にしたがって確保するイメージ数の単位(ゼロも可)
  
  戻り値  : イメージリストのハンドル、失敗ならゼロ
  
    type
      HImageList = THandle;

次に、作成したイメージリストにアイコンを追加してみよう。

  function ImageList_AddIcon(ImageList: HImageList; 
                                  Icon: HIcon): Integer;

第二パラメータに追加するアイコンのハンドルを指定する。戻り値は、格納されたインデックスである。失敗すると-1である。この関数には stdcall 呼び出し規約がないので分かると思うが、実際は ImageList_ReplaceIcon 関数を使った関数として実装されている。(Cのマクロに相当)

保持している画像を描画するには、ImageList_Draw を使う。

  function ImageList_Draw(ImageList: HImageList; 
                              Index: Integer;
                               Dest: HDC; 
                               X, Y: Integer; 
                              Style: UINT): Bool; stdcall;

  Index : 描く画像のインデックス
  Dest  : 描画するデバイスコンテキストハンドル
  X, Y  : 画像の左上隅の描画位置の座標
  Style : 以下のうちの幾つかを指定
  
    const
      ILD_NORMAL        = $0000; //背景色を使って表示、背景色がないときはマスクを使用
      ILD_TRANSPARENT   = $0001; //マスクを使って表示する(背景色を無視)
      ILD_MASK          = $0010; //マスク画像を表示する
      ILD_BLEND25       = $0002; //システムハイライト色を25%ブレンドする
      ILD_BLEND50       = $0004; //システムハイライト色を50%ブレンドする

      ILD_SELECTED      = ILD_BLEND50;
      ILD_FOCUS         = ILD_BLEND25;
      ILD_BLEND         = ILD_BLEND50;

背景色を設定するには、ImageList_SetBkColor を使う。

  function ImageList_SetBkColor(ImageList: HImageList; 
                                    ClrBk: COLORREF): COLORREF; stdcall;

  戻り値は設定前の背景色である

保持している画像の数を取得するには ImageList_GetImageCount を使う。

  function ImageList_GetImageCount(ImageList: HImageList): Integer; stdcall;

イメージリストを破棄するには、ImageList_Destroy を使う。

  function ImageList_Destroy(ImageList: HImageList): Bool; stdcall;

以上の6つの関数を試してみよう。

  1. エクスプローラを使って、新しいフォルダを 2801ImageList01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2707DragList02 フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pasCmCtrl.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで ImageList01.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

以下に ImageList01.dpr の全リストを示す。

program ImageList01;

uses
  windows,
  messages,
  CommCtrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  hIM: HImageList;
  ImageCount:integer;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function GetImageList:HImageList;
var
  i:integer;
  IconX,IconY:integer;
begin
  IconX := GetSystemMetrics(SM_CXICON);
  IconY := GetSystemMetrics(SM_CYICON);

  result := ImageList_Create(IconX,IconY,ILC_COLOR16 or ILC_MASK,0,0);

  for i := 0 to 5 do
    ImageList_AddIcon(result,LoadIcon(0,MakeIntResource(32512+i)));

  ImageCount := ImageList_GetImageCount(result);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
  i:integer;
begin
  if ImageCount > 0 then begin
    ImageList_SetBkColor(hIM,MainWnd.Color);
    DC := BeginPaint(MainWnd.Handle,ps);
      for i := 0 to ImageCount-1 do begin
        ImageList_Draw(hIM,i,DC,10+40*i,10,ILD_NORMAL);
        ImageList_Draw(hIM,i,DC,10+40*i,60,ILD_TRANSPARENT);
        ImageList_Draw(hIM,i,DC,10+40*i,100,ILD_MASK);
        ImageList_Draw(hIM,i,DC,10+40*i,140,ILD_NORMAL or ILD_BLEND25);
        ImageList_Draw(hIM,i,DC,10+40*i,180,ILD_NORMAL or ILD_BLEND50);
      end;
    EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  Randomize;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Trap(WM_PAINT, MainPaint);
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  if hIM = 0 then begin
    hIM := GetImageList;
  end
  else
    MainWnd.Color := RGB(200+Random(56),
                         200+Random(56),200+Random(56));
  Invalidaterect(MainWnd.Handle,nil,true);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  if hIM <> 0 then ImageList_Destroy(hIM);
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifImageList01.zip(24.699kB)
ImageList01.gif

実行して、Test! メニューをクリックすると右図のように6種類のシステムアイコンが表示される。二度目以降に Test! メニューをクリックするとメインウィンドウの背景色が変更される。

コードを調べよう。イメージリストは以下の関数で作成し、初期化している。

function GetImageList:HImageList;
var
  i:integer;
  IconX,IconY:integer;
begin
  IconX := GetSystemMetrics(SM_CXICON);
  IconY := GetSystemMetrics(SM_CYICON);

  result := ImageList_Create(IconX,IconY,ILC_COLOR16 or ILC_MASK,0,0);

  for i := 0 to 5 do
    ImageList_AddIcon(result,LoadIcon(0,MakeIntResource(32512+i)));

  ImageCount := ImageList_GetImageCount(result);
end;

システムアイコンのサイズをあらかじめ取得してから、ImageList_Create( ) を使って、16ビットカラー・マスク付きのものを作成している。 その後、 システムリソースのアイコンを取り出して ImageList_AddIcon( ) により追加している。

  { Standard Icon IDs }
  IDI_APPLICATION = MakeIntResource(32512);
  IDI_HAND        = MakeIntResource(32513);
  IDI_QUESTION    = MakeIntResource(32514);
  IDI_EXCLAMATION = MakeIntResource(32515);
  IDI_ASTERISK    = MakeIntResource(32516);
  IDI_WINLOGO     = MakeIntResource(32517);
  IDI_WARNING     = IDI_EXCLAMATION;
  IDI_ERROR       = IDI_HAND;
  IDI_INFORMATION = IDI_ASTERISK;

このアイコンは、ウィンドウズのバージョンによっては上の図と異なるものが表示されるかもしれない。 そのつぎに、グローバル変数 ImageCountImageList_GetImageCount( ) で実際に保持している画像の数を設定している。 WM_PAINT メッセージに同期してアイコンを描画する関数を見てみよう。

procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
  i:integer;
begin
  if ImageCount > 0 then begin
    ImageList_SetBkColor(hIM,MainWnd.Color);
    DC := BeginPaint(MainWnd.Handle,ps);
      for i := 0 to ImageCount-1 do begin
        ImageList_Draw(hIM,i,DC,10+40*i,10,ILD_NORMAL);
        ImageList_Draw(hIM,i,DC,10+40*i,60,ILD_TRANSPARENT);
        ImageList_Draw(hIM,i,DC,10+40*i,100,ILD_MASK);
        ImageList_Draw(hIM,i,DC,10+40*i,140,ILD_NORMAL or ILD_BLEND25);
        ImageList_Draw(hIM,i,DC,10+40*i,180,ILD_NORMAL or ILD_BLEND50);
      end;
    EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;

最初にイメージリストの背景色をメインウィンドウのそれと一致させる。アイコンは自前のマスク画像を持っているので、イメージリストに背景色を設定しなくても透過的に描画できる。それから、3−2 デバイスコンテキストとは何か? で示したように BeginPaint( ) でデバイスコンテキストハンドルを取得し、EndPaint( ) が実行される前に実際に描画している。 最後に Msg.Result := 1; として、これ以上このメッセージの処理をさせないようにする。

コードを見ると分かるように、6種類のアイコンが5段になって表示される。 一番上が ILD_NORMAL を設定して、設定された背景色を使って透過画像を表示している。二段目は、ILD_TRANSPARENT を設定してアイコンのマスクを使って表示している。これは最上段のものとまったく同じ表示が得られるが、背景色を設定して ILD_NORMAL で表示した方が効率がよいとレファレンスに書いてあった。3段目は、マスク画像のみを表示している。 これを見ると、どのようにして矩形でない形のアイコンを表示できるのか想像できるだろう。 マスク画像は、ビットマップ部分をそのまま描画する黒い部分と「透過」にする白い部分からなるモノクロ画像である。 4段目と5段目は、システムのハイライト色とのブレンドである。 システムのハイライト色は、メニューやリストボックスの「選択項目」やエディットコントロールの「選択範囲」の背景色である。上の図は、私のPCでの設定であるが、設定を忘れてしまったが、多分デフォルト色のままであろう。

最後に、アイコンのサイズについてですが

  IconX := GetSystemMetrics(SM_CXSMICON);
  IconY := GetSystemMetrics(SM_CYSMICON);

ImageList01_2.gifにして小さいアイコンのサイズにすると右図のような表示が得られる。タイトルバーやタスバーのボタン、ツールバーのボタンはこのサイズで描画されている。

redball.gifこの章の目次へ戻る

28−2 その他の関数も試してみる

前節でイメージリストの基本的な使い方が分かったので、その他の関数も試してみよう。

  1. エクスプローラを使って、新しいフォルダを 2802ImageList02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2801ImageList01 フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pasCmCtrl.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで ImageList02.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

以下に ImageList02.dpr の全リストを示す。

program ImageLIst02;

uses
  windows,
  messages,
  CommCtrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  hIM: HImageList;
  ImageCount:integer;
  BG:TBtnGroup;
  L1:TAPILabel;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function ImageList_Copy(himlDst:HIMAGELIST;iDst:integer;himlSrc:HIMAGELIST;
             iSrc:integer;uFlags:UINT): Integer;stdcall;
             external 'comctl32.dll' name 'ImageList_Copy';

const
  ILCF_MOVE   = $00000000;
  ILCF_SWAP   = $00000001;

function GetIconSize(hIcn:HICON):TSize;
var
  II:TIconInfo;
  BM:Windows.TBitmap;
begin
  GetIconInfo(hIcn,II);
  GetObject(II.hbmColor,SizeOf(BM),@BM);
  DeleteObject(II.hbmColor);
  DeleteObject(II.hbmMask);
  result.cx := BM.bmWidth;
  result.cy := BM.bmHeight;
end;

procedure SetSystemIcon(hIM:HImageList);
var
  i:integer;
  hIcn:HICON;
  Size:TSize;
begin
  hIcn := LoadIcon(0,IDI_APPLICATION);
  Size := GetIconSize(hIcn);
  ImageList_SetIconSize(hIM,Size.cx,Size.cy);

  for i := 0 to 5 do
    ImageList_AddIcon(hIM,LoadIcon(0,MakeIntResource(32512+i)));
end;

function GetImageListImageSize(hIm:HImageList):TSize;
var
  XMax,YMax,ICount,i:integer;
  II:TImageInfo;
begin
  result .cx := 0;
  result.cy := 0;
  XMax := 0;
  YMax := 0;

  ICount := ImageList_GetImageCount(hIm);
  if ICount = 0 then exit;

  for i := 0 to ICount-1 do begin
    ImageList_GetImageInfo(hIM,i,II);
    DeleteObject(II.hbmImage);
    DeleteObject(II.hbmMask);
    if II.rcImage.Right > XMax then XMax := II.rcImage.Right;
    if II.rcImage.Bottom > YMax then YMax := II.rcImage.Bottom;
  end;
  result.cx := XMax;
  result.cy := YMax;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
  i:integer;
begin
  if ImageCount > 0 then begin
    ImageList_SetBkColor(hIM,MainWnd.Color);
    DC := BeginPaint(MainWnd.Handle,ps);
      for i := 0 to ImageCount-1 do
        ImageList_Draw(hIM,i,DC,10+40*i,10,ILD_NORMAL);
     EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;

procedure BGClick(var Msg:TMessage);
var
  DC:HDC;
  CX,CY:integer;
  II:TImageInfo;
  hIcn:HICON;
  Size: TSize;
begin
  case Msg.WParam of
    0:begin
      ImageList_Copy(hIM,2,hIm,3,ILCF_SWAP);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
    1:begin
      ImageList_Copy(hIM,1,hIm,5,ILCF_MOVE);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
    2:begin
      Size := GetImageListImageSize(hIM);
      DC := GetDC(MainWnd.Handle);
        ImageList_GetIconSize(hIM,CX,CY);
        ImageList_DrawEx(hIM,0,DC,50,50,Size.cx,Size.cy,CLR_DEFAULT,
                                           CLR_DEFAULT,ILD_NORMAL);
      ReleaseDC(MainWnd.Handle,DC);
    end;
    3:begin
      ImageList_GetImageInfo(hIM,3,II);
      DeleteObject(II.hbmImage);
      DeleteObject(II.hbmMask);
      L1.Text := 'Left   : '+AIntToStr(II.rcImage.Left)+#13+
                 'Top    : '+AIntToStr(II.rcImage.Top)+#13+
                 'Right  : '+AIntToStr(II.rcImage.Right)+#13+
                 'Bottom : '+AIntToStr(II.rcImage.Bottom);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
    4:begin
      hIcn := ImageList_GetIcon(hIM,1,ILD_TRANSPARENT);
      DC := GetDC(MainWnd.Handle);
        DrawIconEx(DC,50,50,hIcn,100,100,0,0,DI_NORMAL);
      ReleaseDC(MainWnd.Handle,DC);
      DestroyIcon(hIcn);
    end;
    5:begin
      ImageList_Remove(hIM,1);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
  end;

end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hIM := ImageList_Create(10,10,ILC_COLOR24 or ILC_MASK,0,0);
  SetSystemIcon(hIM);
  ImageCount := ImageList_GetImageCount(hIM);

  BG := CreateBtnGroup(hWindow,true,200,50,150,230,6,BGClick);
  BG.Captions[0] := 'Swap 2,3';
  BG.Captions[1] := 'Copy to 1 form 5';
  BG.Captions[2] := 'DrawEx 0';
  BG.Captions[3] := 'ImageInfo 3';
  BG.Captions[4] := 'GetIcon 1';
  BG.Captions[5] := 'Remove 1';

  L1 := createLabel(hWindow,10,160,180,120,'');

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 290;
    Trap(WM_PAINT, MainPaint);
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MainWnd.Color := RGB(200+Random(56),
                         200+Random(56),200+Random(56));
  Invalidaterect(MainWnd.Handle,nil,true);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  if hIM <> 0 then ImageList_Destroy(hIM);
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifImageList02.zip(28.496kB)
ImageList02.gif

実行して、上から順にボタンを押して下から二番目のボタンまでを押したところでの様子を右図に示す。 ボタングループのキャプション通りの動作を確認できるだろう。

コードを調べよう。 わたしの Delphi3.1 には ImageList_Copy( ) とそれに使われる定数定義がないので Helper Functions の最初に以下のように定義しておいた。最新バージョンでは必要ないかもしれないので CommCtrl.pas で検索して調べてみてほしい。

function ImageList_Copy(himlDst:HIMAGELIST;iDst:integer;himlSrc:HIMAGELIST;
             iSrc:integer;uFlags:UINT): Integer;stdcall;
             external 'comctl32.dll' name 'ImageList_Copy';

const
  ILCF_MOVE   = $00000000;
  ILCF_SWAP   = $00000001;

MainCreate( ) ハンドラでは、

  hIM := ImageList_Create(10,10,ILC_COLOR24 or ILC_MASK,0,0);

として、保持する画像のサイズが 10x10 で、24ビットカラー、マスク付きのイメージリストを作成している。次に、作成したイメージリストに

  SetSystemIcon(hIM);

により、システムアイコンを6コ追加kしている。追加する前に、アイコンのサイズを取得して、保持するイメージのサイズを変更している。アイコンのサイズを取得するために GetIconSize( ) 関数を使っている。(ここではこれについては説明しない。)そして、ImageList_SetIconSize( ) によりサイズを変更している。

  function ImageList_SetIconSize(ImageList: HImageList;
                                    CX, CY: Integer): Bool; stdcall;

ここで、CX, CY によりサイズを変更する。 その後、前節でも使った ImageList_AddIcon( ) によりシステムアイコンを追加している。

ボタングループの一番上の 'Swap 2,3' を押すと、

  function ImageList_Copy(himlDst:HIMAGELIST;
                             iDst:integer;
                          himlSrc:HIMAGELIST;
                             iSrc:integer;
                           uFlags:UINT): Integer;stdcall;

uFlagsILCF_SWAP を指定してインデックスが2と3の画像を入れ替える。今のところ、himlDsthimlSrc には同一のイメージリストのハンドルを設定しなければならない。 'Copy to 1 form 5' ボタンを押すと ILCF_MOVEuFlags に指定して、 5のイメージが1のイメージのところにコピーされる。

'DrawEx 0' ボタンを押すと、イメージリストが保持しているイメージ全体のサイズを取得してから

function ImageList_DrawEx(ImageList: HImageList; 
                              Index: Integer;
                               Dest: HDC; 
                       X, Y, DX, DY: Integer; 
                             Bk, Fg: TColorRef; 
                              Style: Cardinal): Bool; stdcall;

を使って、イメージ全体を描画している。前に述べたように、イメージリストは追加したイメージを全体として一つのビットマップとして保持しているが、これは横長のビットマップではなく、この結果を見れば分かるように、四つ目のアイコンのところで下に折り返したビットマップとして保持している。 ImageList_DrawEx( ) では、インデックス単位でこの全体画像の一部または全部を描画する事ができる。 ここでは、GetImageListImageSize( ) 関数をつくって、保持している画像全体のサイズを取得している。それには、ImageList_GetImageInfo( ) を使う。

  function ImageList_GetImageInfo(ImageList: HImageList; 
                                      Index: Integer;
                              var ImageInfo: TImageInfo): Bool; stdcall;

これで、インデックスごとの画像の情報が TImageInfo レコードに返される。

type
  PImageInfo = ^TImageInfo;
  TImageInfo = packed record
    hbmImage: HBitmap; // イメージ部分のビットマップ
    hbmMask: HBitmap;  // マスク部分の白黒ビットマップ
    Unused1: Integer;  // 使用不可
    Unused2: Integer;  // 使用不可
    rcImage: TRect;    // 全体画像に対する指定画像の相対位置
  end;

このレコードの rcImage 部分を調べると、個別の画像が全体のビットマップのどの位置にあるかを知ることができる。'ImageInfo 3' ボタンを押すと、インデックス3の位置がラベルに示される。

'GetIcon 1' ボタンを押すと、マスクとカラーイメージが合成されてアイコンとして取り出すことができる。今の場合は、はじめからアイコンを追加したので同じものが得られる。

  function ImageList_GetIcon(ImageList: HImageList; 
                                 Index: Integer;
                                 Flags: Cardinal): HIcon; stdcall;

Flags には、合成する際の描画フラグを指定する。これは前節で示した ImageList_Draw( )Style パラメータに指定するのと同じものを指定する。ここでは、得られたアイコンハンドルをつかって 19−1 アイコンの使用法 で使った DrawIconEx( ) で拡大描画している。

'Remove 1' ボタンを押すと

  function ImageList_Remove(ImageList: HImageList; 
                                Index: Integer): Bool; stdcall;

を使って、インデックス1の画像を取り去っている。

redball.gifこの章の目次へ戻る

28−3 ドラグドロップによる画像の移動

イメージリストは、マウスによるイメージのドラグドロップによる移動をサポートしている。この機能により、表示のちらつきがなく驚くほどスムースな画像の移動が可能である。この節ではイメージリストを使って画像のドラグドロップによる移動の機能を試してみよう。

function ImageList_BeginDrag(ImageList: HImageList; 
                                 Track: Integer;
                    XHotSpot, YHotSpot: Integer): Bool; stdcall;

ドラグドロップによる画像の移動は ImageList_BeginDrag( ) により開始される。 これは移動するウィンドウないの WM_LBUTTONDOWN メッセージに同期して開始されることが多い。 Track には、ドラグするイメージのインデックスを指定する。XHotSpot, YHotSpot は、画像の左上の座標からみたマウスポインタのホットスポットの座標である。 画像の移動は、このホットスポットの対しておこなわれるので、マウスが画像を「つかんでいる」ように見せるために上記のような相対座標を計算して設定するのである。 次に、

function ImageList_DragEnter(LockWnd: HWnd; 
                                X, Y: Integer): Bool; stdcall;

を実行してドラグイメージの初期化を行う。 LockWnd はドラグイメージを描画するウィンドウのハンドルを指定する。X, Y には、ドラグイメージを描画する座標を指定する。 ややこしいのは、この座標が今まで使い慣れたクライアント領域の左上を原点とするものではなく、LockWnd で指定したウィンドウ全体の左上を原点とすることである。 ドラグ中の座標の指定は全てこのような座標系を用いる。 これで画像のドラグが開始される。つぎに、LochWnd で指定したウィンドウの WM_MOUSEMOVE メッセージに同期してドラグ移動中の画像を描画する。

function ImageList_DragMove(X, Y: Integer): Bool; stdcall;

この X, Y には、WM_MOUSEMOVE メッセージから得られる現在のマウス座標を、上記のウィンドウ全体の左上を原点とする座標に変換して設定する。最後に WM_LBUUTONUP メッセージに同期して座像のドラグ動作を終える。

function ImageList_EndDrag: Bool; stdcall;

そして最後に、ドラグ領域に設定したウィンドウをリセットする。

function ImageList_DragLeave(LockWnd: HWnd): Bool; stdcall;

これでドラグドロップによる画像の移動は完了する。最低、ここで示した五つの関数をこの順で実行することにより、イメージリストはマウスのドラグドロップによる画像の移動を自動的に行ってくれる。 それではさっそく試してみよう。

  1. エクスプローラを使って、新しいフォルダを 2803ImageList03 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2802ImageList02 フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pasCmCtrl.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで ImageList03.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

以下に ImageList03.dpr の全リストを示す。

program ImageList03;

uses
  windows,
  messages,
  CommCtrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  DD:TAPIDragDrop;
  hBM: HBITMAP;

  hIM: HImageList;
  ImageCount:integer;

  ImageX,ImageY:integer;

  DragRect:TRect;
  OffSetX,OffsetY:integer;
  ptHotSpot:TPoint;
  FlagDrag:Boolean;
  DragEnable:Boolean;

const
  InitialX = 10;
  InitialY = 10;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure InitCoordinate;
var
  p:TPoint;
  r:TRect;
begin
  p.x := 0; p.y := 0;
  Windows.ClientToScreen(MainWnd.Handle,p);
  Windows.GetWindowRect(MainWnd.Handle,r);
  OffsetX := p.x-r.Left;
  OffsetY := p.y-r.Top;
end;

function StartDrag(wnd:HWND;ptCur:TPoint;himl:hImageList):Boolean;
begin
  result := false;
  if not DragEnable then exit;
  if not Boolean(PtInRect(DragRect,ptCur)) then exit;

  SetCapture(wnd);

  ptHotSpot.x := ptCur.x - DragRect.left;
  ptHotSpot.y := ptCur.y - DragRect.top;

  if not Boolean(ImageList_BeginDrag(himl,0,
                 ptHotSpot.x,ptHotSpot.y)) then exit;

  ImageList_DragEnter(wnd,ptCur.x+OffsetX,ptCur.y+OffsetY);

  result := true;
end;

function MoveImage(ptCur:TPoint):Boolean;
begin
  result := Boolean(ImageList_DragMove(ptCur.x+OffsetX,ptCur.y+OffsetY));
end;

procedure EndDrag(wnd:HWND;himl:hImageList;ptCur:TPoint);
var
  x,y:integer;
begin
  ImageList_EndDrag;
  ImageList_DragLeave(wnd);
  FlagDrag := false;
  x := ptCur.x-ptHotSpot.x;
  y := ptCur.y-ptHotSpot.y;
  SetRect(DragRect,x,y,x+ImageX,y+ImageY);
  InvalidateRect(wnd,nil,true);

  ReleaseCapture;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure DDDrop(var Msg:TMessage);
var
  hBitM:HBITMAP;
  BM: Windows.TBitmap;
begin
  hBitM := LoadImage(0,PChar(DD.Files[0]),IMAGE_BITMAP,0,0,LR_LOADFROMFILE);
  if hBitM > 0  then begin
    DeleteObject(hBM);
    hBM := hBitM;
    GetObject(hBM,SizeOf(BM),@BM);
    ImageX := BM.bmWidth;
    ImageY := BM.bmHeight;
    ImageList_SetIconSize(hIM,ImageX,ImageY);
    ImageList_Add(hIM,hBM,0);
    ImageCount := ImageList_GetImageCount(hIM);
    SetRect(DragRect,InitialX,InitialY,InitialX+ImageX,InitialY+ImageX);
    Invalidaterect(MainWnd.Handle,nil,true);
  end;
end;

procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
begin
  if ImageCount >0 then begin
    DC := BeginPaint(MainWnd.Handle,ps);
      ImageList_Draw(hIM,0,DC,DragRect.Left,DragRect.Top,ILD_NORMAL);
    EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;

procedure MainLButtonDown(var Msg: TMessage);
var
  p:TPoint;
begin
  p.x := Msg.LParamLo;
  p.y := Msg.LParamHi;
  FlagDrag := StartDrag(MainWnd.Handle,p,hIM);
end;

procedure MainMouseMove(var Msg: TMessage);
var
  p:TPoint;
begin
  if not FlagDrag then exit;
  p.x := Msg.LParamLo;
  p.y := Msg.LParamHi;
  MoveImage(p);
end;

procedure MainLButtonUp(var Msg: TMessage);
var
  p:TPoint;
begin
  if not FlagDrag then exit;
  p.x := Msg.LParamLo;
  p.y := Msg.LParamHi;
  EndDrag(MainWnd.Handle,hIM,p);
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hIM := ImageList_Create(10,10,ILC_COLOR24,0,0);
  SetRect(DragRect,InitialX,InitialY,InitialX+10,InitialY+10);
  InitCoordinate;

  DD := TAPIDragDrop.Create(hWindow);
  DD.OnDrop := DDDrop;

  with MainWnd do begin
    ClientWidth := 500;
    ClientHeight := 400;
    Trap(WM_PAINT,MainPaint);
    Trap(WM_LBUTTONDOWN,MainLButtonDown);
    Trap(WM_MOUSEMOVE,MainMouseMove);
    Trap(WM_LBUTTONUP,MainLButtonUp);
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  DragEnable := not DragEnable;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  DeleteObject(hBM);
  ImageList_Destroy(hIM);
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifImageList03.zip(26.553kB)
ImageList03.gif

実行してエクスプローラから壁紙をドロップし、Test! メニューを選択して DragEnabletrue にしてからドラグすると右図のようになる。 移動してからマウスのボタンを離すと、そこに画像が固定される。これを連続して繰り返すことができる。

コードを見てみよう。

MainCreate( ) ハンドラでイメージリストが作られ、初期画像の領域として DragRect を初期化する。そして InitCoordinate 手続きにより、クライアント座標をウィンドウ全体の左上を原点とする座標に変換するときのずれである、OffsetX OffsetY をあらかじめ計算しておく。それから、メインウィンドウでは WM_PAINTWM_LBUTTONDOWNWM_MOUSEMOVEWM_LBUTTONUP の四つのメッセージを捕まえるように Trap( ) メソッドを実行する。

エクスプローラからビットマップをドロップすると DDDrop( ) ハンドラが実行される。

procedure DDDrop(var Msg:TMessage);
var
  hBitM:HBITMAP;
  BM: Windows.TBitmap;
begin
  hBitM := LoadImage(0,PChar(DD.Files[0]),IMAGE_BITMAP,0,0,LR_LOADFROMFILE);
  if hBitM > 0  then begin
    DeleteObject(hBM);
    hBM := hBitM;
    GetObject(hBM,SizeOf(BM),@BM);
    ImageX := BM.bmWidth;
    ImageY := BM.bmHeight;
    ImageList_SetIconSize(hIM,ImageX,ImageY);
    ImageList_Add(hIM,hBM,0);
    ImageCount := ImageList_GetImageCount(hIM);
    SetRect(DragRect,InitialX,InitialY,InitialX+ImageX,InitialY+ImageX);
    Invalidaterect(MainWnd.Handle,nil,true);
  end;
end;

ここでは、19−4 ビットマップの表示 で説明した LoadImage( ) APIを使って、ビットマップファイルをロードし、ビットマップハンドルを取得している。 それから、このハンドルを使ってそのビットマップのサイズを取得している。

function GetObject(p1: HGDIOBJ; 
                   p2: Integer; 
                   p3: Pointer): Integer; stdcall;

GetObject( ) API は、ビットマップ、ペン、ブラシ、フォントなどのハンドルを渡して、その内部情報を取得するときに使われる。 ここでは p1 にビットマップハンドルを設定する。 このとき、p3 には、Windows.pas で定義されている TBitmap レコードの変数のアドレスを指定する。 p2 には、p3 で指定したレコード型のサイズを設定する。

  PBitmap = ^TBitmap;
  TBitmap = packed record
    bmType: Longint;       // 不使用
    bmWidth: Longint;      // ビットマップの幅
    bmHeight: Longint;     // ビットマップの高さ
    bmWidthBytes: Longint; // 1スキャンラインのバイト数
    bmPlanes: Word;        // カラープレーン数
    bmBitsPixel: Word;     // 1ピクセルあたりの色解像度(ビット数)
    bmBits: Pointer;       // ビット情報の位置を示すポインタ
  end;

ここでは、このレコードの bmWidthbmHeight からサイズを求め、 イメージリストの格納画像のサイズを変更した後、イメージリストにこのビットマップを追加している。そして、ドラグ領域 DragRect を再設定している。

マウスの左ボタンを押し下げると MainLButtonDown( ) ハンドラが実行され、マウス位置を渡して StartDrag( ) が呼ばれる。

function StartDrag(wnd:HWND;ptCur:TPoint;himl:hImageList):Boolean;
begin
  result := false;
  if not DragEnable then exit;
  if not Boolean(PtInRect(DragRect,ptCur)) then exit;

  SetCapture(wnd);

  ptHotSpot.x := ptCur.x - DragRect.left;
  ptHotSpot.y := ptCur.y - DragRect.top;

  if not Boolean(ImageList_BeginDrag(himl,0,
                 ptHotSpot.x,ptHotSpot.y)) then exit;

  ImageList_DragEnter(wnd,ptCur.x+OffsetX,ptCur.y+OffsetY);

  result := true;
end;

ここではフラグを確認した後、マウス座標がドラグ領域(画像表示領域)の内側にあることを確認し、マウスをキャプチャする。

function SetCapture(hWnd: HWND): HWND; stdcall;

これは、マウスによるメッセージを指定されたウィンドウに集中させる。戻り値は以前にキャプチャしていたウィンドウのハンドルかゼロである。 それから、ホットスポットを計算する。これは、現在のマウスポインタの位置とドラグ領域の左上の座標の差である。 そして、ImageList_BeginDrag( ) でドラグを開始する。 つぎに、あらかじめ計算しておいた OffsetXOffsetY を使って ImageList_DragEnter( ) によりドラグ領域のウィンドウをリセットする。

マウスが移動すると MainMouseMove( ) ハンドラがよびだされ、ドラグ中華どうかを確認したのち、マウスの座標を設定して MoveImage( ) を呼び出す。

function MoveImage(ptCur:TPoint):Boolean;
begin
  result := Boolean(ImageList_DragMove(ptCur.x+OffsetX,ptCur.y+OffsetY));
end;

ここでは、ImageList_DragMove( ) を呼び出しているだけである。

マウスのボタンを離すと MainLButtonUp( ) が実行され、ドラグ中であればマウス座標を設定して EndDrag( ) を呼び出す。

procedure EndDrag(wnd:HWND;himl:hImageList;ptCur:TPoint);
var
  x,y:integer;
begin
  ImageList_EndDrag;
  ImageList_DragLeave(wnd);
  FlagDrag := false;
  x := ptCur.x-ptHotSpot.x;
  y := ptCur.y-ptHotSpot.y;
  SetRect(DragRect,x,y,x+ImageX,y+ImageY);
  InvalidateRect(wnd,nil,true);

  ReleaseCapture;
end;

ここでは、ドラグドロップによる画像の移動を終了し、ドラグ領域を再設定し、マウスキャプチャを終了している。

以上で、イメージリストを使ったドラグドロップによる画像の移動についてのコードの説明は終わりである。 めんどくさそうであるが、一度その意味を理解してしまうと、同じコードを何度でも使うことができるので、説明するより実行するほうがずっと簡単である。 是非、試していただきたい。

redball.gifこの章の目次へ戻る

28−4 イメージリストのラッパークラス

前節では、イメージリストを使って画像をマウスで移動させるコードを調べた。この節では、前節で調べた画像のドラグドロップによる移動以外の機能をカプセル化したクラスを作成しよう。 最終的にはドラグドロップによる画像の移動をサポートした TAPIImageList クラスを作成したいので、ここではこの上位クラスとして TImageListBase という名前でラッパークラスを作成しよう。

  1. エクスプローラを使って、新しいフォルダを 2804ImageList04 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2803ImageList03 フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pasCmCtrl.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで ImageList04.dpr という名前で保存する。
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ。
  6. コードエディタで以下のように編集する。
  7. [F.9]でコンパイルして実行する。

最初に、CmCtrl.pasTImageListBase クラスを作成しよう。宣言部を以下に示す。

//--------------------- TImageListBase -----------------------
function ImageList_Copy(himlDst:HIMAGELIST;iDst:integer;himlSrc:HIMAGELIST;
  iSrc:integer;uFlags:UINT): Integer;stdcall;
  external 'comctl32.dll' name 'ImageList_Copy';

function ImageList_Duplicate(himl: HIMAGELIST): HIMAGELIST; stdcall;
            external 'comctl32.dll' name 'ImageList_Duplicate';

const
  ILCF_MOVE   = $00000000;
  ILCF_SWAP   = $00000001;

type
TImageListBase = class(TObject)
private
  FHandle: hImageList;
  FDontDestroy: Boolean;
  function GetImageCount:integer;
  procedure SetHandle(val:hImageList);
  function GetBkColor:COLORREF;
  procedure SetBkColor(val:COLORREF);
protected
  procedure GetIconSize(hIcn:HICON;var CX,CY:integer);
  procedure GetBitmapSize(hBm:HBITMAP;var CX,CY:integer);
public
  constructor Create(Mask:Boolean);virtual;
  destructor Destroy; override;
  function AddIcon(hIcn:HICON):integer;
  function AddBitmap(hBm:HBITMAP):integer;
  function Draw(Index:integer;DC:HDC;X,Y:integer;Style:UINT):Boolean;
  function SwapImage(Indx1,Indx2:integer):Boolean;
  function CopyImage(IDst,ISrc:integer):Boolean;
  function GetImageSize(var CX,CY:integer):Boolean;
  function GetWholeImageSize:TSize;
  function GetImageInfo(index:integer;
                     var hImage,hMask:HBITMAP;var Rct:TRect):Boolean;
  function Remove(index:integer):Boolean;
  function ReplaceImage(index:integer;hBm:HBITMAP):Boolean;
  procedure RemoveAll;
  function Duplicate:hImageList;
  function GetIcon(index:integer;flag:UINT):HICON;
  function ReplaceIcon(index:integer;hIcn:HICON):Boolean;
  property ImageCount:integer read GetImageCount;
  property Handle:hImageList read FHandle write SetHandle;
  property BkColor:COLORREF read GetBkColor write SetBkColor;
  property DontDestroy:Boolean read FDontDestroy write FDontDestroy;
end;

これを見てもわかるように、public 部の多くのメソッドはこれまでに説明してきた ImageList_XXX の関数をそのままメソッドにしているだけである。したがって、ほとんど説明の必要はないだろう。 実装部を以下に示す。

//--------------------- TImageListBase -----------------------
constructor TImageListBase.Create(Mask:Boolean);
var
  Flags:UINT;
begin
  InitCommonControls;
  if Mask then
    Flags := ILC_COLOR24 or ILC_MASK
  else
    Flags := ILC_COLOR24;
  FHandle := ImageList_Create(10,10,Flags,0,0);
end;

destructor TImageListBase.Destroy;
begin
  if not FDontDestroy then ImageList_Destroy(FHandle);
  inherited;
end;

function TImageListBase.AddIcon(hIcn:HICON):integer;
var
  CX,CY:integer;
begin
  result := -1;
  if ImageCount = 0 then begin
    GetIconSize(hIcn,CX,CY);
    if not Boolean(ImageList_SetIconSize(FHandle,CX,CY)) then exit;
  end;
  result := ImageList_AddIcon(FHandle,hIcn);
end;

function TImageListBase.AddBitmap(hBm:HBITMAP):integer;
var
  CX,CY:integer;
begin
  result := -1;
  if ImageCount = 0 then begin
    GetBitmapSize(hBm,CX,CY);
    if not Boolean(ImageList_SetIconSize(FHandle,CX,CY)) then exit;
  end;
  result := ImageList_AddMasked(FHandle,hBm,RGB(254,254,254));
end;

function TImageListBase.Draw(Index:integer;DC:HDC;X,Y:integer;Style:UINT):Boolean;
begin
  result := Boolean(ImageList_Draw(FHandle,index,DC,X,Y,ILD_NORMAL));
end;

function TImageListBase.SwapImage(Indx1,Indx2:integer):Boolean;
begin
  result := Boolean(ImageList_Copy(FHandle,Indx1,FHandle,Indx2,ILCF_SWAP));
end;

function TImageListBase.CopyImage(IDst,ISrc:integer):Boolean;
begin
  result := Boolean(ImageList_Copy(FHandle,IDst,FHandle,ISrc,ILCF_MOVE));
end;

function TImageListBase.GetImageSize(var CX,CY:integer):Boolean;
begin
  result := Boolean(ImageList_GetIconSize(FHandle,CX,CY));
end;

function TImageListBase.GetWholeImageSize:TSize;
var
  XMax,YMax,ICount,i:integer;
  II:TImageInfo;
begin
  result .cx := 0;
  result.cy := 0;
  XMax := 0;
  YMax := 0;

  ICount := ImageList_GetImageCount(FHandle);
  if ICount = 0 then exit;

  for i := 0 to ICount-1 do begin
    ImageList_GetImageInfo(FHandle,i,II);
    DeleteObject(II.hbmImage);
    DeleteObject(II.hbmMask);
    if II.rcImage.Right > XMax then XMax := II.rcImage.Right;
    if II.rcImage.Bottom > YMax then YMax := II.rcImage.Bottom;
  end;
  result.cx := XMax;
  result.cy := YMax;
end;

function TImageListBase.GetImageInfo(index:integer;
                      var hImage,hMask:HBITMAP;var Rct:TRect):Boolean;
var
  IIF:TImageInfo;
begin
  result := Boolean(ImageList_GetImageInfo(FHandle,index,IIF));
  if result then begin
    hImage := IIF.hbmImage;
    hMask := IIF.hbmMask;
    Rct := IIF.rcImage;
  end;
end;

function TImageListBase.Remove(index:integer):Boolean;
begin
  result := Boolean(ImageList_Remove(FHandle,index));
end;

function TImageListBase.ReplaceImage(index:integer;hBm:HBITMAP):Boolean;
var
  AddIndex:integer;
begin
  AddIndex := AddBitmap(hBm);
  SwapImage(index,AddIndex);
  result := Remove(AddIndex);
end;

function TImageListBase.ReplaceIcon(index:integer;hIcn:HICON):Boolean;
begin
  result := Boolean(ImageList_ReplaceIcon(FHandle,index,hIcn));
end;

procedure TImageListBase.RemoveAll;
begin
  ImageList_RemoveAll(FHandle);
end;

function TImageListBase.Duplicate:hImageList;
begin
  result  := ImageList_Duplicate(FHandle);
end;

function TImageListBase.GetIcon(index:integer;flag:UINT):HICON;
begin
  result := ImageList_GetIcon(FHandle,index,Flag);
end;

procedure TImageListBase.GetIconSize(hIcn:HICON;var CX,CY:integer);
var
  IconInfo:TIconInfo;
  BM:Windows.TBitmap;
begin
  GetIconInfo(hIcn,IconInfo);
  GetObject(IconInfo.hbmColor,SizeOf(BM),@BM);
  CX := BM.bmWidth;
  CY := BM.bmHeight;
  DeleteObject(IconInfo.hbmColor);
  DeleteObject(IconInfo.hbmMask);
end;

procedure TImageListBase.GetBitmapSize(hBm:HBITMAP;var CX,CY:integer);
var
  BM:Windows.TBitmap;
begin
  GetObject(hBm,SizeOf(BM),@BM);
  CX := BM.bmWidth;
  CY := BM.bmHeight;
end;

function TImageListBase.GetImageCount:integer;
begin
  result := ImageList_GetImageCount(FHandle);
end;

procedure TImageListBase.SetHandle(val:hImageList);
begin
  if (FHandle <> 0) and (not FDontDestroy) then
    ImageList_Destroy(FHandle);
  FHandle := val;
end;

function TImageListBase.GetBkColor:COLORREF;
begin
  result := ImageList_GetBkColor(FHandle);
end;

procedure TImageListBase.SetBkColor(val:COLORREF);
begin
  ImageList_SetBkColor(FHandle,val);
end;

実装コードも、これまでに説明してきたイメージリスト操作関数をカプセル化しているだけなので説明の必要はないだろう。 それでは、早速このクラスをテストするプログラムを ImageList04.dpr に作ろう。 以下に全リストを示す。

program ImageList04;

uses
  windows,
  messages,
  CommCtrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  IL:TImageListBase;

  BG:TBtnGroup;
  L1:TAPILabel;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
  i:integer;
begin
  if IL.ImageCount > 0 then begin
    IL.BkColor := MainWnd.Color;
    DC := BeginPaint(MainWnd.Handle,ps);
      for i := 0 to IL.ImageCount-1 do
        IL.Draw(i,DC,10+40*i,10,ILD_NORMAL);
     EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;

procedure BGClick(var Msg:TMessage);
var
  DC:HDC;
  hbmImage,hbmMask:HBITMAP;
  R:TRect;
  hIcn:HICON;
  Size: TSize;
begin
  case Msg.WParam of
    0:begin
      IL.SwapImage(2,3);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
    1:begin
      IL.CopyImage(1,5);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
    2:begin
      Size := IL.GetWholeImageSize;
      DC := GetDC(MainWnd.Handle);
        ImageList_DrawEx(IL.Handle,0,DC,50,50,Size.cx,Size.cy,CLR_DEFAULT,
                                           CLR_DEFAULT,ILD_NORMAL);
      ReleaseDC(MainWnd.Handle,DC);
    end;
    3:begin
      IL.GetImageInfo(3,hbmImage,hbmMask,R);
      DeleteObject(hbmImage);
      DeleteObject(hbmMask);
      L1.Text := 'Left   : '+AIntToStr(R.Left)+#13+
                 'Top    : '+AIntToStr(R.Top)+#13+
                 'Right  : '+AIntToStr(R.Right)+#13+
                 'Bottom : '+AIntToStr(R.Bottom);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
    4:begin
      hIcn := IL.GetIcon(1,ILD_TRANSPARENT);
      DC := GetDC(MainWnd.Handle);
        DrawIconEx(DC,50,50,hIcn,100,100,0,0,DI_NORMAL);
      ReleaseDC(MainWnd.Handle,DC);
      DestroyIcon(hIcn);
    end;
    5:begin
      IL.Remove(1);
      InvalidateRect(MainWnd.Handle,nil,true);
    end;
  end;

end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
  i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  IL := TImageListBase.Create(true);
  for i := 0 to 5 do
    IL.AddIcon(LoadIcon(0,MakeIntResource(32512+i)));

  BG := CreateBtnGroup(hWindow,true,200,50,150,230,6,BGClick);
  BG.Captions[0] := 'Swap 2,3';
  BG.Captions[1] := 'Copy to 1 form 5';
  BG.Captions[2] := 'DrawEx 0';
  BG.Captions[3] := 'ImageInfo 3';
  BG.Captions[4] := 'GetIcon 1';
  BG.Captions[5] := 'Remove 1';

  L1 := CreateLabel(hWindow,10,160,180,120,'');

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 290;
    Trap(WM_PAINT, MainPaint);
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  IL.Free;
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifImageList04.zip28.730kB)
ImageList04.gif

実行すると右図のようになる。 これらの動作は、ImageList02.dpr とほとんど同じである。 イメージリスト操作用の関数を全てカプセル化したわけではないので、ImageList_DrawEx( ) のような関数はハンドル値を参照してナマのままで使用している。

redball.gifこの章の目次へ戻る

28−5 システムイメージリスト

前節で作成したイメージリストのラッパークラスを利用して、システムイメージリストの中身を覗いてみよう。TImageListBase クラスは、ハンドル値を代入できるので既存のイメージリストを操作するときも便利である。 このようにして利用する場合、イメージリストそのものをそのラッパークラスの開放と同時に開放しないほうが良いことが多い。 この節で扱うシステムイメージリストもそうなので、DontDestroy プロパティーを true に設定する。そうすると、

destructor TImageListBase.Destroy;
begin
  if not FDontDestroy then ImageList_Destroy(FHandle);
  inherited;
end;

なので、デストラクタによりラッパークラスは破棄されるが、イメージリストそのものは破棄されない。 システムイメージリストのハンドルを取得するには、ShellAPI.pas に宣言されている関数を使って、

function GetSystemImageList:hImageList;
var
  FileInfo: TSHFileInfo;
begin
  result := SHGetFileInfo('', 0, FileInfo, SizeOf(TSHFileInfo),
      SHGFI_LARGEICON or SHGFI_SYSICONINDEX );
end;

のようにする。ここではこの関数については説明しない。 後の章でシェルプログラミングを扱う予定なのでそのときに詳しく調べてみよう。 (注:上のように簡単な関数でシステムイメージリストを取得できるのは、Windows9X 系だけのようです。詳しくは System Image List Does Not Contain Overlay Images を参照してください。2003/06/16 )

  1. エクスプローラを使って、新しいフォルダを 2805SystemImageList という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2804ImageList04 フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pasCmCtrl.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで SystemImageList.dpr という名前で保存する。
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ。
  6. コードエディタで以下のように編集する。
  7. [F.9]でコンパイルして実行する。

以下に SystemImageList.dpr の全リストを示す。

program SystemImageList;

uses
  windows,
  messages,
  CommCtrl,
  ShellAPI,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  IL:TImageListBase;

  Fifty: integer;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function GetSystemImageList:hImageList;
var
  FileInfo: TSHFileInfo;
begin
  result := SHGetFileInfo('', 0, FileInfo, SizeOf(TSHFileInfo),
      SHGFI_LARGEICON or SHGFI_SYSICONINDEX );
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
  i,j:integer;
begin
  if IL.ImageCount > 0 then begin
    DC := BeginPaint(MainWnd.Handle,ps);
      for i := 0 to 4 do
        for j := 0 to 9 do begin
          if (Fifty+10*i+j)>= IL.ImageCount then break;
          IL.Draw(Fifty+10*i+j,DC,10+40*j,10+40*i,ILD_NORMAL);
        end;
    EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  IL := TImageListBase.Create(true);
  IL.Handle := GetSystemImageList;
  IL.BkColor := MainWnd.Color;
  IL.DontDestroy := true;

  MainWnd.Title := MainWnd.Title + '   ImageCount : ' +
                     AIntToStr(IL.ImageCount);

  with MainWnd do begin
    ClientWidth := 420;
    ClientHeight := 220;
    Center;
    Trap(WM_PAINT, MainPaint);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  Fifty := Fifty+50;
  if Fifty > IL.ImageCount then Fifty := 0;
  InvalidateRect(MainWnd.Handle,nil,true);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  IL.Free;
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifSystemImageList.zip(24.915kB)
SystemImageList_1.gif

実行すると右図のようになる。 筆者の環境では、 画像キャプチャした時点で450個のアイコンが含まれていた。 このプログラムでは、そのうち50個ずつクライアント領域に描画している。 Test! メニューが選択されると、次の50個が描画される。 右図はその350〜399までを描画したときのものである。

redball.gifこの章の目次へ戻る

28−6 画像移動機能を追加する

この節では、これまでに作成した TImageListBase クラスに、第3節で調べたマウスをつかって画像のドラグドロップによる移動の機能を追加して TAPIImageList クラスを作成しよう。 そして、このクラスを使って複数のアイコンをマウスで移動させるプログラムをつくろう。

  1. エクスプローラを使って、新しいフォルダを 2806ImageList05 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2805SystemImageList フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pasCmCtrl.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで ImageList05.dpr という名前で保存する。
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ。
  6. コードエディタで以下のように編集する。
  7. [F.9]でコンパイルして実行する。

最初に TImageListBase クラスから派生して、画像移動機能を追加して TAPIImageList クラスを CmCtrl.pas に作成しよう。宣言部を以下に示す。

//--------------------- TAPIImageList -----------------------
TAPIImageList = class(TImageListBase)
private
  FDragRect:TRect;
  FOffSetX,FOffsetY:integer;
  FDragIndex:integer;
  FptHotSpot:TPoint;
  FFlagDrag:Boolean;
  FhParent:HWND;
protected
  procedure InitCoordinate;
public
  function StartDrag(hParent:HWND;CurX,CurY:integer):Boolean;
  function MoveImage(CurX,CurY:integer):Boolean;
  function EndDrag(CurX,CurY:integer):Boolean;
  property DragIndex:integer read FDragIndex write FDragIndex;
  property DraggedRect:TRect read FDragRect write FDragRect;
end;

public 部の StartDrag( )MoveImage( )EndDrag( ) メソッドは、第3節で作った同名のヘルパ関数と同じ機能を持ち、それぞれ WM_LBUTTONDOWNWM_MOUSEMOVEWM_LBUTTONUP メッセージに同期して呼び出される。DragIndex プロパティーは、保持している画像のうち、どの画像を移動するのかをインデックスで取得・設定する。DraggedRect プロパティーは、ドラグされる画像の現在の表示位置を取得設定する。これは、ドラグ中の参照は不正確な値である。 実装部を以下に示す。

//--------------------- TAPIImageList -----------------------
procedure TAPIImageList.InitCoordinate;
var
  p:TPoint;
  r:TRect;
begin
  p.x := 0; p.y := 0;
  Windows.ClientToScreen(FhParent,p);
  Windows.GetWindowRect(FhParent,r);
  FOffsetX := p.x-r.Left;
  FOffsetY := p.y-r.Top;
end;

function TAPIImageList.StartDrag(hParent:HWND;CurX,CurY:integer):Boolean;
var
  ptCur:TPoint;
begin
  FhParent := hParent;
  InitCoordinate;

  FFlagDrag := false;
  result := false;
  ptCur.x := CurX; ptCur.y := CurY;
  if not Boolean(PtInRect(FDragRect,ptCur)) then exit;

  SetCapture(hParent);

  FptHotSpot.x := CurX - FDragRect.left;
  FptHotSpot.y := CurY - FDragRect.top;

  if not Boolean(ImageList_BeginDrag(FHandle,FDragIndex,
                 FptHotSpot.x,FptHotSpot.y)) then exit;

  ImageList_DragEnter(hParent,CurX+FOffsetX,CurY+FOffsetY);

  FFlagDrag := true;
  result := true;
end;

function TAPIImageList.MoveImage(CurX,CurY:integer):Boolean;
begin
  result := false;
  if not FFlagDrag then exit;
  result := Boolean(ImageList_DragMove(CurX+FOffsetX,CurY+FOffsetY));
end;

function TAPIImageList.EndDrag(CurX,CurY:integer):Boolean;
var
  x,y,CX,CY:integer;
begin
  result := false;
  if not FFlagDrag then exit;
  GetImageSize(CX,CY);
  result := Boolean(ImageList_EndDrag);
  ImageList_DragLeave(FhParent);
  FFlagDrag := false;
  x := CurX-FptHotSpot.x;
  y := CurY-FptHotSpot.y;
  SetRect(FDragRect,x,y,x+CX,y+CY);
  InvalidateRect(FhParent,nil,true);

  ReleaseCapture;
end;

それでは、このクラスをつかって複数のアイコンをドラグ移動するプログラムを ImageList05.dpr に作成しよう。 以下に全リストを示す。

program ImageList05;

uses
  windows,
  messages,
  CommCtrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  IL:TAPIImageList;

  DragRect: array[0..5] of TRect;

  DragFlag:Boolean;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function GetDragIndex(X,Y:integer):integer;
var
  i:integer;
  p:TPoint;
begin
  result := -1;
  p.x := X; p.y := Y;
  for i := 0 to 5 do
    if Boolean(PtInRect(DragRect[i],p)) then result := i;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainPaint(var Msg: TMessage);
var
  DC:HDC;
  ps:TPaintStruct;
  i:integer;
begin
  if IL.ImageCount > 0 then begin
    IL.BkColor := MainWnd.Color;
    DC := BeginPaint(MainWnd.Handle,ps);
      for i := 0 to IL.ImageCount-1 do
        IL.Draw(i,DC,DragRect[i].Left,DragRect[i].Top,ILD_NORMAL);
     EndPaint(MainWnd.Handle,ps);
    Msg.Result := 1;
  end;
end;

procedure MainLButtonDown(var Msg: TMessage);
var
  DragIndex:integer;
begin
  if DragFlag then begin
    DragIndex := GetDragIndex(Msg.LParamLo,Msg.LParamHi);
    if DragIndex <> -1 then begin
      IL.DragIndex := DragIndex;
      IL.DraggedRect := DragRect[DragIndex];
      IL.StartDrag(MainWnd.Handle,Msg.LParamLo,Msg.LParamHi);
    end;
  end;
end;

procedure MainMouseMove(var Msg: TMessage);
begin
  IL.MoveImage(Msg.LParamLo,Msg.LParamHi);
end;

procedure MainLButtonUp(var Msg: TMessage);
begin
  if IL.EndDrag(Msg.LParamLo,Msg.LParamHi) then begin
    DragRect[IL.DragIndex] := IL.DraggedRect;
  end;
end;
                                                          
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
  CX,CY,i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  IL := TAPIImageList.Create(true);
  for i := 0 to 5 do
    IL.AddIcon(LoadIcon(0,MakeIntResource(32512+i)));
  IL.GetImageSize(CX,CY);
  for i := 0 to 5 do
    SetRect(DragRect[i],10+40*i,10,10+40*i+CX,10+CY);
  IL.BkColor := MainWnd.Color;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Trap(WM_PAINT,MainPaint);
    Trap(WM_LBUTTONDOWN,MainLButtonDown);
    Trap(WM_MOUSEMOVE,MainMouseMove);
    Trap(WM_LBUTTONUP,MainLButtonUp);
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  DragFlag := not DragFlag;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  IL.Free;
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifImageList05.zip(25.337kB)
ImageList05.gif

実行して、Test! メニューをクリックするとどのアイコンもドラグ移動できるようになる。 その様子を右図に示す。

コードを見てみよう。ここでは、前回も使ったシステムアイコンを6個イメージリストに追加するがその個々の表示領域とドラグ移動の許可/不許可を表すフラグをグローバル変数としている。

  DragRect: array[0..5] of TRect;

  DragFlag:Boolean;

そして、MainCreate( ) でアイコンを追加した後、その表示領域を設定している。

  IL.GetImageSize(CX,CY);
  for i := 0 to 5 do
    SetRect(DragRect[i],10+40*i,10,10+40*i+CX,10+CY);

こうして、表示領域を初期化しているわけである。 MainWnd では、WM_LBUTTONDOWNWM_MOUSEMOVEWM_LBUTTONUP メッセージを捕まえてイベントハンドラを呼び出している。

procedure MainLButtonDown(var Msg: TMessage);
var
  DragIndex:integer;
begin
  if DragFlag then begin
    DragIndex := GetDragIndex(Msg.LParamLo,Msg.LParamHi);
    if DragIndex <> -1 then begin
      IL.DragIndex := DragIndex;
      IL.DraggedRect := DragRect[DragIndex];
      IL.StartDrag(MainWnd.Handle,Msg.LParamLo,Msg.LParamHi);
    end;
  end;
end;

procedure MainMouseMove(var Msg: TMessage);
begin
  IL.MoveImage(Msg.LParamLo,Msg.LParamHi);
end;

procedure MainLButtonUp(var Msg: TMessage);
begin
  if IL.EndDrag(Msg.LParamLo,Msg.LParamHi) then begin
    DragRect[IL.DragIndex] := IL.DraggedRect;
  end;
end;

これらの呼び出しシークエンスは第3節で行ったのと全く同じである。 ただ、今回は複数のアイコンを移動対象としているので、マウスボタンの押された位置によりどのアイコンを移動するのかを決めなければならない。これは MainLButtonDown( ) ハンドラの中で GetDragIndex( ) ヘルパ関数を用いてアイコンのインデックスを決定している。

function GetDragIndex(X,Y:integer):integer;
var
  i:integer;
  p:TPoint;
begin
  result := -1;
  p.x := X; p.y := Y;
  for i := 0 to 5 do
    if Boolean(PtInRect(DragRect[i],p)) then result := i;
end;

ここでは、現在のマウスポインタの位置を受け取って、現在の表示領域を表す DragRect 配列を走査して、アイコンのインデックスを決定している。どこにも入らないときは、-1 を戻している。 MainLButtonDown( ) ハンドラでは、 この戻り値を参照して DragIndex プロパティーと DraggedRect プロパティーを設定してから StartDrag( ) メソッドを呼び出している。 MainMouseMove( ) ハンドラでは、MoveImage( ) メソッドを呼び出すだけである。 TAPIImageList クラスの内部で現在ドラグ中であるかどうかを示すフラグをもっているので、ドラグ中でないときは何もしない。 MainLButtonUp( ) ハンドラでは、 EndDrag( ) メソッドを呼び出して成功したら、DragRect 配列の対応する要素を更新する。以上で移動シークエンスが完了する。

redball.gifこの章の目次へ戻る

28−7 まとめ

本章では、 イメージリストを調べた。 イメージリストは、他の多くのコモンコントロールと異なり、子ウィンドウではなく、ハンドルで識別されるシステムリソースであることが分かった。 ウィンドウではないのでシステムとの間でメッセージの授受はない。イメージリストを操作するには、ハンドルを指定して、専用の関数を呼び出す。ここでは幾つかの関数を試した。そして、イメージリストのラッパークラスを TObject から派生して作成してテストした。

イメージリストは、格納している画像をマウスでドラグドロップして移動する機能があり、これも試してみた。そして、この機能をラッパークラスに取り込んで、複数の画像を移動することをテストした。 この機能を使えば、ソリテアのようなトランプゲームでマウスによるカードの移動が簡単に実現できる。 本章では試していないが、マウスの移動と独立にコードによって任意に画像をスムーズに移動させることもできるだろう。

redball.gifこの章の目次へ戻る


ここまでのプログラムファイル

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (19 kB)
  3. UtilClass.pas (74 kB)
  4. GDIObject.pas (21 kB)
  5. APIControl.pas (69 kB)
  6. APIWindow.pas (35 kB)
  7. CmCtrl.pas (57 kB)




redball.gifこの章の目次へ戻る