bargraph.pas

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

unit BarGraph;

interface

uses Windows, Messages;

type
 // 自定NOTIFY结构
  P_BarGraph_Notify = ^T_BarGraph_Notify;
  T_BarGraph_Notify = record
    nmh: NMHdr; // 标准NMHdr头
    uBar: UINT; // 被点击的Bar
  end;

 // 单个Bar信息结构
  PBar = ^TBar;
  TBar = record
    nHeight: UINT; // Bar高度
    hbr: HBRUSH; // 填充画刷
  end;

const
 // BarGraph控件类名
  WC_BARGRAPH = 'BarGraph';

 // 自定控件消息 ~~

 // Purpose: 设置控件TBar数组, (注: 其中画刷应该由调用者建立和清除)
 // wParam: UINT - TBar组员个数
 // lParam: PBar - TBar数组地址
 // Return: 略
  BGM_SETBARS = (WM_USER + 0);

 // Purpose: 取得控件TBar数组地址
 // wParam: 略
 // lParam: 略
 // Return: PBar - TBar数组地址
  BGM_GETBARS = (WM_USER + 1);

 // Purpose: 取得控件TBar组员个数
 // wParam: 略
 // lParam: 略
 // Return: UINT - TBar组员个数
  BGM_GETCOUNT = (WM_USER + 2);

 // Purpose: 设置控件整体高度 
 // wParam: UINT - 新的控件高度
 // lParam: 略
 // Return: 略
  BGM_SETHEIGHT = (WM_USER + 3);

 // Purpose: 取得控件整体高度
 // wParam: 略
 // lParam: 略
 // Return: UINT - 控件高度
  BGM_GETHEIGHT = (WM_USER + 4);

 // Purpose: 设置控件背景颜色
 // wParam: 略
 // lParam: COLORREF - 新的背景颜色
 // Return: 略
  BGM_SETBKCOLOR = (WM_USER + 5);

 // Purpose: 取得控件背景颜色
 // wParam: 略
 // lParam: 略
 // Return: COLORREF - 当前背景颜色
  BGM_GETBKCOLOR = (WM_USER + 6);

 // Purpose: 设置控件文字颜色
 // wParam: 略
 // lParam: COLORREF - 新的文字颜色
 // Return: 略
  BGM_SETTEXTCOLOR = (WM_USER + 7);

 // Purpose: 取得控件文字颜色
 // wParam: 略
 // lParam: 略
 // Returns: COLORREF - 当前文字颜色
  BGM_GETTEXTCOLOR = (WM_USER + 8);

 // 对控件消息的简单包装
procedure BarGraph_SetBars(hWnd: HWND; cBars: UINT; PtBar: PBar);
function BarGraph_GetBars(hWnd: HWND): PBar;
function BarGraph_GetCount(hWnd: HWND): UINT;
procedure BarGraph_SetHeight(hWnd: HWND; nHeight: UINT);
function BarGraph_GetHeight(hWnd: HWND): UINT;
procedure BarGraph_SetBkColor(hWnd: HWND; crNew: COLORREF);
function BarGraph_GetBkColor(hWnd: HWND): COLORREF;
procedure BarGraph_SetTextColor(hWnd: HWND; crNew: COLORREF);
function BarGraph_GetTextColor(hWnd: HWND): COLORREF;

  // 注册/注销控件窗体类
function BarGraph_RegisterClass(HInst: THandle; fGlobalClass: BOOL): ATOM; stdcall;
function BarGraph_UnregisterClass(HInst: THandle): BOOL; stdcall;

implementation

uses CommCtrl;

 // 设置控件TBar数组
procedure BarGraph_SetBars(hWnd: HWND; cBars: UINT; PtBar: PBar);
begin
  SendMessage(hWnd, BGM_SETBARS, cBars, LPARAM(PtBar));
end;

 // 取得控件TBar数组
function BarGraph_GetBars(hWnd: HWND): PBar;
begin
  Result := PBar(SendMessage(hWnd, BGM_GETBARS, 0, 0));
end;

 // 取得控件TBar组员个数
function BarGraph_GetCount(hWnd: HWND): UINT;
begin
  Result := SendMessage(hWnd, BGM_GETCOUNT, 0, 0);
end;

 // 设置控件整体高度
procedure BarGraph_SetHeight(hWnd: HWND; nHeight: UINT);
begin
  SendMessage(hWnd, BGM_SETHEIGHT, nHeight, 0);
end;

 // 取得控件整体高度
function BarGraph_GetHeight(hWnd: HWND): UINT;
begin
  Result := SendMessage(hWnd, BGM_GETHEIGHT, 0, 0);
end;

 // 设置控件背景颜色
procedure BarGraph_SetBkColor(hWnd: HWND; crNew: COLORREF);
begin
  SendMessage(hWnd, BGM_SETBKCOLOR, 0, crNew);
end;

 // 取得控件背景颜色
function BarGraph_GetBkColor(hWnd: HWND): COLORREF;
begin
  Result := SendMessage(hWnd, BGM_GETBKCOLOR, 0, 0);
end;

 // 设置控件文字颜色
procedure BarGraph_SetTextColor(hWnd: HWND; crNew: COLORREF);
begin
  SendMessage(hWnd, BGM_SETTEXTCOLOR, 0, crNew);
end;

 // 取得控件文字颜色
function BarGraph_GetTextColor(hWnd: HWND): COLORREF;
begin
  Result := SendMessage(hWnd, BGM_GETTEXTCOLOR, 0, 0);
end;

type
 // 单个BarGraph信息结构
  PThisData = ^TThisData;
  TThisData = packed record
    nHeight: UINT; // 控件高度
    cBars: UINT; // TBar数组长度
    PtBar: PBar; // TBar数组地址
    nSelectedBar: UINT; // 当前选中的Bar
    nMouseDownBar: UINT; // 鼠标按下的Bar
    nCancelBar: UINT; // 上次选中的Bar
    crBk: COLORREF; // 背景颜色
    crText: COLORREF; // 文字颜色
  end;

 // BarGraph额外内存结构
  T_BarGraph_WndExtraBytes = record
    PThis: PThisData;
  end;

 // 取得控件TThisData地址
function GetThisData(hWnd: HWND): PThisData;
begin
  Result := PThisData(GetWindowLong(hWnd, 0));
end;

 // 设置控件TThisData地址
procedure SetThisData(hWnd: HWND; pThisNew: PThisData);
begin
  SetWindowLong(hWnd, 0, DWORD(pThisNew));
end;

 // BarGraph控件WM_CREATE处理
function BarGraph_OnCreate(hWnd: HWND; pcs: PCreateStruct): BOOL;
var
  crBk: COLORREF;
  hWndParent: LongWord; // HWND
  pThis: PThisData;
  lb: TLogBrush;
  hWndDc: HDC;
  hbr: HBRUSH;
begin
  hWndParent := GetParent(hWnd);

 // 分配内存并保存指针
  GetMem(pThis, SizeOf(TThisData));
  SetThisData(hWnd, pThis);

 // 采用父窗体背景颜色
  if (GetClassWord(hWndParent, GCW_ATOM) = 32770) then
  begin
    hWndDc := GetDC(hWndParent);
    hbr := SendMessage(hWndParent, WM_CTLCOLORDLG, hWndDc, hWndParent);
    ReleaseDC(hWndParent, hWndDc);

    GetObject(hbr, SizeOf(TLogBrush), @lb);
    crBk := lb.lbColor;
  end else
    crBk := GetSysColor(COLOR_WINDOW);

 // TThisData结构分配成功
 // 则进一步作控件初始化
  if (pThis <> nil) then
  begin
    BarGraph_SetHeight(hWnd, 100);
    BarGraph_SetBars(hWnd, 0, nil);
    BarGraph_SetBkColor(hWnd, crBk);
    BarGraph_SetTextColor(hWnd, GetSysColor(COLOR_WINDOWTEXT));
    pThis.nSelectedBar := 0;
  end;

 // 分配失败则返回FALSE
  Result := pThis <> nil;
end;

 // BarGraph控件WM_DESTROY处理
procedure BarGraph_OnDestroy(hWnd: HWND);
begin
 // 释放TThisData结构
  FreeMem(GetThisData(hWnd));
end;

 // BarGraph控件WM_GETDLGCODE处理
function BarGraph_OnGetDlgCode(hWnd: HWND; lpmsg: PMsg): UINT;
begin
 // 表示我们想要自己处理方向键
  Result := DLGC_WANTARROWS;

 // 如果lpmsg不空,  他指向一个包含当前消息的TMsg
  if (lpmsg <> nil) and (lpmsg.message = WM_KEYDOWN) then // 键盘按下
    if (lpmsg.wParam = VK_RETURN) or (lpmsg.wParam = VK_SPACE) then // 空格回车
      Result := Result or DLGC_WANTMESSAGE; // 表示自己处理(不作默认处理)
end;

 // 取BarGraph控件某个Bar范围
function BarGraph_GetBarRect(hWnd: HWND; n: UINT; prc: PRect): PRect;
const
  BarSpacing = 2; // Bar间距
var
  cxClient, cyClient: Integer;
  rcClient: TRect;
  pThis: PThisData;
begin
  pThis := GetThisData(hWnd);
  Result := prc;
  if (IsWindow(hWnd) = FALSE) or (prc = nil) or (pThis.cBars < n) then Exit;

 // BarGraph范围(不含坐标轴)
  GetClientRect(hWnd, rcClient);
  Inc(rcClient.Left);
  Dec(rcClient.Bottom);
  cxClient := rcClient.Right - rcClient.Left;
  cyClient := rcClient.Bottom - rcClient.Top;

 // 计算第n个Bar的左右边位置
  prc.Left := rcClient.Left + Int64(cxClient) * n div pThis.cBars + BarSpacing;
  prc.Right := rcClient.Left + Int64(cxClient) * (n + 1) div pThis.cBars;

 // 计算第n个Bar的上下边位置  
  prc.Top := rcClient.Bottom -
    Int64(cyClient) * PBar(DWORD(pThis.PtBar) + SizeOf(TBar) * n).nHeight div pThis.nHeight;
  prc.Bottom := rcClient.Bottom - BarSpacing;
end;

const
  INVALID_BAR = UINT(-1); // 标识非法的Bar

 // 计算指定位置所对应的Bar
function BarGraph_BarFromPoint(hWnd: HWND; x, y: Integer): UINT;
var
  rcBar: TRect;
  pThis: PThisData;
  pt: TPoint;
begin
  pThis := GetThisData(hWnd);
  pt.x := x;
  pt.y := y;

 // 如果位于某个Bar之内, 返回其编号
  Result := 0;
  while (Result < pThis.cBars) do
  begin
    if PtInRect(BarGraph_GetBarRect(hWnd, Result, @rcBar)^, pt) then Exit;
    Inc(Result);
  end;

 // 失败, 返回错误标识
  Result := INVALID_BAR;
end;

 // 向父窗体发送WM_NOTIFY通知
procedure BarGraph_NotifyParent(hWndCtl: HWND; code, uBar: UINT);
var
  bgn: T_BarGraph_Notify;
begin
  if (IsWindow(hWndCtl) = FALSE) then Exit;

  bgn.nmh.hwndFrom := hWndCtl;
  bgn.nmh.idFrom := GetDlgCtrlID(hWndCtl);
  bgn.nmh.code := code;
  bgn.uBar := uBar;

  SendMessage(GetParent(hWndCtl), WM_NOTIFY, bgn.nmh.idFrom, LPARAM(@bgn));
end;

 // BarGraph控件WM_LBUTTONDOWN处理
procedure BarGraph_OnLButtonDown(hWnd: HWND; fDoubleClick: BOOL; x, y: Integer; keyFlags: UINT);
var
  Bar: UINT;
begin
  Bar := BarGraph_BarFromPoint(hWnd, x, y);
  if (Bar <> INVALID_BAR) then
  begin
    GetThisData(hWnd).nMouseDownBar := Bar;
    GetThisData(hWnd).nCancelBar := GetThisData(hWnd).nSelectedBar;
    GetThisData(hWnd).nSelectedBar := Bar;
    InvalidateRect(hWnd, nil, FALSE); // 刷新
    SetFocus(hWnd);   // 设焦点给自己
    SetCapture(hWnd); // 接管鼠标消息
  end;
end;

 // BarGraph控件WM_LBUTTONUP处理
procedure BarGraph_OnLButtonUp(hWnd: HWND; x, y: Integer; keyFlags: UINT);
var
  Bar: UINT;
begin
 // 只有之前在本控件内按下的鼠标, 此时才处理抬起
  if (GetCapture() = hWnd) then
  begin
   // 鼠标抬起位置处的Bar
    Bar := BarGraph_BarFromPoint(hWnd, x, y);

   // 取消鼠标消息接管,
   // 注: 此函数通常会发送一个WM_CAPTURECHANGED,
   // 此处会导致 nSelectedBar 被设成 nCancelBar
    ReleaseCapture();

   // 抬起按下为相同的Bar
    if (Bar = GetThisData(hWnd).nMouseDownBar) then
    begin
     // 设置新的'选中'Bar
      GetThisData(hWnd).nSelectedBar := Bar;
      InvalidateRect(hWnd, nil, FALSE);

     // 通知父窗体单击事件
      BarGraph_NotifyParent(hWnd, UINT(NM_CLICK), Bar);
    end;
  end;
end;

 // BarGraph控件WM_MOUSEMOVE处理
procedure BarGraph_OnMouseMove(hWnd: HWND; x, y: Integer; keyFlags: UINT);
var
  Bar, nSelectedBar: UINT;
begin
 // 说明鼠标处于按下状态
  if (GetCapture() = hWnd) then
  begin