DelphiXE2对话框实现源码分析

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

10年的张掖网站建设经验，针对设计、前端、开发、售后、文案、推广等六对一服务，响应快，48小时及时工作处理。成都营销网站建设的优势是能够根据用户设备显示端的尺寸不同，自动调整张掖建站的显示方式，使网站能够适用不同显示终端，在浏览器中调整网站的宽度，无论在任何一种浏览器上浏览网站，都能展现优雅布局与设计，从而大程度地提升浏览体验。成都创新互联公司从事“张掖网站设计”,“张掖网站推广”以来，每个客户项目都认真落实执行。

　　跟踪代码

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

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

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

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

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

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

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

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

　　LTaskDialog: TTaskDialogConfig;

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

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

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

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

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

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

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

　　查看代码知道, TaskDialogIndirect 直接调用ComCtrl32.Dll里的函数:TaskDialogIndirect 显示对话框. 通过查询MSDN了解TaskDialogIndirect API的用途与用法:

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

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

　　下面是CreateMessageDialog代码:

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

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

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

文章题目：DelphiXE2对话框实现源码分析
文章出自：http://www.shufengxianlan.com/qtweb/news21/302021.html

网站建设、网络推广公司-创新互联，是专注品牌与效果的网站制作，网络营销seo公司；服务项目有等

广告

声明：本网站发布的内容（图片、视频和文字）以用户投稿、用户转载内容为主，如果涉及侵权请尽快告知，我们将会在第一时间删除。文章观点不代表本网站立场，如需处理请联系客服。电话：028-86922220；邮箱：631063699@qq.com。内容未经允许不得转载，或转载时需注明来源： 创新互联

猜你还喜欢下面的内容

解决方案知识

同城分类信息

乐山托管服务器　　 　营销网站定位　　 　兴宏源活动板房　　 　泸县网站建设　　 　网站建设公司　　 　成都门窗定制　　 　成都响应式网站建设　　 　西部信息中心　　 　珉田数据中心　　 　德阳服务器托管　　 　微信小程序开发　　 　成都口碑营销公司　　 　重庆移动机房托管　　 　画册设计制作　　 　重庆服务器托管　　 　香港空间腾讯云　　 　自适应网页设计　　 　做网站设计　　 　成都光华机房　　 　鳄鱼养殖