dyndlg.pas

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

unit DynDlg;

interface

uses Windows, Messages, DlgTmplt;

 // 产生对话框结构
function BuildDynamicDlgBox(fModeless: BOOL): PDlgTemplateEx;

 // 动态对话框过程
function DynDlg_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;

implementation

type
 // 自定义控件信息结构
  TDynDlgBoxData = record
    x, y, cx, cy: SHORT;
    dwStyle, dwExStyle, dwHelpId: DWORD;
    id: Integer;
    szClass, szText: PChar;
    wExtraDataCount: WORD;
    pbExtraData: PByte;
  end;

const
 // 动态对话框的控件ID
  IDC_EDITBOX  = 101;
  IDC_LISTBOX  = 102;
  IDC_RADIO1   = 103;
  IDC_RADIO2   = 104;
  IDC_CHECKBOX = 105;
  IDC_STATIC   = -1;

 // 主窗体'建立..'按钮ID
  IDC_MODELESS = 1001;

 // 动态对话框控件列表
  DynDlgBoxData: array[0..9] of TDynDlgBoxData = (
   ( x: 4; y: 4; cx: 32; cy: 12; dwStyle: SS_LEFT; dwExStyle: 0; dwHelpId: 0; id: IDC_STATIC;
     szClass: 'STATIC'; szText: '&Edit:'; wExtraDataCount: 0; pbExtraData: nil),

   ( x: 40; y: 4; cx: 64; cy: 12; dwStyle: ES_LEFT or WS_BORDER or WS_TABSTOP or WS_GROUP;
     dwExStyle: 0; dwHelpId: 0; id: IDC_EDITBOX; szClass: 'EDIT'; szText: '';
     wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 4; y: 18; cx: 40; cy: 8; dwStyle: SS_LEFT; dwExStyle: 0; dwHelpId: 0; id: IDC_STATIC;
     szClass: 'STATIC'; szText: '&Listbox:'; wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 4; y: 28; cx: 76; cy: 41; dwStyle: LBS_NOTIFY or LBS_SORT or LBS_STANDARD or
     WS_BORDER or WS_VSCROLL or WS_TABSTOP or WS_GROUP; dwExStyle: 0; dwHelpId: 0;
     id: IDC_LISTBOX; szClass: 'LISTBOX'; szText: ''; wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 132; y: 4; cx: 36; cy: 12; dwStyle: BS_DEFPUSHBUTTON or WS_TABSTOP or WS_GROUP;
     dwExStyle: 0; dwHelpId: 0; id: IDOK; szClass: 'BUTTON'; szText: 'OK';
     wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 176; y: 4; cx: 36; cy: 12; dwStyle: BS_PUSHBUTTON or WS_TABSTOP or WS_GROUP;
     dwExStyle: 0; dwHelpId: 0; id: IDCANCEL; szClass: 'BUTTON'; szText: 'Cancel';
     wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 88; y: 24; cx: 56; cy: 44; dwStyle: BS_GROUPBOX or WS_GROUP;
     dwExStyle: 0; dwHelpId: 0; id: IDC_STATIC; szClass: 'BUTTON';
     szText: 'Group box'; wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 92; y: 36; cx: 48; cy: 12; dwStyle: BS_AUTORADIOBUTTON or WS_TABSTOP or WS_GROUP;
     dwExStyle: 0; dwHelpId: 0; id: IDC_RADIO1; szClass: 'BUTTON'; szText: 'Radio &1';
     wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 92; y: 48; cx: 48; cy: 12; dwStyle: BS_AUTORADIOBUTTON or WS_TABSTOP;
     dwExStyle: 0; dwHelpId: 0; id: IDC_RADIO2; szClass: 'BUTTON'; szText: 'Radio &2';
     wExtraDataCount: 0; pbExtraData: nil ),

   ( x: 152; y: 32; cx: 60; cy: 12; dwStyle: BS_AUTOCHECKBOX or WS_TABSTOP or WS_GROUP;
     dwExStyle: 0; dwHelpId: 0; id: IDC_CHECKBOX; szClass: 'BUTTON';
     szText: 'C&heck box'; wExtraDataCount: 0; pbExtraData: nil )
                                                  );

 // 产生对话框结构
function BuildDynamicDlgBox(fModeless: BOOL): PDlgTemplateEx;
var
  x: Integer;
  fCtrlAddedOK: BOOL;
begin
  fCtrlAddedOK := TRUE;

 // 产生对话框内存模板
  if (fModeless) then
  begin
    Result := DlgTemplate_CreateA(WS_BORDER or WS_CAPTION or WS_DLGFRAME or
      WS_SYSMENU or WS_VISIBLE or WS_POPUP or DS_SETFONT, 0, 0, 6, 26, 216, 72,
      '', '', 'Dynamic Modeless Demo', 12, FW_NORMAL, 1, 'Courier New');
  end else
  begin
    Result := DlgTemplate_CreateA(WS_BORDER or WS_CAPTION or WS_DLGFRAME or
      WS_SYSMENU or WS_VISIBLE or WS_POPUP, 0, 0, 6, 26, 216, 72, '', '',
      'Dynamic Modal Demo', 0, 0, 0, nil);
  end;

  if (Result = nil) then Exit;

 // 添加数组中所有控件
  for x := Low(DynDlgBoxData) to High(DynDlgBoxData) do
  begin
   // 非模态对话框不添加OK按钮, 以便动态对话框过程区分
    if (fModeless) then
    begin
      if (DynDlgBoxData[x].id = IDOK) then Continue;
    end;

   // 向对话框结构尾部增加控件
    fCtrlAddedOK := DlgTemplate_AddControlA(Result,
      DynDlgBoxData[x].x, DynDlgBoxData[x].y,
      DynDlgBoxData[x].cx, DynDlgBoxData[x].cy,
      DynDlgBoxData[x].id, DynDlgBoxData[x].dwHelpId,
      DynDlgBoxData[x].dwStyle or WS_VISIBLE, DynDlgBoxData[x].dwExStyle,
      DynDlgBoxData[x].szClass, DynDlgBoxData[x].szText,
      DynDlgBoxData[x].wExtraDataCount, DynDlgBoxData[x].pbExtraData);

   // 添加控件失败, 则跳出循环
    if (fCtrlAddedOK = FALSE) then Break;
  end;

 // 添加控件失败, 释放内存, 返回nil
  if (fCtrlAddedOK = FALSE) then
  begin
    DlgTemplate_Free(Result);
    Result := nil;
  end;

 // 此函数返回对话框内存模板地址 ..
end;

 // 动态对话框WM_INITDIALOG消息处理
function DynDlg_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
begin
  Result := TRUE;
end;

 // 动态对话框WM_COMMAND消息处理
procedure DynDlg_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
begin       
  case (id) of
    IDOK, IDCANCEL:
      begin
        if IsWindow(GetDlgItem(hWnd, IDOK)) then // 如果有OK按钮, 则是模态对话框
          EndDialog(hwnd, id) // 删除模态对话框, 且结束其消息循环
        else
          if (id = IDCANCEL) then // 非模态对话框没有OK按钮
            PostMessage(GetParent(hWnd), // 发消息模拟按下主窗体'删除'按钮
              WM_COMMAND,
              MakeWParam(IDC_MODELESS, BN_CLICKED),
              GetDlgItem(GetParent(hWnd), IDC_MODELESS));
      end;
  end;
end;

 // 动态对话框过程
function DynDlg_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  case (uMsg) of
    WM_INITDIALOG:
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(DynDlg_OnInitDialog(hWnd, wParam, lParam))));
      end;
    WM_COMMAND:
      begin
        DynDlg_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
        Result := TRUE;
      end;
    else Result := FALSE;
  end;
end;

end.