anibtn.pas

这一系列是我平时收集的pascal深入核心编程

unit AniBtn;

interface

uses Windows, Messages, CommCtrl;

const
 // 动画按钮控件类名
  WC_ANIBTN = 'AniBtn';

 // 控件自定消息 ~~

 // 注意, 只有将消息定义在这个范围, 才不会冲突
  ABM_FIRSTMSG = (WM_APP + 0);

 // Purpose: 设置动画定时器延时
 // wParam: Integer - 新的定时器延时(毫秒为单位)
 // lParam: 略
 // Return: 略
  ABM_SETTIMER = (ABM_FIRSTMSG + 0);

 // Purpose: 取得动画定时器延时
 // wParam: 略
 // lParam: 略
 // Return: Integer - 当前定时器延时(毫秒为单位)
  ABM_GETTIMER = (ABM_FIRSTMSG + 1);

 // Purpose: 设置动画图像列表
 // wParam: HIMAGELIST - 图像列表控件句柄
 // lParam: 略
 // Return: 略
  ABM_SETIMAGELIST = (ABM_FIRSTMSG + 2);

 // Purpose: 取得动画图像列表
 // wParam: 略
 // lParam: 略
 // Return: HIMAGELIST - 当前图像列表句柄
  ABM_GETIMAGELIST = (ABM_FIRSTMSG + 3);

 // 对控件消息的简单包装
procedure AniBtn_SetTimer(hWnd: HWND; nTimeOut: Integer);
function AniBtn_GetTimer(hWnd: HWND): Integer;
procedure AniBtn_SetImageList(hWnd: HWND; himl: HIMAGELIST);
function AniBtn_GetImageList(hWnd: HWND): HIMAGELIST;

 // 注册or反注册控件
function AniBtn_RegisterClass(HInst: THandle; fGlobalClass: BOOL): ATOM; stdcall;
function AniBtn_UnregisterClass(HInst: THandle): BOOL; stdcall;

implementation

uses SuperCls;

 // 设置定时器间隔
procedure AniBtn_SetTimer(hWnd: HWND; nTimeOut: Integer);
begin
  SendMessage(hWnd, ABM_SETTIMER, nTimeout, 0);
end;

 // 取得定时器间隔
function AniBtn_GetTimer(hWnd: HWND): Integer;
begin
  Result := SendMessage(hWnd, ABM_GETTIMER, 0, 0);
end;

 // 设置动画图像列表
procedure AniBtn_SetImageList(hWnd: HWND; himl: HIMAGELIST);
begin
  SendMessage(hWnd, ABM_SETIMAGELIST, himl, 0);
end;

 // 取得动画图像列表
function AniBtn_GetImageList(hWnd: HWND): HIMAGELIST;
begin
  Result := SendMessage(hWnd, ABM_GETIMAGELIST, 0, 0);
end;

type
 // 按钮额外空间结构
  P_AniBtn_WndExtraBytes = ^T_AniBtn_WndExtraBytes;
  T_AniBtn_WndExtraBytes = packed record
    himl: HIMAGELIST; // 图像列表控件句柄
    iImage: Integer;  // 下一个要显示的图片
    nTimeout: Integer; // 图片变化时间间隔
  end;

 // 按钮ABM_SETTIMER处理
procedure AniBtn_OnSetTimer(hWnd: HWND; nTimeout: Integer); stdcall;
begin
  SuperCls_SetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).nTimeout), nTimeout);
  SetTimer(hWnd, 1, nTimeout, nil);
end;

 // 按钮ABM_GETTIMER处理
function AniBtn_OnGetTimer(hWnd: HWND): Integer; stdcall;
begin
  Result := SuperCls_GetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).nTimeout));
end;

 // 按钮ABM_SETIMAGELIST处理
procedure AniBtn_OnSetImageList(hWnd: HWND; himl: HIMAGELIST); stdcall;
begin
  SuperCls_SetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).himl), himl);
  SuperCls_SetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).iImage), 0);
end;

 // 按钮ABM_GETIMAGELIST处理
function AniBtn_OnGetImageList(hWnd: HWND): HIMAGELIST; stdcall;
begin
  Result := SuperCls_GetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).himl));
end;

 // 调用基类(Button)窗口过程
function AniBtn_CallBaseClass(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  Result := CallWindowProc(SuperCls_GetWndProcBaseCls(hWnd), hWnd, uMsg, wParam, lParam);
end;

 // 按钮WM_CREATE处理
function AniBtn_OnCreate(hWnd: HWND; lpCreateStruct: PCreateStruct): BOOL;
begin
 // 缺省延时为0.25秒
  AniBtn_SetTimer(hWnd, 250);

 // 调用基类处理过程
  Result := AniBtn_CallBaseClass(hWnd, WM_CREATE, 0, Integer(lpCreateStruct)) <> -1;
end;

 // 按钮WM_DESTROY处理
procedure AniBtn_OnDestroy(hWnd: HWND);
var
  himl: HIMAGELIST;
begin
 // 清除关联的图像列表
  himl := AniBtn_GetImageList(hWnd);
  if (himl <> 0) then ImageList_Destroy(himl);

 // 删除动画定时器
  KillTimer(hWnd, 1);

 // 调用基类处理过程
  AniBtn_CallBaseClass(hWnd, WM_DESTROY, 0, 0);
end;

 // 按钮WM_TIMER处理
procedure AniBtn_OnTimer(hWnd: HWND; id: UINT);
var
  himl: HIMAGELIST;
  iImage: Integer;
  hiconOld: HICON;
begin
  himl := AniBtn_GetImageList(hWnd);
  if (himl <> 0) then
  begin
   // 要显示的图像
    iImage := SuperCls_GetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).iImage));

   // 修改按钮图标
    hiconOld := SendMessage(hWnd, BM_SETIMAGE, IMAGE_ICON, ImageList_GetIcon(himl, iImage, ILD_NORMAL));

   // 清除老的图标
    if (hiconOld <> 0) then DestroyIcon(hiconOld);

   // 后继图像编号
    iImage := (iImage + 1) mod ImageList_GetImageCount(himl);
    SuperCls_SetWindowLong(hWnd, Integer(@P_AniBtn_WndExtraBytes(0).iImage), iImage);
  end;
end;

 // 按钮消息处理回调
function AniBtn_WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Result := 0;

  case (uMsg) of
   // 标准窗口消息
    WM_CREATE:
      begin
        if AniBtn_OnCreate(hWnd, PCreateStruct(lParam)) = FALSE then Result := -1;
      end;

    WM_DESTROY:
      begin
        AniBtn_OnDestroy(hWnd);
      end;

    WM_TIMER:
      begin
        AniBtn_OnTimer(hWnd, wParam);
      end;

   // 控件自定消息
    ABM_SETTIMER:
      begin
        AniBtn_OnSetTimer(hWnd, wParam);
      end;

    ABM_GETTIMER:
      begin
        Result := AniBtn_OnGetTimer(hWnd);
      end;

    ABM_SETIMAGELIST:
      begin
        AniBtn_OnSetImageList(hWnd, wParam);
      end;

    ABM_GETIMAGELIST:
      begin
        Result := AniBtn_OnGetImageList(hWnd);
      end;

    else Result := AniBtn_CallBaseClass(hWnd, uMsg, wParam, lParam);  
  end;
end;

 // 注册动画按钮类
function AniBtn_RegisterClass(HInst: THandle; fGlobalClass: BOOL): ATOM; stdcall;
var
  wc: TWndClassEx;
begin
  ZeroMemory(@wc, SizeOf(TWndClassEx));
  wc.cbSize := SizeOf(TWndClassEx);

 // 取基类(Button)信息 
  if (GetClassInfoEx(0, 'BUTTON', wc) = FALSE) then
  begin
    Result := INVALID_ATOM;
    Exit;
  end;

 // InitCommonControls()其实是comctl32.dll中的一个空函数,
 // 一般调用它是为了保证在程序启动时自动载入comctl32.dll,
 // 而该DLL在载入的时候, 会自动注册其所包含控件的窗口类,
 // 随后, 即可直接根据类名来建立控件了..  :~)
 
 // 这里有两点理由可以不调用InitCommonControls()函数,
 // 1.程序已经静态调用了comctl32.dll中的ImageList_Create()
 // 来建立图像列表, 所以comctl32.dll同样会自动载入..
 // 2.图像列表并没有对应的窗口类, 无须注册, 也可以正常使用

 // InitCommonControls();

 // 设置我们的类名
  wc.lpszClassName := WC_ANIBTN;

 // 欲注册类的模块
  wc.hInstance := HInst;

 // 要求注册全局类
  if (fGlobalClass) then wc.style := wc.style or CS_GLOBALCLASS;

 // 注册superclass
  Result := SuperCls_RegisterClassEx(@wc, @AniBtn_WndProc, 0, SizeOf(T_AniBtn_WndExtraBytes));
end;

 // 注销动画按钮类
function AniBtn_UnregisterClass(HInst: THandle): BOOL; stdcall;
begin
  Result := UnregisterClass(WC_ANIBTN, HInst);
end;

end.