简介
在这篇文章中，我将大概的从Delphi XE2 的Dialogs单元入手，分析ShowMessage，MessageBox等对话框运行原理，希望能帮助你理解Delphi，不求你爱上她，只求让你能快速地解决问题。跟踪代码
为了了解这些对话框的运行原理，我们需要跟踪进源代码中去，为此，你需要做如下设置1. 简单创建一个使用了ShowMessage的VCL应用程序
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage(Edit1.Text); MessageBox(Self.Handle,PChar(Edit1.Text),PChar(Application.Title), MB_ICONINFORMATION or MB_OK); MessageDlg(Edit1.Text,mtInformation,[mbOK,mbCancel],0); end; end.
DFM文件代码：
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 243 ClientWidth = 472 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Edit1: TEdit Left = 128 Top = 72 Width = 209 Height = 21 TabOrder = 0 TextHint = 'Message here' end object Button1: TButton Left = 192 Top = 120 Width = 75 Height = 25 Caption = 'Message box' TabOrder = 1 _disibledevent=>
2. 在29行里设置一个断点, 再在Edit里输入一些内容,按下Message Box按钮, 按F7跟踪到Dialogs单元, 经过一段时间的仔细跟踪, 你会发现程序运行到下面一段代码:
function MessageDlgPosHelp(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; const HelpFileName: string): Integer; begin if (Win32MajorVersion >= 6) and UseLatestCommonDialogs and ThemeServices.ThemesEnabled then Result := DoTaskMessageDlgPosHelp('', Msg, DlgType, Buttons, HelpCtx, X, Y, HelpFileName) else Result := DoMessageDlgPosHelp(CreateMessageDialog(Msg, DlgType, Buttons), HelpCtx, X, Y, HelpFileName); end;
函数MessageDlgPosHelp指出, 如果当前系统是Vista,sever2008或以上版本的系统,那就调用DoTaskMessageDlgPosHelp函数进行对话框显示, 否则调用DoMessageDlgPosHelp显示对话框. 继续跟踪DoTaskMessageDlgPosHelp函数, 你会发现如下一段代码:
function TCustomTaskDialog.DoExecute(ParentWnd: HWND): Boolean; const CTaskDlgFlags: array[TTaskDialogFlag] of Cardinal = ( TDF_Enable_Hyperlinks, TDF_Use_Hicon_Main, tdf_Use_Hicon_Footer, TDF_ALLOW_DIALOG_CANCELLATION, TDF_USE_COMMAND_LINKS, TDF_USE_COMMAND_LINKS_NO_ICON, TDF_EXPAND_FOOTER_AREA, TDF_EXPANDED_BY_DEFAULT, TDF_VERIFICATION_FLAG_CHECKED, TDF_SHOW_PROGRESS_BAR, TDF_SHOW_MARQUEE_PROGRESS_BAR, TDF_CALLBACK_TIMER, TDF_POSITION_RELATIVE_TO_WINDOW, TDF_RTL_LAYOUT, TDF_NO_DEFAULT_RADIO_BUTTON, TDF_CAN_BE_MINIMIZED); CTaskDlgCommonButtons: array[TTaskDialogCommonButton] of Cardinal = ( TDCBF_OK_BUTTON, TDCBF_YES_BUTTON, TDCBF_NO_BUTTON, TDCBF_CANCEL_BUTTON, TDCBF_RETRY_BUTTON, TDCBF_CLOSE_BUTTON); CTaskDlgDefaultButtons: array[TTaskDialogCommonButton] of Integer = ( IDOK, IDYES, IDNO, IDCANCEL, IDRETRY, IDCLOSE); var LWindowList: TTaskWindowList; LModalResult: Integer; LRadioButton: Integer; LFlag: TTaskDialogFlag; LFocusState: TFocusState; LVerificationChecked: LongBool; LTaskDialog: TTaskDialogConfig; LCommonButton: TTaskDialogCommonButton; begin if Win32MajorVersion < 6 then raise EPlatformVersionException.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SWindowsVistaRequired, [ClassName]); if not ThemeServices.ThemesEnabled then raise Exception.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SXPThemesRequired, [ClassName]); {$IF NOT DEFINED(CLR)} FillChar(LTaskDialog, SizeOf(LTaskDialog), 0); {$IFEND} with LTaskDialog do begin // Set Size, Parent window, Flags cbSize := SizeOf(LTaskDialog); hwndParent := ParentWnd; dwFlags := 0; for LFlag := Low(TTaskDialogFlag) to High(TTaskDialogFlag) do if LFlag in FFlags then dwFlags := dwFlags or CTaskDlgFlags[LFlag]; // Set CommonButtons dwCommonButtons := 0; for LCommonButton := Low(TTaskDialogCommonButton) to High(TTaskDialogCommonButton) do if LCommonButton in FCommonButtons then dwCommonButtons := dwCommonButtons or CTaskDlgCommonButtons[LCommonButton]; // Set Content, MainInstruction, Title, MainIcon, DefaultButton if FText <> '' then pszContent := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FText)); if FTitle <> '' then pszMainInstruction := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FTitle)); if FCaption <> '' then pszWindowTitle := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FCaption)); if tfUseHiconMain in FFlags then hMainIcon := FCustomMainIcon.Handle else begin if FMainIcon in [tdiNone..tdiShield] then pszMainIcon := LPCWSTR(CTaskDlgIcons[FMainIcon]) else pszMainIcon := LPCWSTR(MakeIntResourceW(Word(FMainIcon))); end; nDefaultButton := CTaskDlgDefaultButtons[FDefaultButton]; // Set Footer, FooterIcon if FFooterText <> '' then pszFooter := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FFooterText)); if tfUseHiconFooter in FFlags then hFooterIcon := FCustomFooterIcon.Handle else begin if FFooterIcon in [tdiNone..tdiShield] then pszFooterIcon := LPCWSTR(CTaskDlgIcons[FFooterIcon]) else pszFooterIcon := LPCWSTR(MakeIntResourceW(Word(FFooterIcon))); end; // Set VerificationText, ExpandedInformation, CollapsedControlText if FVerificationText <> '' then pszVerificationText := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FVerificationText)); if FExpandedText <> '' then pszExpandedInformation := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandedText)); if FExpandButtonCaption <> '' then pszCollapsedControlText := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandButtonCaption)); // Set Buttons cButtons := FButtons.Count; if cButtons > 0 then pButtons := FButtons.Buttons; if FButtons.DefaultButton <> nil then nDefaultButton := FButtons.DefaultButton.ModalResult; // Set RadioButtons cRadioButtons := FRadioButtons.Count; if cRadioButtons > 0 then pRadioButtons := FRadioButtons.Buttons; if not (tfNoDefaultRadioButton in FFlags) and (FRadioButtons.DefaultButton <> nil) then nDefaultRadioButton := FRadioButtons.DefaultButton.ModalResult; // Prepare callback {$IF DEFINED(CLR)} pfCallBack := @CallbackProc; {$ELSE} lpCallbackData := LONG_PTR(Self); pfCallback := @TaskDialogCallbackProc; {$IFEND} end; LWindowList := DisableTaskWindows(ParentWnd); LFocusState := SaveFocusState; try Result := TaskDialogIndirect(LTaskDialog, {$IFNDEF CLR}@{$ENDIF}LModalResult, {$IFNDEF CLR}@{$ENDIF}LRadioButton, {$IFNDEF CLR}@{$ENDIF}LVerificationChecked) = S_OK; FModalResult := LModalResult; if Result then begin FButton := TTaskDialogButtonItem(FButtons.FindButton(FModalResult)); FRadioButton := TTaskDialogRadioButtonItem(FRadioButtons.FindButton(LRadioButton)); if LVerificationChecked then Include(FFlags, tfVerificationFlagChecked) else Exclude(FFlags, tfVerificationFlagChecked); end; finally EnableTaskWindows(LWindowList); SetActiveWindow(ParentWnd); RestoreFocusState(LFocusState); end; end;
上面这段代码在Dialogs单元的第5407行, 该函数先进行可用性判断, 然后填充
LTaskDialog: TTaskDialogConfig;
一个TTaskDialogConfig的结构体, 该结构体定义在CommCtrl单元第9550行, 其定义如下:
type { $EXTERNALSYM TASKDIALOGCONFIG} TASKDIALOGCONFIG = packed record cbSize: UINT; hwndParent: HWND; hInstance: HINST; // used for MAKEINTRESOURCE() strings dwFlags: DWORD; // TASKDIALOG_FLAGS (TDF_XXX) flags dwCommonButtons: DWORD; // TASKDIALOG_COMMON_BUTTON (TDCBF_XXX) flags pszWindowTitle: LPCWSTR; // string or MAKEINTRESOURCE() case Integer of 0: (hMainIcon: HICON); 1: (pszMainIcon: LPCWSTR; pszMainInstruction: LPCWSTR; pszContent: LPCWSTR; cButtons: UINT; pButtons: PTaskDialogButton; nDefaultButton: Integer; cRadioButtons: UINT; pRadioButtons: PTaskDialogButton; nDefaultRadioButton: Integer; pszVerificationText: LPCWSTR; pszExpandedInformation: LPCWSTR; pszExpandedControlText: LPCWSTR; pszCollapsedControlText: LPCWSTR; case Integer of 0: (hFooterIcon: HICON); 1: (pszFooterIcon: LPCWSTR; pszFooter: LPCWSTR; pfCallback: TFTaskDialogCallback; lpCallbackData: LONG_PTR; cxWidth: UINT // width of the Task Dialog's client area in DLU's. // If 0, Task Dialog will calculate the ideal width. ); ); end; {$EXTERNALSYM _TASKDIALOGCONFIG} _TASKDIALOGCONFIG = TASKDIALOGCONFIG; PTaskDialogConfig = ^TTaskDialogConfig; TTaskDialogConfig = TASKDIALOGCONFIG;
该结构体其实是从MSDN里翻译过来的, 定义在CommCtrl.h 头文件里(需要Windows Vista, Windows Server 2008及以上版本, 我是用Windows 7 64位进行的测试), 详细说明可以查看MSDN.
TCustomTaskDialog.DoExecute 填充完LTaskDialog结构体后, 直接调用:
Result := TaskDialogIndirect(LTaskDialog, {$IFNDEF CLR}@{$ENDIF}LModalResult, {$IFNDEF CLR}@{$ENDIF}LRadioButton, {$IFNDEF CLR}@{$ENDIF}LVerificationChecked) = S_OK;
TaskDialogIndirect显示对话框, TaskDialogIndirect定义在CommCtrl单元, 其代码如下:
{ Task Dialog } var _TaskDialogIndirect: function(const pTaskConfig: TTaskDialogConfig; pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT; stdcall; _TaskDialog: function(hwndParent: HWND; hInstance: HINST; pszWindowTitle: LPCWSTR; pszMainInstruction: LPCWSTR; pszContent: LPCWSTR; dwCommonButtons: DWORD; pszIcon: LPCWSTR; pnButton: PInteger): HRESULT; stdcall; function TaskDialogIndirect(const pTaskConfig: TTaskDialogConfig; pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT; begin if Assigned(_TaskDialogIndirect) then Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton, pfVerificationFlagChecked) else begin InitComCtl; Result := E_NOTIMPL; if ComCtl32DLL <> 0 then begin @_TaskDialogIndirect := GetProcAddress(ComCtl32DLL, 'TaskDialogIndirect'); if Assigned(_TaskDialogIndirect) then Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton, pfVerificationFlagChecked) end; end; end;
查看代码知道, TaskDialogIndirect 直接调用ComCtrl32.Dll里的函数:TaskDialogIndirect 显示对话框. 通过查询MSDN了解TaskDialogIndirect API的用途与用法:
The TaskDialogIndirect function creates, displays, and operates a task dialog. The task dialog contains application-defined icons, messages, title, verification check box, command links, push buttons, and radio buttons. This function can register a callback function to receive notification messages.
函数TaskDialogIndirect 用于创建, 显示, 运行一个任务对话框, 这个任务对话框可以包括由应用程序定义的图标,消息,标题,复选框,按钮,单选框. 该函数还可以接收一个回调函数用于接收通知信息
看到这里你或许会问:
如果我的系统是xp或其他低于Vista, server2008的系统呢? 由上文中可知, 如果是低版本的系统, 则调用DoMessageDlgPosHelp 函数进行对话框显示, 调用代码如下:Result := DoMessageDlgPosHelp(CreateMessageDialog(Msg, DlgType, Buttons), HelpCtx, X, Y, HelpFileName);
DoMessageDlgPosHelp代码:
function DoMessageDlgPosHelp(MessageDialog: TForm; HelpCtx: Longint; X, Y: Integer; const HelpFileName: string): Integer; begin with MessageDialog do try HelpContext := HelpCtx; HelpFile := HelpFileName; if X >= 0 then Left := X; if Y >= 0 then Top := Y; if (Y < 0) and (X < 0) then Position := poScreenCenter; Result := ShowModal; finally Free; end; end;
从DoMessageDlgPosHelp代码中可见, 该函数只是简单的将传递进来的TForm以模式窗口的形式显示在指定的位置.
下面是CreateMessageDialog代码:
function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TForm; const mcHorzMargin = 8; mcVertMargin = 8; mcHorzSpacing = 10; mcVertSpacing = 10; mcButtonWidth = 50; mcButtonHeight = 14; mcButtonSpacing = 4; var DialogUnits: TPoint; HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth, ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth, IconTextWidth, IconTextHeight, X, ALeft: Integer; B, CancelButton: TMsgDlgBtn; {$IF DEFINED(CLR)} IconID: Integer; {$ELSE} IconID: PChar; {$IFEND} TextRect: TRect; LButton: TButton; begin Result := TMessageForm.CreateNew(Application); with Result do begin BiDiMode := Application.BiDiMode; BorderStyle := bsDialog; Canvas.Font := Font; KeyPreview := True; PopupMode := pmAuto; Position := poDesigned; _disibledevent=> ButtonWidth then ButtonWidth := ButtonWidths[B]; end; end; ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8); ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4); SetRect(TextRect, 0, 0, Screen.Width div 2, 0); DrawText(Canvas.Handle, Msg, Length(Msg)+1, TextRect, DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly); IconID := IconIDs[DlgType]; IconTextWidth := TextRect.Right; IconTextHeight := TextRect.Bottom; {$IF DEFINED(CLR)} if DlgType <> mtCustom then {$ELSE} if IconID <> nil then {$IFEND} begin Inc(IconTextWidth, 32 + HorzSpacing); if IconTextHeight < 32 then IconTextHeight := 32; end; ButtonCount := 0; for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do if B in Buttons then Inc(ButtonCount); ButtonGroupWidth := 0; if ButtonCount <> 0 then ButtonGroupWidth := ButtonWidth * ButtonCount + ButtonSpacing * (ButtonCount - 1); ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2; ClientHeight := IconTextHeight + ButtonHeight + VertSpacing + VertMargin * 2; Left := (Screen.Width div 2) - (Width div 2); Top := (Screen.Height div 2) - (Height div 2); if DlgType <> mtCustom then {$IF DEFINED(CLR)} Caption := Captions[DlgType] else Caption := Application.Title; if DlgType <> mtCustom then {$ELSE} Caption := LoadResString(Captions[DlgType]) else Caption := Application.Title; if IconID <> nil then {$IFEND} with TImage.Create(Result) do begin Name := 'Image'; Parent := Result; Picture.Icon.Handle := LoadIcon(0, IconID); SetBounds(HorzMargin, VertMargin, 32, 32); end; TMessageForm(Result).Message := TLabel.Create(Result); with TMessageForm(Result).Message do begin Name := 'Message'; Parent := Result; WordWrap := True; Caption := Msg; BoundsRect := TextRect; BiDiMode := Result.BiDiMode; ALeft := IconTextWidth - TextRect.Right + HorzMargin; if UseRightToLeftAlignment then ALeft := Result.ClientWidth - ALeft - Width; SetBounds(ALeft, VertMargin, TextRect.Right, TextRect.Bottom); end; if mbCancel in Buttons then CancelButton := mbCancel else if mbNo in Buttons then CancelButton := mbNo else CancelButton := mbOk; X := (ClientWidth - ButtonGroupWidth) div 2; for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do if B in Buttons then begin LButton := TButton.Create(Result); with LButton do begin Name := ButtonNames[B]; Parent := Result; {$IF DEFINED(CLR)} Caption := ButtonCaptions[B]; {$ELSE} Caption := LoadResString(ButtonCaptions[B]); {$IFEND} ModalResult := ModalResults[B]; if B = DefaultButton then begin Default := True; ActiveControl := LButton; end; if B = CancelButton then Cancel := True; SetBounds(X, IconTextHeight + VertMargin + VertSpacing, ButtonWidth, ButtonHeight); Inc(X, ButtonWidth + ButtonSpacing); if B = mbHelp then _disibledevent=>
由代码可见, CreateMessageDialog只是创建了一个TMessageForm, 然后动态地添加了一些设置. 写到这里或许可以解答一些人的问题: 对话框是不是一个窗口? 答案是:是.
你还可能会问: 为什么对话框可以停留在那一行代码直到用户操作完毕后再往下执行, 这里就需要了解一下模态窗口的知识: 请参见这篇文章 Delphi ShowModal解析
最新评论