偷偷摘套内射激情视频,久久精品99国产国产精,中文字幕无线乱码人妻,中文在线中文a,性爽19p

Delphi XE2對話框?qū)崿F(xiàn)源碼分析

作者：潺緣
開發(fā) 開發(fā)工具
本文將給大家分析Delphi XE2對話框的實(shí)現(xiàn)源碼，分析ShowMessage，MessageBox等對話框運(yùn)行原理，希望能幫助你理解Delphi。

　　在這篇文章中，我將大概的從Delphi XE2 的Dialogs單元入手，分析ShowMessage，MessageBox等對話框運(yùn)行原理，希望能幫助你理解Delphi，不求你愛上她，只求讓你能快速地解決問題。

　　跟蹤代碼

　　為了了解這些對話框的運(yùn)行原理，我們需要跟蹤進(jìn)源代碼中去，為此，你需要做如下設(shè)置

　　1. 簡單創(chuàng)建一個(gè)使用了ShowMessage的VCL應(yīng)用程序

  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行里設(shè)置一個(gè)斷點(diǎn), 再在Edit里輸入一些內(nèi)容,按下Message Box按鈕, 按F7跟蹤到Dialogs單元, 經(jīng)過一段時(shí)間的仔細(xì)跟蹤, 你會發(fā)現(xiàn)程序運(yùn)行到下面一段代碼:

  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; 

　　函數(shù)MessageDlgPosHelp指出, 如果當(dāng)前系統(tǒng)是Vista,sever2008或以上版本的系統(tǒng),那就調(diào)用DoTaskMessageDlgPosHelp函數(shù)進(jìn)行對話框顯示, 否則調(diào)用DoMessageDlgPosHelp顯示對話框. 繼續(xù)跟蹤DoTaskMessageDlgPosHelp函數(shù), 你會發(fā)現(xiàn)如下一段代碼:

  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行, 該函數(shù)先進(jìn)行可用性判斷, 然后填充

　　LTaskDialog: TTaskDialogConfig;

　　一個(gè)TTaskDialogConfig的結(jié)構(gòu)體, 該結(jié)構(gòu)體定義在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; 

　　該結(jié)構(gòu)體其實(shí)是從MSDN里翻譯過來的, 定義在CommCtrl.h 頭文件里(需要Windows Vista, Windows Server 2008及以上版本, 我是用Windows 7 64位進(jìn)行的測試), 詳細(xì)說明可以查看MSDN.

　　TCustomTaskDialog.DoExecute 填充完LTaskDialog結(jié)構(gòu)體后, 直接調(diào)用:

  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 直接調(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)建, 顯示, 運(yùn)行一個(gè)任務(wù)對話框, 這個(gè)任務(wù)對話框可以包括由應(yīng)用程序定義的圖標(biāo),消息,標(biāo)題,復(fù)選框,按鈕,單選框. 該函數(shù)還可以接收一個(gè)回調(diào)函數(shù)用于接收通知信息

　　看到這里你或許會問:

　　如果我的系統(tǒng)是xp或其他低于Vista, server2008的系統(tǒng)呢? 由上文中可知, 如果是低版本的系統(tǒng), 則調(diào)用DoMessageDlgPosHelp 函數(shù)進(jìn)行對話框顯示, 調(diào)用代碼如下:

  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代碼中可見, 該函數(shù)只是簡單的將傳遞進(jìn)來的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只是創(chuàng)建了一個(gè)TMessageForm, 然后動態(tài)地添加了一些設(shè)置. 寫到這里或許可以解答一些人的問題: 對話框是不是一個(gè)窗口? 答案是:是.

　　你還可能會問: 為什么對話框可以停留在那一行代碼直到用戶操作完畢后再往下執(zhí)行, 這里就需要了解一下模態(tài)窗口的知識。

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

【編輯推薦】

  1. Delphi與C#之父：技術(shù)理想架構(gòu)開發(fā)傳奇
  2. Delphi 2010初體驗(yàn)：徹底告別內(nèi)存泄露
  3. 開發(fā)熱點(diǎn)周報(bào)：Delphi 2010出爐 mixin進(jìn)駐JavaFX
  4. Delphi XE2將出 一場技術(shù)革命即將打響
  5. 9月TIOBE編程語言排行榜發(fā)布 Delphi東山再起

 

責(zé)任編輯：彭凡 來源： 博客園
Delphi XE2
相關(guān)推薦

2011-10-31 14:29:14

2011-09-05 14:16:44

Delphi XE2

2011-07-01 11:33:00

Qt 模態(tài) 非模態(tài)

2009-12-28 13:47:35

WPF對話框

2011-05-31 10:26:37

Android 對話框

2009-12-11 15:35:50

PHP彈出對話框

2009-12-28 14:32:31

WPF窗體對話框

2011-07-21 15:50:42

jQuery Mobi頁面對話框

2010-01-28 16:55:26

Android對話框

2009-10-20 14:05:42

VB.NET路徑

2011-11-23 09:47:36

Winform

2009-12-29 15:24:48

WPF對話框

2010-01-11 09:33:32

VB.NET對話框調(diào)用

2011-05-20 16:49:21

VB.NET

2011-07-22 15:32:53

iPhone 按鈕 對話框

2010-09-29 15:56:02

J2ME對話框

2024-02-17 21:50:30

2025-01-03 11:16:38

2011-06-02 10:37:02

Android 對話框

2010-01-22 16:27:19

VB.NET關(guān)于對話框
點(diǎn)贊
收藏

51CTO技術(shù)棧公眾號