1. 首页
  2. 移动端
  3. Delphi 对话框实现源码分析 Delphi 对话框实现源码分析

Delphi 对话框实现源码分析 Delphi 对话框实现源码分析

•移动端•阅读 2805

简介

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

跟踪代码

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

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

unitUnit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 =class(TForm)

Edit1: TEdit;

Button1: TButton;

procedureButton1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedureTForm1.Button1Click(Sender: TObject);

begin

ShowMessage(Edit1.Text);

MessageBox(Self.Handle,PChar(Edit1.Text),PChar(Application.Title),

MB_ICONINFORMATIONorMB_OK);

MessageDlg(Edit1.Text,mtInformation,[mbOK,mbCancel],0);

end;

end.

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

1

2

3

4

5

6

7

8

9

10

11

functionMessageDlgPosHelp(constMsg:string; DlgType: TMsgDlgType;

Buttons: TMsgDlgButtons; HelpCtx:Longint; X, Y:Integer;

constHelpFileName:string):Integer;

begin

if(Win32MajorVersion >=6)andUseLatestCommonDialogsandThemeServices.ThemesEnabledthen

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函数, 你会发现如下一段代码:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

functionTCustomTaskDialog.DoExecute(ParentWnd: HWND):Boolean;

const

CTaskDlgFlags:array[TTaskDialogFlag]ofCardinal= (

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]ofCardinal= (

TDCBF_OK_BUTTON, TDCBF_YES_BUTTON, TDCBF_NO_BUTTON,

TDCBF_CANCEL_BUTTON, TDCBF_RETRY_BUTTON, TDCBF_CLOSE_BUTTON);

CTaskDlgDefaultButtons:array[TTaskDialogCommonButton]ofInteger= (

IDOK, IDYES, IDNO, IDCANCEL, IDRETRY, IDCLOSE);

var

LWindowList: TTaskWindowList;

LModalResult:Integer;

LRadioButton:Integer;

LFlag: TTaskDialogFlag;

LFocusState: TFocusState;

LVerificationChecked: LongBool;

LTaskDialog: TTaskDialogConfig;

LCommonButton: TTaskDialogCommonButton;

begin

ifWin32MajorVersion <6then

raiseEPlatformVersionException.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SWindowsVistaRequired, [ClassName]);

ifnotThemeServices.ThemesEnabledthen

raiseException.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SXPThemesRequired, [ClassName]);

{$IF NOT DEFINED(CLR)}

FillChar(LTaskDialog, SizeOf(LTaskDialog),0);

{$IFEND}

withLTaskDialogdo

begin

// Set Size, Parent window, Flags

cbSize := SizeOf(LTaskDialog);

hwndParent := ParentWnd;

dwFlags :=0;

forLFlag := Low(TTaskDialogFlag)toHigh(TTaskDialogFlag)do

ifLFlaginFFlagsthen

dwFlags := dwFlagsorCTaskDlgFlags[LFlag];

// Set CommonButtons

dwCommonButtons :=0;

forLCommonButton := Low(TTaskDialogCommonButton)toHigh(TTaskDialogCommonButton)do

ifLCommonButtoninFCommonButtonsthen

dwCommonButtons := dwCommonButtonsorCTaskDlgCommonButtons[LCommonButton];

// Set Content, MainInstruction, Title, MainIcon, DefaultButton

ifFText <>''then

pszContent :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FText));

ifFTitle <>''then

pszMainInstruction :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FTitle));

ifFCaption <>''then

pszWindowTitle :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FCaption));

iftfUseHiconMaininFFlagsthen

hMainIcon := FCustomMainIcon.Handle

else

begin

ifFMainIconin[tdiNone..tdiShield]then

pszMainIcon := LPCWSTR(CTaskDlgIcons[FMainIcon])

else

pszMainIcon := LPCWSTR(MakeIntResourceW(Word(FMainIcon)));

end;

nDefaultButton := CTaskDlgDefaultButtons[FDefaultButton];

// Set Footer, FooterIcon

ifFFooterText <>''then

pszFooter :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FFooterText));

iftfUseHiconFooterinFFlagsthen

hFooterIcon := FCustomFooterIcon.Handle

else

begin

ifFFooterIconin[tdiNone..tdiShield]then

pszFooterIcon := LPCWSTR(CTaskDlgIcons[FFooterIcon])

else

pszFooterIcon := LPCWSTR(MakeIntResourceW(Word(FFooterIcon)));

end;

// Set VerificationText, ExpandedInformation, CollapsedControlText

ifFVerificationText <>''then

pszVerificationText :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FVerificationText));

ifFExpandedText <>''then

pszExpandedInformation :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandedText));

ifFExpandButtonCaption <>''then

pszCollapsedControlText :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandButtonCaption));

// Set Buttons

cButtons := FButtons.Count;

ifcButtons >0then

pButtons := FButtons.Buttons;

ifFButtons.DefaultButton <>nilthen

nDefaultButton := FButtons.DefaultButton.ModalResult;

// Set RadioButtons

cRadioButtons := FRadioButtons.Count;

ifcRadioButtons >0then

pRadioButtons := FRadioButtons.Buttons;

ifnot(tfNoDefaultRadioButtoninFFlags)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;

ifResultthen

begin

FButton := TTaskDialogButtonItem(FButtons.FindButton(FModalResult));

FRadioButton := TTaskDialogRadioButtonItem(FRadioButtons.FindButton(LRadioButton));

ifLVerificationCheckedthen

Include(FFlags, tfVerificationFlagChecked)

else

Exclude(FFlags, tfVerificationFlagChecked);

end;

finally

EnableTaskWindows(LWindowList);

SetActiveWindow(ParentWnd);

RestoreFocusState(LFocusState);

end;

end;

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

1

LTaskDialog: TTaskDialogConfig;

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

type

{ $EXTERNALSYM TASKDIALOGCONFIG}

TASKDIALOGCONFIG =packedrecord

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()

caseIntegerof

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;

caseIntegerof

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结构体后, 直接调用:

1

2

Result := TaskDialogIndirect(LTaskDialog,{$IFNDEF CLR}@{$ENDIF}LModalResult,

{$IFNDEF CLR}@{$ENDIF}LRadioButton, {$IFNDEF CLR}@{$ENDIF}LVerificationChecked) = S_OK;

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

{ Task Dialog }

var

_TaskDialogIndirect:function(constpTaskConfig: 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;

functionTaskDialogIndirect(constpTaskConfig: TTaskDialogConfig;

pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT;

begin

ifAssigned(_TaskDialogIndirect)then

Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton,

pfVerificationFlagChecked)

else

begin

InitComCtl;

Result := E_NOTIMPL;

ifComCtl32DLL <>0then

begin

@_TaskDialogIndirect := GetProcAddress(ComCtl32DLL,'TaskDialogIndirect');

ifAssigned(_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 函数进行对话框显示, 调用代码如下:

1

2

Result := DoMessageDlgPosHelp(CreateMessageDialog(Msg, DlgType, Buttons),

HelpCtx, X, Y, HelpFileName);

DoMessageDlgPosHelp代码:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

functionDoMessageDlgPosHelp(MessageDialog: TForm; HelpCtx:Longint; X, Y:Integer;

constHelpFileName:string):Integer;

begin

withMessageDialogdo

try

HelpContext := HelpCtx;

HelpFile := HelpFileName;

ifX >=0thenLeft := X;

ifY >=0thenTop := Y;

if(Y <0)and(X <0)thenPosition := poScreenCenter;

Result := ShowModal;

finally

Free;

end;

end;

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

下面是CreateMessageDialog代码:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

functionCreateMessageDialog(constMsg: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);

withResultdo

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);

forB := Low(TMsgDlgBtn)toHigh(TMsgDlgBtn)do

begin

ifBinButtonsthen

begin

ifButtonWidths[B] =0then

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_CALCRECTorDT_LEFTorDT_SINGLELINEor

DrawTextBiDiModeFlagsReadingOnly);

withTextRectdoButtonWidths[B] := Right - Left +8;

end;

ifButtonWidths[B] > ButtonWidththen

ButtonWidth := ButtonWidths[B];

end;

end;

ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y,8);

ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X,4);

SetRect(TextRect,0,0, Screen.Widthdiv2,0);

DrawText(Canvas.Handle, Msg, Length(Msg)+1, TextRect,

DT_EXPANDTABSorDT_CALCRECTorDT_WORDBREAKor

DrawTextBiDiModeFlagsReadingOnly);

IconID := IconIDs[DlgType];

IconTextWidth := TextRect.Right;

IconTextHeight := TextRect.Bottom;

{$IF DEFINED(CLR)}

ifDlgType <> mtCustomthen

{$ELSE}

ifIconID <>nilthen

{$IFEND}

begin

Inc(IconTextWidth,32+ HorzSpacing);

ifIconTextHeight <32thenIconTextHeight :=32;

end;

ButtonCount :=0;

forB := Low(TMsgDlgBtn)toHigh(TMsgDlgBtn)do

ifBinButtonsthenInc(ButtonCount);

ButtonGroupWidth :=0;

ifButtonCount <>0then

ButtonGroupWidth := ButtonWidth * ButtonCount +

ButtonSpacing * (ButtonCount -1);

ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin *2;

ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +

VertMargin *2;

Left := (Screen.Widthdiv2) - (Widthdiv2);

Top := (Screen.Heightdiv2) - (Heightdiv2);

ifDlgType <> mtCustomthen

{$IF DEFINED(CLR)}

Caption := Captions[DlgType]else

Caption := Application.Title;

ifDlgType <> mtCustomthen

{$ELSE}

Caption := LoadResString(Captions[DlgType])else

Caption := Application.Title;

ifIconID <>nilthen

{$IFEND}

withTImage.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);

withTMessageForm(Result).Messagedo

begin

Name :='Message';

Parent := Result;

WordWrap :=True;

Caption := Msg;

BoundsRect := TextRect;

BiDiMode := Result.BiDiMode;

ALeft := IconTextWidth - TextRect.Right + HorzMargin;

ifUseRightToLeftAlignmentthen

ALeft := Result.ClientWidth - ALeft - Width;

SetBounds(ALeft, VertMargin,

TextRect.Right, TextRect.Bottom);

end;

ifmbCancelinButtonsthenCancelButton := mbCancelelse

ifmbNoinButtonsthenCancelButton := mbNoelse

CancelButton := mbOk;

X := (ClientWidth - ButtonGroupWidth)div2;

forB := Low(TMsgDlgBtn)toHigh(TMsgDlgBtn)do

ifBinButtonsthen

begin

LButton := TButton.Create(Result);

withLButtondo

begin

Name := ButtonNames[B];

Parent := Result;

{$IF DEFINED(CLR)}

Caption := ButtonCaptions[B];

{$ELSE}

Caption := LoadResString(ButtonCaptions[B]);

{$IFEND}

ModalResult := ModalResults[B];

ifB = DefaultButtonthen

begin

Default :=True;

ActiveControl := LButton;

end;

ifB = CancelButtonthen

Cancel :=True;

SetBounds(X, IconTextHeight + VertMargin + VertSpacing,

ButtonWidth, ButtonHeight);

Inc(X, ButtonWidth + ButtonSpacing);

ifB = mbHelpthen

OnClick := TMessageForm(Result).HelpButtonClick;

end;

end;

end;

end;

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

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

参考：

http://www.cnblogs.com/neugls/archive/2011/09/14/2176733.html

简介

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

跟踪代码

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

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

unitUnit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 =class(TForm)

Edit1: TEdit;

Button1: TButton;

procedureButton1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedureTForm1.Button1Click(Sender: TObject);

begin

ShowMessage(Edit1.Text);

MessageBox(Self.Handle,PChar(Edit1.Text),PChar(Application.Title),

MB_ICONINFORMATIONorMB_OK);

MessageDlg(Edit1.Text,mtInformation,[mbOK,mbCancel],0);

end;

end.

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

1

2

3

4

5

6

7

8

9

10

11

functionMessageDlgPosHelp(constMsg:string; DlgType: TMsgDlgType;

Buttons: TMsgDlgButtons; HelpCtx:Longint; X, Y:Integer;

constHelpFileName:string):Integer;

begin

if(Win32MajorVersion >=6)andUseLatestCommonDialogsandThemeServices.ThemesEnabledthen

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函数, 你会发现如下一段代码:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

functionTCustomTaskDialog.DoExecute(ParentWnd: HWND):Boolean;

const

CTaskDlgFlags:array[TTaskDialogFlag]ofCardinal= (

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]ofCardinal= (

TDCBF_OK_BUTTON, TDCBF_YES_BUTTON, TDCBF_NO_BUTTON,

TDCBF_CANCEL_BUTTON, TDCBF_RETRY_BUTTON, TDCBF_CLOSE_BUTTON);

CTaskDlgDefaultButtons:array[TTaskDialogCommonButton]ofInteger= (

IDOK, IDYES, IDNO, IDCANCEL, IDRETRY, IDCLOSE);

var

LWindowList: TTaskWindowList;

LModalResult:Integer;

LRadioButton:Integer;

LFlag: TTaskDialogFlag;

LFocusState: TFocusState;

LVerificationChecked: LongBool;

LTaskDialog: TTaskDialogConfig;

LCommonButton: TTaskDialogCommonButton;

begin

ifWin32MajorVersion <6then

raiseEPlatformVersionException.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SWindowsVistaRequired, [ClassName]);

ifnotThemeServices.ThemesEnabledthen

raiseException.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SXPThemesRequired, [ClassName]);

{$IF NOT DEFINED(CLR)}

FillChar(LTaskDialog, SizeOf(LTaskDialog),0);

{$IFEND}

withLTaskDialogdo

begin

// Set Size, Parent window, Flags

cbSize := SizeOf(LTaskDialog);

hwndParent := ParentWnd;

dwFlags :=0;

forLFlag := Low(TTaskDialogFlag)toHigh(TTaskDialogFlag)do

ifLFlaginFFlagsthen

dwFlags := dwFlagsorCTaskDlgFlags[LFlag];

// Set CommonButtons

dwCommonButtons :=0;

forLCommonButton := Low(TTaskDialogCommonButton)toHigh(TTaskDialogCommonButton)do

ifLCommonButtoninFCommonButtonsthen

dwCommonButtons := dwCommonButtonsorCTaskDlgCommonButtons[LCommonButton];

// Set Content, MainInstruction, Title, MainIcon, DefaultButton

ifFText <>''then

pszContent :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FText));

ifFTitle <>''then

pszMainInstruction :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FTitle));

ifFCaption <>''then

pszWindowTitle :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FCaption));

iftfUseHiconMaininFFlagsthen

hMainIcon := FCustomMainIcon.Handle

else

begin

ifFMainIconin[tdiNone..tdiShield]then

pszMainIcon := LPCWSTR(CTaskDlgIcons[FMainIcon])

else

pszMainIcon := LPCWSTR(MakeIntResourceW(Word(FMainIcon)));

end;

nDefaultButton := CTaskDlgDefaultButtons[FDefaultButton];

// Set Footer, FooterIcon

ifFFooterText <>''then

pszFooter :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FFooterText));

iftfUseHiconFooterinFFlagsthen

hFooterIcon := FCustomFooterIcon.Handle

else

begin

ifFFooterIconin[tdiNone..tdiShield]then

pszFooterIcon := LPCWSTR(CTaskDlgIcons[FFooterIcon])

else

pszFooterIcon := LPCWSTR(MakeIntResourceW(Word(FFooterIcon)));

end;

// Set VerificationText, ExpandedInformation, CollapsedControlText

ifFVerificationText <>''then

pszVerificationText :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FVerificationText));

ifFExpandedText <>''then

pszExpandedInformation :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandedText));

ifFExpandButtonCaption <>''then

pszCollapsedControlText :={$IFNDEF CLR}PWideChar{$ENDIF}(WideString(FExpandButtonCaption));

// Set Buttons

cButtons := FButtons.Count;

ifcButtons >0then

pButtons := FButtons.Buttons;

ifFButtons.DefaultButton <>nilthen

nDefaultButton := FButtons.DefaultButton.ModalResult;

// Set RadioButtons

cRadioButtons := FRadioButtons.Count;

ifcRadioButtons >0then

pRadioButtons := FRadioButtons.Buttons;

ifnot(tfNoDefaultRadioButtoninFFlags)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;

ifResultthen

begin

FButton := TTaskDialogButtonItem(FButtons.FindButton(FModalResult));

FRadioButton := TTaskDialogRadioButtonItem(FRadioButtons.FindButton(LRadioButton));

ifLVerificationCheckedthen

Include(FFlags, tfVerificationFlagChecked)

else

Exclude(FFlags, tfVerificationFlagChecked);

end;

finally

EnableTaskWindows(LWindowList);

SetActiveWindow(ParentWnd);

RestoreFocusState(LFocusState);

end;

end;

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

1

LTaskDialog: TTaskDialogConfig;

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

type

{ $EXTERNALSYM TASKDIALOGCONFIG}

TASKDIALOGCONFIG =packedrecord

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()

caseIntegerof

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;

caseIntegerof

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结构体后, 直接调用:

1

2

Result := TaskDialogIndirect(LTaskDialog,{$IFNDEF CLR}@{$ENDIF}LModalResult,

{$IFNDEF CLR}@{$ENDIF}LRadioButton, {$IFNDEF CLR}@{$ENDIF}LVerificationChecked) = S_OK;

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

{ Task Dialog }

var

_TaskDialogIndirect:function(constpTaskConfig: 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;

functionTaskDialogIndirect(constpTaskConfig: TTaskDialogConfig;

pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT;

begin

ifAssigned(_TaskDialogIndirect)then

Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton,

pfVerificationFlagChecked)

else

begin

InitComCtl;

Result := E_NOTIMPL;

ifComCtl32DLL <>0then

begin

@_TaskDialogIndirect := GetProcAddress(ComCtl32DLL,'TaskDialogIndirect');

ifAssigned(_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 函数进行对话框显示, 调用代码如下:

1

2

Result := DoMessageDlgPosHelp(CreateMessageDialog(Msg, DlgType, Buttons),

HelpCtx, X, Y, HelpFileName);

DoMessageDlgPosHelp代码:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

functionDoMessageDlgPosHelp(MessageDialog: TForm; HelpCtx:Longint; X, Y:Integer;

constHelpFileName:string):Integer;

begin

withMessageDialogdo

try

HelpContext := HelpCtx;

HelpFile := HelpFileName;

ifX >=0thenLeft := X;

ifY >=0thenTop := Y;

if(Y <0)and(X <0)thenPosition := poScreenCenter;

Result := ShowModal;

finally

Free;

end;

end;

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

下面是CreateMessageDialog代码:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

functionCreateMessageDialog(constMsg: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);

withResultdo

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);

forB := Low(TMsgDlgBtn)toHigh(TMsgDlgBtn)do

begin

ifBinButtonsthen

begin

ifButtonWidths[B] =0then

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_CALCRECTorDT_LEFTorDT_SINGLELINEor

DrawTextBiDiModeFlagsReadingOnly);

withTextRectdoButtonWidths[B] := Right - Left +8;

end;

ifButtonWidths[B] > ButtonWidththen

ButtonWidth := ButtonWidths[B];

end;

end;

ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y,8);

ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X,4);

SetRect(TextRect,0,0, Screen.Widthdiv2,0);

DrawText(Canvas.Handle, Msg, Length(Msg)+1, TextRect,

DT_EXPANDTABSorDT_CALCRECTorDT_WORDBREAKor

DrawTextBiDiModeFlagsReadingOnly);

IconID := IconIDs[DlgType];

IconTextWidth := TextRect.Right;

IconTextHeight := TextRect.Bottom;

{$IF DEFINED(CLR)}

ifDlgType <> mtCustomthen

{$ELSE}

ifIconID <>nilthen

{$IFEND}

begin

Inc(IconTextWidth,32+ HorzSpacing);

ifIconTextHeight <32thenIconTextHeight :=32;

end;

ButtonCount :=0;

forB := Low(TMsgDlgBtn)toHigh(TMsgDlgBtn)do

ifBinButtonsthenInc(ButtonCount);

ButtonGroupWidth :=0;

ifButtonCount <>0then

ButtonGroupWidth := ButtonWidth * ButtonCount +

ButtonSpacing * (ButtonCount -1);

ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin *2;

ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +

VertMargin *2;

Left := (Screen.Widthdiv2) - (Widthdiv2);

Top := (Screen.Heightdiv2) - (Heightdiv2);

ifDlgType <> mtCustomthen

{$IF DEFINED(CLR)}

Caption := Captions[DlgType]else

Caption := Application.Title;

ifDlgType <> mtCustomthen

{$ELSE}

Caption := LoadResString(Captions[DlgType])else

Caption := Application.Title;

ifIconID <>nilthen

{$IFEND}

withTImage.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);

withTMessageForm(Result).Messagedo

begin

Name :='Message';

Parent := Result;

WordWrap :=True;

Caption := Msg;

BoundsRect := TextRect;

BiDiMode := Result.BiDiMode;

ALeft := IconTextWidth - TextRect.Right + HorzMargin;

ifUseRightToLeftAlignmentthen

ALeft := Result.ClientWidth - ALeft - Width;

SetBounds(ALeft, VertMargin,

TextRect.Right, TextRect.Bottom);

end;

ifmbCancelinButtonsthenCancelButton := mbCancelelse

ifmbNoinButtonsthenCancelButton := mbNoelse

CancelButton := mbOk;

X := (ClientWidth - ButtonGroupWidth)div2;

forB := Low(TMsgDlgBtn)toHigh(TMsgDlgBtn)do

ifBinButtonsthen

begin

LButton := TButton.Create(Result);

withLButtondo

begin

Name := ButtonNames[B];

Parent := Result;

{$IF DEFINED(CLR)}

Caption := ButtonCaptions[B];

{$ELSE}

Caption := LoadResString(ButtonCaptions[B]);

{$IFEND}

ModalResult := ModalResults[B];

ifB = DefaultButtonthen

begin

Default :=True;

ActiveControl := LButton;

end;

ifB = CancelButtonthen

Cancel :=True;

SetBounds(X, IconTextHeight + VertMargin + VertSpacing,

ButtonWidth, ButtonHeight);

Inc(X, ButtonWidth + ButtonSpacing);

ifB = mbHelpthen

OnClick := TMessageForm(Result).HelpButtonClick;

end;

end;

end;

end;

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

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

参考：

http://www.cnblogs.com/neugls/archive/2011/09/14/2176733.html

相关推荐

Copyright © 2008-2024渝ICP备2022006305号-5.

本站所有数据收集于网络如有侵犯到您的权益请联系，进行下架处理。