Delphi XE2對話框?qū)崿F(xiàn)源碼分析
在這篇文章中,我將大概的從Delphi XE2 的Dialogs單元入手,分析ShowMessage,MessageBox等對話框運行原理,希望能幫助你理解Delphi,不求你愛上她,只求讓你能快速地解決問題。
跟蹤代碼
為了了解這些對話框的運行原理,我們需要跟蹤進源代碼中去,為此,你需要做如下設置
1. 簡單創(chuàng)建一個使用了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
- OnClick = Button1Click
- end
- end
2. 在29行里設置一個斷點, 再在Edit里輸入一些內(nèi)容,按下Message Box按鈕, 按F7跟蹤到Dialogs單元, 經(jīng)過一段時間的仔細跟蹤, 你會發(fā)現(xiàn)程序運行到下面一段代碼:
- 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;
函數(shù)MessageDlgPosHelp指出, 如果當前系統(tǒng)是Vista,sever2008或以上版本的系統(tǒng),那就調(diào)用DoTaskMessageDlgPosHelp函數(shù)進行對話框顯示, 否則調(diào)用DoMessageDlgPosHelp顯示對話框. 繼續(xù)跟蹤DoTaskMessageDlgPosHelp函數(shù), 你會發(fā)現(xiàn)如下一段代碼:
- 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行, 該函數(shù)先進行可用性判斷, 然后填充
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結構體后, 直接調(diào)用:
- 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 直接調(diào)用ComCtrl32.Dll里的函數(shù):TaskDialogIndirect 顯示對話框. 通過查詢MSDN了解TaskDialogIndirect API的用途與用法:
The TaskDialogIndirectfunction 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.
函數(shù)TaskDialogIndirect 用于創(chuàng)建, 顯示, 運行一個任務對話框, 這個任務對話框可以包括由應用程序定義的圖標,消息,標題,復選框,按鈕,單選框. 該函數(shù)還可以接收一個回調(diào)函數(shù)用于接收通知信息
看到這里你或許會問:
如果我的系統(tǒng)是xp或其他低于Vista, server2008的系統(tǒng)呢? 由上文中可知, 如果是低版本的系統(tǒng), 則調(diào)用DoMessageDlgPosHelp 函數(shù)進行對話框顯示, 調(diào)用代碼如下:
- 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代碼中可見, 該函數(shù)只是簡單的將傳遞進來的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;
- OnKeyDown := TMessageForm(Result).CustomKeyDown;
- DialogUnits := GetAveCharSize(Canvas);
- HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
- VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
- HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
- VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
- ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
- for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
- begin
- if B in Buttons then
- begin
- if ButtonWidths[B] = 0 then
- begin
- TextRect := Rect(0,0,0,0);
- Windows.DrawText( canvas.handle,
- {$IF DEFINED(CLR)}
- ButtonCaptions[B], -1,
- {$ELSE}
- PChar(LoadResString(ButtonCaptions[B])), -1,
- {$IFEND}
- TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
- DrawTextBiDiModeFlagsReadingOnly);
- with TextRect do ButtonWidths[B] := Right - Left + 8;
- end;
- if ButtonWidths[B] >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
- OnClick := TMessageForm(Result).HelpButtonClick;
- end;
- end;
- end;
- end;
由代碼可見, CreateMessageDialog只是創(chuàng)建了一個TMessageForm, 然后動態(tài)地添加了一些設置. 寫到這里或許可以解答一些人的問題: 對話框是不是一個窗口? 答案是:是.
你還可能會問: 為什么對話框可以停留在那一行代碼直到用戶操作完畢后再往下執(zhí)行, 這里就需要了解一下模態(tài)窗口的知識。
原文鏈接:http://www.cnblogs.com/neugls/archive/2011/09/14/2176733.html
【編輯推薦】
- Delphi與C#之父:技術理想架構開發(fā)傳奇
- Delphi 2010初體驗:徹底告別內(nèi)存泄露
- 開發(fā)熱點周報:Delphi 2010出爐 mixin進駐JavaFX
- Delphi XE2將出 一場技術革命即將打響
- 9月TIOBE編程語言排行榜發(fā)布 Delphi東山再起