custcntl.dpr

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

program CustCntl;

{$R CustCntl.res}

uses Windows, Messages, CommCtrl, Legend in 'Legend.pas', BarGraph in 'BarGraph.pas';

const
 // 图标资源ID
  IDI_CUSTCNTL = 102;

 // 模板资源ID
  IDD_CUSTCNTL = 103;

 // 窗口控件ID
  IDC_BARGRAPH = 1005;
  IDC_APILABEL = 1009;
  IDC_USER = 1006;
  IDC_GDI = 1007;
  IDC_KERNEL = 1008;

 // Legend控件ID范围及其数量
  FIRST_LEGEND = 1000;
  LAST_LEGEND = 1004;
  NUM_LEGENDS = LAST_LEGEND - FIRST_LEGEND + 1;

 // BarGraph控件高度
  APIGRAPH_HEIGHT = 750;

 // 设置当前Bars列表
procedure CustCntl_SetBars(hWnd: HWND; nIDC: Integer);
const
 // 各版本Windows三大模块分别提供的API数量
  anAPICallsUser: array[0..4] of Integer = ( 236, 283, 387, 413, 563 ); // User
  anAPICallsGDI: array[0..4] of Integer = ( 183, 213, 235, 283, 332 );  // GDI
  anAPICallsKernel: array[0..4] of Integer = ( 103, 141, 192, 233, 707 ); // Kernel  
var
  J, cBars: Integer;
  hWndBarGraph: LongWord; // HWND
  PtBar: PBar;
  pnAPICalls: PInteger;
begin
  hWndBarGraph := GetDlgItem(hWnd, IDC_BARGRAPH);
  cBars := BarGraph_GetCount(hWndBarGraph);
  PtBar := BarGraph_GetBars(hWndBarGraph);

  if (PtBar <> nil) then
  begin
   // 区分模块
    case (nIDC) of
      IDC_GDI:
        begin
          pnAPICalls := @anAPICallsGDI[0];
          SetDlgItemText(hWnd, IDC_APILABEL, '&Number of GDI API Functions');
        end;

      IDC_USER:
        begin
          pnAPICalls := @anAPICallsUser[0];
          SetDlgItemText(hWnd, IDC_APILABEL, '&Number of User API Functions');
        end;

      IDC_KERNEL:
        begin
          pnAPICalls := @anAPICallsKernel[0];
          SetDlgItemText(hWnd, IDC_APILABEL, '&Number of Kernel API Functions');
        end;
            
      else Exit;  
    end;

   // 修改高度
    for J := 0 to cBars - 1 do
    begin
      PBar(Integer(PtBar) + J * SizeOf(TBar)).nHeight :=
        PInteger(Integer(pnAPICalls) + J * SizeOf(Integer))^;
    end;

   // 修改生效
    BarGraph_SetBars(hWndBarGraph, cBars, PtBar);
  end;
end;

 // 主窗体对话框WM_INITDIALOG处理
function CustCntl_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
const
  alb: array[0..4] of TLogBrush = // 画刷列表
   ( ( lbStyle: BS_HATCHED; lbColor: $FFFF00; lbHatch: HS_HORIZONTAL ),
     ( lbStyle: BS_HATCHED; lbColor: $FF00FF; lbHatch: HS_FDIAGONAL ),
     ( lbStyle: BS_HATCHED; lbColor: $0000FF; lbHatch: HS_DIAGCROSS ),
     ( lbStyle: BS_HATCHED; lbColor: $00FF00; lbHatch: HS_CROSS ),
     ( lbStyle: BS_HATCHED; lbColor: $FF0000; lbHatch: HS_BDIAGONAL ) );
var
  J, cBars: Integer;
  hWndBarGraph: LongWord; // HWND
  PtBar: PBar;
begin
  cBars := NUM_LEGENDS;
  GetMem(PtBar, SizeOf(TBar) * cBars); // 为TBar数组分配内存
  hWndBarGraph := GetDlgItem(hWnd, IDC_BARGRAPH);

  if (PtBar <> nil) then
  begin
   // 填写TBar数组, 设置Legend控件..
    for J := 0 to cBars - 1 do
    begin
      PBar(Integer(PtBar) + SizeOf(TBar) * J).hbr := CreateBrushIndirect(alb[J]); // 画刷
      PBar(Integer(PtBar) + SizeOf(TBar) * J).nHeight := 0; // 高度

      if (PBar(Integer(PtBar) + SizeOf(TBar) * J).hbr <> 0) then
        Legend_SetBoxBrush(GetDlgItem(hWnd, FIRST_LEGEND + J), PBar(Integer(PtBar) + SizeOf(TBar) * J).hbr);
    end;

   // 设置Bars列表和BarGraph高度
    BarGraph_SetBars(hWndBarGraph, cBars, PtBar);
    BarGraph_SetHeight(hWndBarGraph, APIGRAPH_HEIGHT);

   // 初始化, 选择并显示User模块
    CheckRadioButton(hWnd, IDC_USER, IDC_KERNEL, IDC_USER);
    CustCntl_SetBars(hWnd, IDC_USER);
  end else
  begin
   // 内存分配失败, 则结束主窗口(模态对话框)
    BarGraph_SetBars(hWndBarGraph, 0, nil);
    EndDialog(hWnd, 0); // FALSE
  end;

 // 设置图标
  SendMessage(hWnd, WM_SETICON, ICON_BIG, LoadIcon(HInstance, MakeIntResource(IDI_CUSTCNTL)));

 // 接受焦点
  Result := TRUE;
end;

 // 主窗体对话框WM_DESTROY处理
procedure CustCntl_OnDestroy(hWnd: HWND);
var
  J: Integer;
  hbr: HBRUSH;
begin
 // 清除画刷对象
  for J := 0 to NUM_LEGENDS - 1 do
  begin
    hbr := Legend_GetBoxBrush(GetDlgItem(hWnd, FIRST_LEGEND + J));
    if (GetObjectType(hbr) = OBJ_BRUSH) then DeleteObject(hbr);
  end;

 // 释放TBar数组
  FreeMem(BarGraph_GetBars(GetDlgItem(hWnd, IDC_BARGRAPH)));
end;

 // 去除'&'字符
procedure RemoveAccelerators(pSrc: PChar);
var
  pDest: PChar;
begin
  pDest := pSrc;
  
  while (pSrc^ <> #0) do
  begin
    if (pSrc^ <> '&') then
    begin
      pDest^ := pSrc^;
      Inc(pDest);
    end;
    Inc(pSrc);
  end;

  pDest^ := #0;
end;

 // 返回被选按钮ID
function GetRadioCheck(hWnd: HWND; idcFirst, idcLast: Integer): Integer;
begin
  for Result := idcFirst to idcLast do
    if (IsDlgButtonChecked(hWnd, Result) = BST_CHECKED) then
      Exit;

  Result := -1;
end;

 // 主窗体对话框WM_NOTIFY处理
function CustCntl_OnNotify(hWnd: HWND; idCtl: Integer; pnmh: PNMHdr): LRESULT;
var
  pbgn: P_BarGraph_Notify;
  sz: array[0..256] of Char;
  szWindowsVersion: array[0..64] of Char;
  szModule: array[0..64] of Char;
  idcModule: Integer;
  ArgList: array[1..4] of DWORD;
begin
  case (idCtl) of
    IDC_BARGRAPH:
      begin
        pbgn := P_BarGraph_Notify(pnmh);
        if (pbgn.nmh.code = NM_CLICK) then
        begin
         // 选择的Windows版本
          GetDlgItemText(hWnd, FIRST_LEGEND + pbgn.uBar, szWindowsVersion, SizeOf(szWindowsVersion));
          RemoveAccelerators(szWindowsVersion);

         // 选择的Windows模块
          idcModule := GetRadioCheck(hWnd, IDC_USER, IDC_KERNEL);
          if (idcModule <> -1) then
          begin
            GetDlgItemText(hWnd, idcModule, szModule, SizeOf(szModule));
            RemoveAccelerators(szModule);
          end else
            szModule[0] := #0;

         // 显示格式化字符串
          ArgList[1] := pbgn.uBar + 1;
          ArgList[2] := DWORD(@szWindowsVersion[0]);
          ArgList[3] := DWORD(@szModule[0]);
          ArgList[4] := PBar(DWORD(BarGraph_GetBars(GetDlgItem(hWnd, idCtl))) + pbgn.uBar * SizeOf(TBar)).nHeight;
          wvsprintf(sz, 'You picked bar #%d.'#13#10'%s %s - %d API calls.', @ArgList[1]);
          MessageBox(hWnd, sz, 'Notification', MB_OK);
        end;
      end;
  end; // END: case (idCtl) of .. 

  Result := 0; // Return(0)
end;

 // 主窗体对话框WM_COMMAND处理
procedure CustCntl_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
begin
  case (id) of
    IDC_KERNEL, IDC_USER, IDC_GDI:
      begin
        CustCntl_SetBars(hWnd, id); // 调整当前选中模块
      end;
      
    IDCANCEL:
      begin
        EndDialog(hWnd, id); // 结束主窗体(模态对话框)
      end;  
  end;
end;

 // 主窗体对话框消息处理过程
function CustCntl_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  Result := TRUE;

  case (uMsg) of
    WM_INITDIALOG:
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(CustCntl_OnInitDialog(hWnd, wParam, lParam))));
      end;

    WM_DESTROY:
      begin
        CustCntl_OnDestroy(hWnd);
      end;

    WM_COMMAND:
      begin
        CustCntl_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
      end;
      
    WM_NOTIFY:
      begin
        CustCntl_OnNotify(hWnd, wParam, PNMHdr(lParam));
      end;

    else Result := FALSE;
  end;
end;

 // 程序'主线程'入口
var
  atomLegend, atomBarGraph: ATOM;
begin
 // 注册控件类别
  atomLegend := Legend_RegisterClass(HInstance, FALSE);
  atomBarGraph := BarGraph_RegisterClass(HInstance, FALSE);

 // 如果注册成功
  if (atomLegend <> INVALID_ATOM) and (atomBarGraph <> INVALID_ATOM) then
  begin
   // 建立主窗口并作消息循环
    DialogBox(HInstance, MakeIntResource(IDD_CUSTCNTL), 0, @CustCntl_DlgProc);
  end;

 // 注销控件类别
  if (atomLegend <> INVALID_ATOM) then Legend_UnregisterClass(HInstance);
  if (atomBarGraph <> INVALID_ATOM) then BarGraph_UnregisterClass(HInstance);
end.