51CTO首页
AI.x社区
博客
学堂
精品班
直播训练营
企业培训
鸿蒙开发者社区
WOT技术大会
AIGC创新中国行
公众号矩阵
移动端
短视频免费课程课程排行直播课软考学堂
全部课程厂商认证IT技术2024年软考PMP项目管理软考资讯
在线学习
文章资源问答课堂专栏直播
51CTO
鸿蒙开发者社区
51CTO技术栈
51CTO官微
51CTO学堂
51CTO博客
CTO训练营
鸿蒙开发者社区订阅号
51CTO题库小程序
51CTO学堂APP
51CTO学堂企业版APP
鸿蒙开发者社区视频号
账号设置 退出

Delphi XE2对话框实现源码分析

作者：潺缘
开发 开发工具
本文将给大家分析Delphi XE2对话框的实现源码，分析ShowMessage，MessageBox等对话框运行原理，希望能帮助你理解Delphi。

　　在这篇文章中，我将大概的从Delphi XE2 的Dialogs单元入手，分析ShowMessage，MessageBox等对话框运行原理，希望能帮助你理解Delphi，不求你爱上她，只求让你能快速地解决问题。

　　跟踪代码

　　为了了解这些对话框的运行原理，我们需要跟踪进源代码中去，为此，你需要做如下设置

　　1. 简单创建一个使用了ShowMessage的VCL应用程序

  1. 　　unit Unit1;  
  2. 　　interface 
  3. 　　uses  
  4. 　　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  5. 　　Dialogs, StdCtrls;  
  6. 　　type  
  7. 　　TForm1 = class(TForm)  
  8. 　　Edit1: TEdit;  
  9. 　　Button1: TButton;  
  10. 　　procedure Button1Click(Sender: TObject);  
  11. 　　private 
  12. 　　{ Private declarations }  
  13. 　　public 
  14. 　　{ Public declarations }  
  15. 　　end;  
  16. 　　var  
  17. 　　Form1: TForm1;  
  18. 　　implementation  
  19. 　　{$R *.dfm}  
  20. 　　procedure TForm1.Button1Click(Sender: TObject);  
  21. 　　begin  
  22. 　　ShowMessage(Edit1.Text);  
  23. 　　MessageBox(Self.Handle,PChar(Edit1.Text),PChar(Application.Title),  
  24. 　　MB_ICONINFORMATION or MB_OK);  
  25. 　　MessageDlg(Edit1.Text,mtInformation,[mbOK,mbCancel],0);  
  26. 　　end;  
  27. 　　end.  
  28. 　　DFM文件代码：  
  29. 　　object Form1: TForm1  
  30. 　　Left = 0  
  31. 　　Top = 0  
  32. 　　Caption = 'Form1' 
  33. 　　ClientHeight = 243  
  34. 　　ClientWidth = 472  
  35. 　　Color = clBtnFace  
  36. 　　Font.Charset = DEFAULT_CHARSET  
  37. 　　Font.Color = clWindowText  
  38. 　　Font.Height = -11  
  39. 　　Font.Name = 'Tahoma' 
  40. 　　Font.Style = []  
  41. 　　OldCreateOrder = False  
  42. 　　PixelsPerInch = 96  
  43. 　　TextHeight = 13  
  44. 　　object Edit1: TEdit  
  45. 　　Left = 128  
  46. 　　Top = 72  
  47. 　　Width = 209  
  48. 　　Height = 21  
  49. 　　TabOrder = 0  
  50. 　　TextHint = 'Message here' 
  51. 　　end  
  52. 　　object Button1: TButton  
  53. 　　Left = 192  
  54. 　　Top = 120  
  55. 　　Width = 75  
  56. 　　Height = 25  
  57. 　　Caption = 'Message box' 
  58. 　　TabOrder = 1  
  59. 　　OnClick = Button1Click  
  60. 　end  
  61. 　　end 

　　2. 在29行里设置一个断点, 再在Edit里输入一些内容,按下Message Box按钮, 按F7跟踪到Dialogs单元, 经过一段时间的仔细跟踪, 你会发现程序运行到下面一段代码:

  1. 　　function MessageDlgPosHelp(const Msg: string; DlgType: TMsgDlgType;  
  2. 　　Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;  
  3. 　　const HelpFileName: string): Integer;  
  4. 　　begin  
  5. 　　if (Win32MajorVersion >= 6) and UseLatestCommonDialogs and ThemeServices.ThemesEnabled then  
  6. 　　Result := DoTaskMessageDlgPosHelp('', Msg, DlgType, Buttons,  
  7. 　　HelpCtx, X, Y, HelpFileName)  
  8. 　　else 
  9. 　　Result := DoMessageDlgPosHelp(CreateMessageDialog(Msg, DlgType, Buttons),  
  10. 　　HelpCtx, X, Y, HelpFileName);  
  11. 　　end; 

　　函数MessageDlgPosHelp指出, 如果当前系统是Vista,sever2008或以上版本的系统,那就调用DoTaskMessageDlgPosHelp函数进行对话框显示, 否则调用DoMessageDlgPosHelp显示对话框. 继续跟踪DoTaskMessageDlgPosHelp函数, 你会发现如下一段代码:

  1. 　　function TCustomTaskDialog.DoExecute(ParentWnd: HWND): Boolean;  
  2. 　　const  
  3. 　　CTaskDlgFlags: array[TTaskDialogFlag] of Cardinal = (  
  4. 　　TDF_Enable_Hyperlinks, TDF_Use_Hicon_Main,  
  5. 　　tdf_Use_Hicon_Footer, TDF_ALLOW_DIALOG_CANCELLATION,  
  6. 　　TDF_USE_COMMAND_LINKS, TDF_USE_COMMAND_LINKS_NO_ICON,  
  7. 　　TDF_EXPAND_FOOTER_AREA, TDF_EXPANDED_BY_DEFAULT,  
  8. 　　TDF_VERIFICATION_FLAG_CHECKED, TDF_SHOW_PROGRESS_BAR,  
  9. 　　TDF_SHOW_MARQUEE_PROGRESS_BAR, TDF_CALLBACK_TIMER,  
  10. 　　TDF_POSITION_RELATIVE_TO_WINDOW, TDF_RTL_LAYOUT,  
  11. 　　TDF_NO_DEFAULT_RADIO_BUTTON, TDF_CAN_BE_MINIMIZED);  
  12. 　　CTaskDlgCommonButtons: array[TTaskDialogCommonButton] of Cardinal = (  
  13. 　　TDCBF_OK_BUTTON, TDCBF_YES_BUTTON, TDCBF_NO_BUTTON,  
  14. 　　TDCBF_CANCEL_BUTTON, TDCBF_RETRY_BUTTON, TDCBF_CLOSE_BUTTON);  
  15. 　　CTaskDlgDefaultButtons: array[TTaskDialogCommonButton] of Integer = (  
  16. 　　IDOK, IDYES, IDNO, IDCANCEL, IDRETRY, IDCLOSE);  
  17. 　　var  
  18. 　　LWindowList: TTaskWindowList;  
  19. 　　LModalResult: Integer;  
  20. 　　LRadioButton: Integer;  
  21. 　　LFlag: TTaskDialogFlag;  
  22. 　　LFocusState: TFocusState;  
  23. 　　LVerificationChecked: LongBool;  
  24. 　　LTaskDialog: TTaskDialogConfig;  
  25. 　　LCommonButton: TTaskDialogCommonButton;  
  26. 　　begin  
  27. 　　if Win32MajorVersion <6 then  
  28. 　　raise EPlatformVersionException.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SWindowsVistaRequired, [ClassName]);  
  29. 　　if not ThemeServices.ThemesEnabled then  
  30. 　　raise Exception.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SXPThemesRequired, [ClassName]);  
  31. 　　{$IF NOT DEFINED(CLR)}  
  32. 　　FillChar(LTaskDialog, SizeOf(LTaskDialog), 0);  
  33. 　　{$IFEND}  
  34. 　　with LTaskDialog do  
  35. 　　begin  
  36. 　　// Set Size, Parent window, Flags  
  37. 　cbSize := SizeOf(LTaskDialog);  
  38. 　hwndParent := ParentWnd;  
  39. 　　dwFlags := 0;  
  40. 　　for LFlag := Low(TTaskDialogFlag) to High(TTaskDialogFlag) do  
  41. 　　if LFlag in FFlags then  
  42. 　　dwFlags := dwFlags or CTaskDlgFlags[LFlag];  
  43. 　// Set CommonButtons  
  44. 　　dwCommonButtons := 0;  
  45. 　　for LCommonButton := Low(TTaskDialogCommonButton) to High(TTaskDialogCommonButton) do  
  46. 　　if LCommonButton in FCommonButtons then  
  47. 　　dwCommonButtons := dwCommonButtons or CTaskDlgCommonButtons[LCommonButton];  
  48. 　　// Set Content, MainInstruction, Title, MainIcon, DefaultButton  
  49. 　　if FText <>'' then  
  50. 　　pszContent := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FText));  
  51. 　　if FTitle <>'' then  
  52. 　　pszMainInstruction := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FTitle));  
  53. 　　if FCaption <>'' then  
  54. 　　pszWindowTitle := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FCaption));  
  55. 　　if tfUseHiconMain in FFlags then  
  56. 　　hMainIcon := FCustomMainIcon.Handle  
  57. 　　else  
  58. 　　begin  
  59. 　　if FMainIcon in [tdiNone..tdiShield] then  
  60. 　　pszMainIcon := LPCWSTR(CTaskDlgIcons[FMainIcon])  
  61. 　　else  
  62. 　　pszMainIcon := LPCWSTR(MakeIntResourceW(Word(FMainIcon)));  
  63. 　　end;  
  64. 　　nDefaultButton := CTaskDlgDefaultButtons[FDefaultButton];  
  65. 　　// Set Footer, FooterIcon  
  66. 　　if FFooterText <>'' then  
  67. 　　pszFooter := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FFooterText));  
  68. 　　if tfUseHiconFooter in FFlags then  
  69. 　　hFooterIcon := FCustomFooterIcon.Handle  
  70. 　　else  
  71. 　　begin  
  72. 　　if FFooterIcon in [tdiNone..tdiShield] then  
  73. 　　pszFooterIcon := LPCWSTR(CTaskDlgIcons[FFooterIcon])  
  74. 　　else  
  75. 　　pszFooterIcon := LPCWSTR(MakeIntResourceW(Word(FFooterIcon)));  
  76. 　　end;  
  77. 　　// Set VerificationText, ExpandedInformation, CollapsedControlText  
  78. 　　if FVerificationText <>'' then  
  79. 　　pszVerificationText := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FVerificationText));  
  80. 　　if FExpandedText <>'' then  
  81. 　　pszExpandedInformation := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandedText));  
  82. 　　if FExpandButtonCaption <>'' then  
  83. 　　pszCollapsedControlText := {$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandButtonCaption));  
  84. 　　// Set Buttons  
  85. 　　cButtons := FButtons.Count;  
  86. 　　if cButtons >0 then  
  87. 　　pButtons := FButtons.Buttons;  
  88. 　　if FButtons.DefaultButton <>nil then  
  89. 　　nDefaultButton := FButtons.DefaultButton.ModalResult;  
  90. 　　// Set RadioButtons  
  91. 　　cRadioButtons := FRadioButtons.Count;  
  92. 　　if cRadioButtons >0 then  
  93. 　　pRadioButtons := FRadioButtons.Buttons;  
  94. 　　if not (tfNoDefaultRadioButton in FFlags) and (FRadioButtons.DefaultButton <>nil) then  
  95. 　　nDefaultRadioButton := FRadioButtons.DefaultButton.ModalResult;  
  96. 　　// Prepare callback  
  97. 　　{$IF DEFINED(CLR)}  
  98. 　　pfCallBack := @CallbackProc;  
  99. 　　{$ELSE}  
  100. 　　lpCallbackData := LONG_PTR(Self);  
  101. 　　pfCallback := @TaskDialogCallbackProc;  
  102. 　　{$IFEND}  
  103. 　　end;  
  104. 　　LWindowList := DisableTaskWindows(ParentWnd);  
  105. 　　LFocusState := SaveFocusState;  
  106. 　　try  
  107. 　　Result := TaskDialogIndirect(LTaskDialog, {$IFNDEF CLR}@{$ENDIF}LModalResult,  
  108. 　　{$IFNDEF CLR}@{$ENDIF}LRadioButton, {$IFNDEF CLR}@{$ENDIF}LVerificationChecked) = S_OK;  
  109. 　　FModalResult := LModalResult;  
  110. 　　if Result then  
  111. 　　begin  
  112. 　　FButton := TTaskDialogButtonItem(FButtons.FindButton(FModalResult));  
  113. 　　FRadioButton := TTaskDialogRadioButtonItem(FRadioButtons.FindButton(LRadioButton));  
  114. 　　if LVerificationChecked then  
  115. 　　Include(FFlags, tfVerificationFlagChecked)  
  116. 　　else  
  117. 　　Exclude(FFlags, tfVerificationFlagChecked);  
  118. 　　end;  
  119. 　　finally  
  120. 　　EnableTaskWindows(LWindowList);  
  121. 　　SetActiveWindow(ParentWnd);  
  122. 　　RestoreFocusState(LFocusState);  
  123. 　　end;  
  124. 　　end; 

　　上面这段代码在Dialogs单元的第5407行, 该函数先进行可用性判断, 然后填充

　　LTaskDialog: TTaskDialogConfig;

　　一个TTaskDialogConfig的结构体, 该结构体定义在CommCtrl单元第9550行, 其定义如下:

  1. 　　type  
  2. 　　{ $EXTERNALSYM TASKDIALOGCONFIG}  
  3. 　　TASKDIALOGCONFIG = packed record  
  4. 　　cbSize: UINT;  
  5. 　　hwndParent: HWND;  
  6. 　　hInstance: HINST; // used for MAKEINTRESOURCE() strings  
  7. 　　dwFlags: DWORD; // TASKDIALOG_FLAGS (TDF_XXX) flags  
  8. 　　dwCommonButtons: DWORD; // TASKDIALOG_COMMON_BUTTON (TDCBF_XXX) flags  
  9. 　　pszWindowTitle: LPCWSTR; // string or MAKEINTRESOURCE()  
  10. 　　case Integer of  
  11. 　　0: (hMainIcon: HICON);  
  12. 　　1: (pszMainIcon: LPCWSTR;  
  13. 　　pszMainInstruction: LPCWSTR;  
  14. 　　pszContent: LPCWSTR;  
  15. 　　cButtons: UINT;  
  16. 　　pButtons: PTaskDialogButton;  
  17. 　　nDefaultButton: Integer;  
  18. 　　cRadioButtons: UINT;  
  19. 　　pRadioButtons: PTaskDialogButton;  
  20. 　　nDefaultRadioButton: Integer;  
  21. 　　pszVerificationText: LPCWSTR;  
  22. 　　pszExpandedInformation: LPCWSTR;  
  23. 　　pszExpandedControlText: LPCWSTR;  
  24. 　　pszCollapsedControlText: LPCWSTR;  
  25. 　　case Integer of  
  26. 　　0: (hFooterIcon: HICON);  
  27. 　　1: (pszFooterIcon: LPCWSTR;  
  28. 　　pszFooter: LPCWSTR;  
  29. 　　pfCallback: TFTaskDialogCallback;  
  30. 　　lpCallbackData: LONG_PTR;  
  31. 　　cxWidth: UINT // width of the Task Dialog's client area in DLU's.  
  32. 　　// If 0, Task Dialog will calculate the ideal width.  
  33. 　　);  
  34. 　　);  
  35. 　　end;  
  36. 　　{$EXTERNALSYM _TASKDIALOGCONFIG}  
  37. 　　_TASKDIALOGCONFIG = TASKDIALOGCONFIG;  
  38. 　　PTaskDialogConfig = ^TTaskDialogConfig;  
  39. 　　TTaskDialogConfig = TASKDIALOGCONFIG; 

　　该结构体其实是从MSDN里翻译过来的, 定义在CommCtrl.h 头文件里(需要Windows Vista, Windows Server 2008及以上版本, 我是用Windows 7 64位进行的测试), 详细说明可以查看MSDN.

　　TCustomTaskDialog.DoExecute 填充完LTaskDialog结构体后, 直接调用:

  1. 　　Result := TaskDialogIndirect(LTaskDialog, {$IFNDEF CLR}@{$ENDIF}LModalResult,  
  2. 　　{$IFNDEF CLR}@{$ENDIF}LRadioButton, {$IFNDEF CLR}@{$ENDIF}LVerificationChecked) = S_OK; 

　　TaskDialogIndirect显示对话框, TaskDialogIndirect定义在CommCtrl单元, 其代码如下:

  1. 　　{ Task Dialog }  
  2. 　　var  
  3. 　　_TaskDialogIndirect: function(const pTaskConfig: TTaskDialogConfig;  
  4. 　　pnButton: PInteger; pnRadioButton: PInteger;  
  5. 　　pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;  
  6. 　　_TaskDialog: function(hwndParent: HWND; hInstance: HINST;  
  7. 　　pszWindowTitle: LPCWSTR; pszMainInstruction: LPCWSTR; pszContent: LPCWSTR;  
  8. 　　dwCommonButtons: DWORD; pszIcon: LPCWSTR; pnButton: PInteger): HRESULT; stdcall;  
  9. 　　function TaskDialogIndirect(const pTaskConfig: TTaskDialogConfig;  
  10. 　　pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT;  
  11. 　begin  
  12. 　　if Assigned(_TaskDialogIndirect) then  
  13. 　Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton,  
  14. 　　pfVerificationFlagChecked)  
  15. 　　else  
  16. 　　begin  
  17. 　　InitComCtl;  
  18. 　　Result := E_NOTIMPL;  
  19. 　　if ComCtl32DLL <>0 then  
  20. 　　begin  
  21. 　　@_TaskDialogIndirect := GetProcAddress(ComCtl32DLL, 'TaskDialogIndirect');  
  22. 　　if Assigned(_TaskDialogIndirect) then  
  23. 　　Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton,  
  24. 　　pfVerificationFlagChecked)  
  25. 　　end;  
  26. 　　end;  
  27. 　　end; 

　　查看代码知道, TaskDialogIndirect 直接调用ComCtrl32.Dll里的函数: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.

　　函数TaskDialogIndirect 用于创建, 显示, 运行一个任务对话框, 这个任务对话框可以包括由应用程序定义的图标,消息,标题,复选框,按钮,单选框. 该函数还可以接收一个回调函数用于接收通知信息

　　看到这里你或许会问:

　　如果我的系统是xp或其他低于Vista, server2008的系统呢? 由上文中可知, 如果是低版本的系统, 则调用DoMessageDlgPosHelp 函数进行对话框显示, 调用代码如下:

  1. 　　Result := DoMessageDlgPosHelp(CreateMessageDialog(Msg, DlgType, Buttons),  
  2. 　　HelpCtx, X, Y, HelpFileName);  
  3. 　　DoMessageDlgPosHelp代码:  
  4. 　　function DoMessageDlgPosHelp(MessageDialog: TForm; HelpCtx: Longint; X, Y: Integer;  
  5. 　　const HelpFileName: string): Integer;  
  6. 　　begin  
  7. 　　with MessageDialog do  
  8. 　　try  
  9. 　　HelpContext := HelpCtx;  
  10. 　　HelpFile := HelpFileName;  
  11. 　　if X >= 0 then Left := X;  
  12. 　　if Y >= 0 then Top := Y;  
  13. 　　if (Y <0) and (X <0) then Position := poScreenCenter;  
  14. 　　Result := ShowModal;  
  15. 　　finally  
  16. 　　Free;  
  17. 　　end;  
  18. 　　end; 

　　从DoMessageDlgPosHelp代码中可见, 该函数只是简单的将传递进来的TForm以模式窗口的形式显示在指定的位置.

　　下面是CreateMessageDialog代码:

  1. 　　function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;  
  2. 　　Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TForm;  
  3. 　　const  
  4. 　　mcHorzMargin = 8;  
  5. 　　mcVertMargin = 8;  
  6. 　mcHorzSpacing = 10;  
  7. 　　mcVertSpacing = 10;  
  8. 　　mcButtonWidth = 50;  
  9. 　　mcButtonHeight = 14;  
  10. 　　mcButtonSpacing = 4;  
  11. 　　var  
  12. 　　DialogUnits: TPoint;  
  13. 　　HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,  
  14. 　　ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,  
  15. 　　IconTextWidth, IconTextHeight, X, ALeft: Integer;  
  16. 　　B, CancelButton: TMsgDlgBtn;  
  17. 　　{$IF DEFINED(CLR)}  
  18. 　　IconID: Integer;  
  19. 　　{$ELSE}  
  20. 　　IconID: PChar;  
  21. 　　{$IFEND}  
  22. 　　TextRect: TRect;  
  23. 　　LButton: TButton;  
  24. 　　begin  
  25. 　　Result := TMessageForm.CreateNew(Application);  
  26. 　　with Result do  
  27. 　　begin  
  28. 　　BiDiMode := Application.BiDiMode;  
  29. 　　BorderStyle := bsDialog;  
  30. 　　Canvas.Font := Font;  
  31. 　　KeyPreview := True;  
  32. 　　PopupMode := pmAuto;  
  33. 　　Position := poDesigned;  
  34. 　　OnKeyDown := TMessageForm(Result).CustomKeyDown;  
  35. 　　DialogUnits := GetAveCharSize(Canvas);  
  36. 　　HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);  
  37. 　　VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);  
  38. 　　HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);  
  39. 　　VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);  
  40. 　　ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);  
  41. 　　for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do  
  42. 　　begin  
  43. 　　if B in Buttons then  
  44. 　　begin  
  45. 　　if ButtonWidths[B] = 0 then  
  46. 　　begin  
  47. 　　TextRect := Rect(0,0,0,0);  
  48. 　　Windows.DrawText( canvas.handle,  
  49. 　　{$IF DEFINED(CLR)}  
  50. 　ButtonCaptions[B], -1,  
  51. 　　{$ELSE}  
  52. 　　PChar(LoadResString(ButtonCaptions[B])), -1,  
  53. 　　{$IFEND}  
  54. 　　TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or  
  55. 　　DrawTextBiDiModeFlagsReadingOnly);  
  56. 　　with TextRect do ButtonWidths[B] := Right - Left + 8;  
  57. 　　end;  
  58. 　　if ButtonWidths[B] >ButtonWidth then  
  59. 　　ButtonWidth := ButtonWidths[B];  
  60. 　　end;  
  61. 　end;  
  62. 　　ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);  
  63. 　　ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);  
  64. 　　SetRect(TextRect, 0, 0, Screen.Width div 2, 0);  
  65. 　　DrawText(Canvas.Handle, Msg, Length(Msg)+1, TextRect,  
  66. 　　DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or  
  67. 　　DrawTextBiDiModeFlagsReadingOnly);  
  68. 　　IconID := IconIDs[DlgType];  
  69. 　　IconTextWidth := TextRect.Right;  
  70. 　　IconTextHeight := TextRect.Bottom;  
  71. 　　{$IF DEFINED(CLR)}  
  72. 　if DlgType <>mtCustom then  
  73. 　　{$ELSE}  
  74. 　　if IconID <>nil then  
  75. 　　{$IFEND}  
  76. 　　begin  
  77. 　　Inc(IconTextWidth, 32 + HorzSpacing);  
  78. 　　if IconTextHeight <32 then IconTextHeight := 32;  
  79. 　　end;  
  80. 　　ButtonCount := 0;  
  81. 　　for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do  
  82. 　　if B in Buttons then Inc(ButtonCount);  
  83. 　　ButtonGroupWidth := 0;  
  84. 　　if ButtonCount <>0 then  
  85. 　　ButtonGroupWidth := ButtonWidth * ButtonCount +  
  86. 　　ButtonSpacing * (ButtonCount - 1);  
  87. 　　ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;  
  88. 　　ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +  
  89. 　　VertMargin * 2;  
  90. 　　Left := (Screen.Width div 2) - (Width div 2);  
  91. 　　Top := (Screen.Height div 2) - (Height div 2);  
  92. 　　if DlgType <>mtCustom then  
  93. 　　{$IF DEFINED(CLR)}  
  94. 　　Caption := Captions[DlgType] else  
  95. 　　Caption := Application.Title;  
  96. 　if DlgType <>mtCustom then  
  97. 　　{$ELSE}  
  98. 　　Caption := LoadResString(Captions[DlgType]) else  
  99. 　　Caption := Application.Title;  
  100. 　if IconID <>nil then  
  101. 　　{$IFEND}  
  102. 　　with TImage.Create(Result) do  
  103. 　　begin  
  104. 　　Name := 'Image';  
  105. 　　Parent := Result;  
  106. 　　Picture.Icon.Handle := LoadIcon(0, IconID);  
  107. 　　SetBounds(HorzMargin, VertMargin, 32, 32);  
  108. 　end;  
  109. 　　TMessageForm(Result).Message := TLabel.Create(Result);  
  110. 　　with TMessageForm(Result).Message do  
  111. 　　begin  
  112. 　　Name := 'Message';  
  113. 　　Parent := Result;  
  114. 　　WordWrap := True;  
  115. 　　Caption := Msg;  
  116. 　　BoundsRect := TextRect;  
  117. 　　BiDiMode := Result.BiDiMode;  
  118. 　　ALeft := IconTextWidth - TextRect.Right + HorzMargin;  
  119. 　　if UseRightToLeftAlignment then  
  120. 　　ALeft := Result.ClientWidth - ALeft - Width;  
  121. 　　SetBounds(ALeft, VertMargin,  
  122. 　TextRect.Right, TextRect.Bottom);  
  123. 　　end;  
  124. 　　if mbCancel in Buttons then CancelButton := mbCancel else  
  125. 　　if mbNo in Buttons then CancelButton := mbNo else  
  126. 　　CancelButton := mbOk;  
  127. 　　X := (ClientWidth - ButtonGroupWidth) div 2;  
  128. 　　for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do  
  129. 　　if B in Buttons then  
  130. 　　begin  
  131. 　　LButton := TButton.Create(Result);  
  132. 　　with LButton do  
  133. 　　begin  
  134. 　　Name := ButtonNames[B];  
  135. 　　Parent := Result;  
  136. 　　{$IF DEFINED(CLR)}  
  137. 　　Caption := ButtonCaptions[B];  
  138. 　　{$ELSE}  
  139. 　　Caption := LoadResString(ButtonCaptions[B]);  
  140. 　　{$IFEND}  
  141. 　　ModalResult := ModalResults[B];  
  142. 　　if B = DefaultButton then  
  143. 　　begin  
  144. 　　Default := True;  
  145. 　　ActiveControl := LButton;  
  146. 　　end;  
  147. 　if B = CancelButton then  
  148. 　　Cancel := True;  
  149. 　　SetBounds(X, IconTextHeight + VertMargin + VertSpacing,  
  150. 　　ButtonWidth, ButtonHeight);  
  151. 　　Inc(X, ButtonWidth + ButtonSpacing);  
  152. 　　if B = mbHelp then  
  153. 　　OnClick := TMessageForm(Result).HelpButtonClick;  
  154. 　　end;  
  155. 　　end;  
  156. 　　end;  
  157. 　　end; 

　　由代码可见, CreateMessageDialog只是创建了一个TMessageForm, 然后动态地添加了一些设置. 写到这里或许可以解答一些人的问题: 对话框是不是一个窗口? 答案是:是.

　　你还可能会问: 为什么对话框可以停留在那一行代码直到用户操作完毕后再往下执行, 这里就需要了解一下模态窗口的知识。

原文链接：http://www.cnblogs.com/neugls/archive/2011/09/14/2176733.html

【编辑推荐】

  1. Delphi与C#之父：技术理想架构开发传奇
  2. Delphi 2010初体验：彻底告别内存泄露
  3. 开发热点周报：Delphi 2010出炉 mixin进驻JavaFX
  4. Delphi XE2将出 一场技术革命即将打响
  5. 9月TIOBE编程语言排行榜发布 Delphi东山再起

 

责任编辑：彭凡 来源： 博客园
Delphi XE2
相关推荐
Delphi XE2:这就是我们所期待的Delphi吗？
就在我几乎要失去等待的耐心之时，Embarcadero发布了一个新的Delphi版本，而且从表面上看它的诸多功能都超出了我的预想。下面是它的一些亮点：

2011-10-31 14:29:14

Delphi XE2将出 一场技术革命即将打响
DelphiXE2支持64位开发，移动平台开发，web开发等等。今天参加了DelphiXE2的产品发布会，趁热打铁，整理下笔记，看看XE2中到底有什么新东西。

2011-09-05 14:16:44

Delphi XE2
详解 Qt 模态对话框和非模态对话框
如果从线程角度来讲，模态对话框实际上是线程阻塞的，也就是子对话框是一个线程，但是在创建这个子线程之后，父窗口就阻塞了；模态对话框则不是阻塞型的线程模型，父子线程可以并行运行。

2011-07-01 11:33:00

Qt 模态 非模态
WPF对话框相关实现方法介绍
WPF对话框中的非模式对话框可以通过一段VC++代码来实现。在本文中将会给出具体的代码示例，希望大家可以理解。

2009-12-28 13:47:35

WPF对话框
Android实战系统对话框实现登陆注册功能
在android的应用中越来越多的包含了网络互动功能,这就带来了注册,登陆账号功能.本文完整的介绍对话框的方式实现用户登陆功能.

2011-05-31 10:26:37

Android 对话框
Android系统搜索对话框设计妙招
本文介绍一个Android开发平台Android系统搜索对话框设计的妙招和使用方法，从设计位置到应用程序生成一系列的介绍。

2010-08-05 10:42:41

Android开发Android高级编程
Android对话框相关操作技巧讲解
Android对话框可以通过Android操作系统中提供的快捷方式来创建。在这里给出了详细的操作方法，供大家参考与学习。

2010-01-28 16:55:26

Android对话框
jQuery Mobile组件：页面和对话框
jQueryMobile包含自动通过AJAX装载带有返回按钮的外部页面,以及一组页面切换动画效果和用来把页面显示为对话框的简单工具.

2011-07-21 15:50:42

jQuery Mobi页面对话框
详细解读PHP弹出对话框技巧
我们在实现PHP弹出对话框之后，一般还需要返回原来页面或者用新的页面替换原来的页面等。本文将会讲解详细代码编写。

2009-12-11 15:35:50

PHP弹出对话框
WPF窗体对话框具体概念详解
WPF窗体对话框的应用对于初学者来说还是比较难以掌握的一个知识点。本篇文章中将会以一段代码示例来为大家详细介绍相关概念。

2009-12-28 14:32:31

WPF窗体对话框
细谈VB.NET路径选择对话框实现(API)实例
文章主要介绍了VB.NET路径的选择对话框（API）的实例和介绍，让大家深入的了解VB.NET路径，希望在文章中能够给大家带来你想要的东西。

2009-10-20 14:05:42

VB.NET路径
盘点VB.NET对话框制作技巧
在这里为大家介绍的VB.NET关于对话框的实现，就可以帮助大家轻松的了解这一语言的相关应用技巧，方便大家解读，一起来看。

2011-05-20 16:49:21

VB.NET
VB.NET对话框调用思想框架
如果大家想正确的实现VB.NET对话框调用，那么就可以通过一个OpenFileDialog类的定义来实现。具体的操作方法将会在文中详细给出。

2010-01-11 09:33:32

VB.NET对话框调用
深入探讨WPF对话框使用技巧
WPF对话框的实现技巧不是说通过一片文章的解读就能完全了解掌握的。我们还需要通过不断的实践去巩固我们所学到的书面知识。

2009-12-29 15:24:48

WPF对话框
Winform开发框架之同化对话框样式
本文将谈到Winform开发框架中的同化对话框样式，三个不同的对话框封装类，专门为不同的Winform界面样式服务，接口一样，返回的对话框结果一样。

2011-11-23 09:47:36

Winform
iPhone教程 对话框与输入框按钮响应界面
本文介绍的是iPhone教程对话框与输入框按钮响应界面，主要是界面的操作，我们先来看内容。

2011-07-22 15:32:53

iPhone 按钮 对话框
J2ME对话框选择功能实现原理
本文利用J2ME实现了一个阻塞当前线程的对话框，简要地说，你可以运用诸如win32API中dialog函数那样的方式来实现对话框并阻塞等待返回值，然后根据返回值执行不同的处理。

2010-09-29 15:56:02

J2ME对话框
Web开发中的弹出对话框控件介绍
Web开发中，目前由于Jquery的大行其道，因此很多弹出对话框，都用到了Jquery技术，反而原始的弹出对话框的方式较为少用了。

2012-12-03 10:47:54

WebJQuery控件
剖析Android中 一个简单对话框
对于windows来说，对话框是一种次要窗口，包含按钮和各种选项，通过它们可以完成特定命令或任务。查找和替换对话框对话框与窗口有区别，它没有最大化按钮、没有最小化按钮、大都不能改变形状大小。本文讲述的是关于android。

2011-06-02 10:37:02

Android 对话框
VB.NET关于对话框制作技巧分享
VB.NET关于对话框的实现，可以在程序运行中显示程序版本信息等等。那么如何才能正确的实现这一功能呢？在这里就做了相应的解读。

2010-01-22 16:27:19

VB.NET关于对话框
点赞
收藏

51CTO技术栈公众号

业务
速览
在线客服