Delphi 对话框实现源码分析

 

简介

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

跟踪代码

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

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

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Edit1: TEdit;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage(Edit1.Text);

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

    MB_ICONINFORMATION or MB_OK);

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

end;



end.

DFM文件代码：

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 243

  ClientWidth = 472

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch = 96

  TextHeight = 13

  object Edit1: TEdit

    Left = 128

    Top = 72

    Width = 209

    Height = 21

    TabOrder = 0

    TextHint = 'Message here'

  end

  object Button1: TButton

    Left = 192

    Top = 120

    Width = 75

    Height = 25

    Caption = 'Message box'

    TabOrder = 1

    OnClick = Button1Click

  end

end

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

function MessageDlgPosHelp(const Msg: string; DlgType: TMsgDlgType;

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

  const HelpFileName: string): Integer;

begin

  if (Win32MajorVersion >= 6) and UseLatestCommonDialogs and ThemeServices.ThemesEnabled then

    Result := DoTaskMessageDlgPosHelp('', Msg, DlgType, Buttons,

      HelpCtx, X, Y, HelpFileName)

  else

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

      HelpCtx, X, Y, HelpFileName);

end;

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

function TCustomTaskDialog.DoExecute(ParentWnd: HWND): Boolean;

const

  CTaskDlgFlags: array[TTaskDialogFlag] of Cardinal = (

    TDF_Enable_Hyperlinks, TDF_Use_Hicon_Main,

    tdf_Use_Hicon_Footer, TDF_ALLOW_DIALOG_CANCELLATION,

    TDF_USE_COMMAND_LINKS, TDF_USE_COMMAND_LINKS_NO_ICON,

    TDF_EXPAND_FOOTER_AREA, TDF_EXPANDED_BY_DEFAULT,

    TDF_VERIFICATION_FLAG_CHECKED, TDF_SHOW_PROGRESS_BAR,

    TDF_SHOW_MARQUEE_PROGRESS_BAR, TDF_CALLBACK_TIMER,

    TDF_POSITION_RELATIVE_TO_WINDOW, TDF_RTL_LAYOUT,

    TDF_NO_DEFAULT_RADIO_BUTTON, TDF_CAN_BE_MINIMIZED);



  CTaskDlgCommonButtons: array[TTaskDialogCommonButton] of Cardinal = (

    TDCBF_OK_BUTTON, TDCBF_YES_BUTTON, TDCBF_NO_BUTTON,

    TDCBF_CANCEL_BUTTON, TDCBF_RETRY_BUTTON, TDCBF_CLOSE_BUTTON);



  CTaskDlgDefaultButtons: array[TTaskDialogCommonButton] of Integer = (

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



var

  LWindowList: TTaskWindowList;

  LModalResult: Integer;

  LRadioButton: Integer;

  LFlag: TTaskDialogFlag;

  LFocusState: TFocusState;

  LVerificationChecked: LongBool;

  LTaskDialog: TTaskDialogConfig;

  LCommonButton: TTaskDialogCommonButton;

begin

  if Win32MajorVersion < 6 then

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

  if not ThemeServices.ThemesEnabled then

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



{$IF NOT DEFINED(CLR)}

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

{$IFEND}

  with LTaskDialog do

  begin

    // Set Size, Parent window, Flags

    cbSize := SizeOf(LTaskDialog);

    hwndParent := ParentWnd;

    dwFlags := 0;

    for LFlag := Low(TTaskDialogFlag) to High(TTaskDialogFlag) do

      if LFlag in FFlags then

        dwFlags := dwFlags or CTaskDlgFlags[LFlag];



    // Set CommonButtons

    dwCommonButtons := 0;

    for LCommonButton := Low(TTaskDialogCommonButton) to High(TTaskDialogCommonButton) do

      if LCommonButton in FCommonButtons then

        dwCommonButtons := dwCommonButtons or CTaskDlgCommonButtons[LCommonButton];



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

    if FText <> '' then

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

    if FTitle <> '' then

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

    if FCaption <> '' then

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

    if tfUseHiconMain in FFlags then

      hMainIcon := FCustomMainIcon.Handle

    else

    begin

      if FMainIcon in [tdiNone..tdiShield] then

        pszMainIcon := LPCWSTR(CTaskDlgIcons[FMainIcon])

      else

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

    end;

    nDefaultButton := CTaskDlgDefaultButtons[FDefaultButton];



    // Set Footer, FooterIcon

    if FFooterText <> '' then

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

    if tfUseHiconFooter in FFlags then

      hFooterIcon := FCustomFooterIcon.Handle

    else

    begin

      if FFooterIcon in [tdiNone..tdiShield] then

        pszFooterIcon := LPCWSTR(CTaskDlgIcons[FFooterIcon])

      else

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

    end;



    // Set VerificationText, ExpandedInformation, CollapsedControlText

    if FVerificationText <> '' then

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

    if FExpandedText <> '' then

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

    if FExpandButtonCaption <> '' then

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



    // Set Buttons

    cButtons := FButtons.Count;

    if cButtons > 0 then

      pButtons := FButtons.Buttons;

    if FButtons.DefaultButton <> nil then

      nDefaultButton := FButtons.DefaultButton.ModalResult;



    // Set RadioButtons

    cRadioButtons := FRadioButtons.Count;

    if cRadioButtons > 0 then

      pRadioButtons := FRadioButtons.Buttons;

    if not (tfNoDefaultRadioButton in FFlags) and (FRadioButtons.DefaultButton <> nil) then

      nDefaultRadioButton := FRadioButtons.DefaultButton.ModalResult;



    // Prepare callback

{$IF DEFINED(CLR)}

    pfCallBack := @CallbackProc;

{$ELSE}

    lpCallbackData := LONG_PTR(Self);

    pfCallback := @TaskDialogCallbackProc;

{$IFEND}

  end;



  LWindowList := DisableTaskWindows(ParentWnd);

  LFocusState := SaveFocusState;

  try

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

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

    FModalResult := LModalResult;

    if Result then

    begin

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

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

      if LVerificationChecked then

        Include(FFlags, tfVerificationFlagChecked)

      else

        Exclude(FFlags, tfVerificationFlagChecked);

    end;

  finally

    EnableTaskWindows(LWindowList);

    SetActiveWindow(ParentWnd);

    RestoreFocusState(LFocusState);

  end;

end;

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

LTaskDialog: TTaskDialogConfig;

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

type

  { $EXTERNALSYM TASKDIALOGCONFIG}

  TASKDIALOGCONFIG = packed record

    cbSize: UINT;

    hwndParent: HWND;

    hInstance: HINST;                     // used for MAKEINTRESOURCE() strings

    dwFlags: DWORD;                       // TASKDIALOG_FLAGS (TDF_XXX) flags

    dwCommonButtons: DWORD;               // TASKDIALOG_COMMON_BUTTON (TDCBF_XXX) flags

    pszWindowTitle: LPCWSTR;              // string or MAKEINTRESOURCE()

    case Integer of

      0: (hMainIcon: HICON);

      1: (pszMainIcon: LPCWSTR;

          pszMainInstruction: LPCWSTR;

          pszContent: LPCWSTR;

          cButtons: UINT;

          pButtons: PTaskDialogButton;

          nDefaultButton: Integer;

          cRadioButtons: UINT;

          pRadioButtons: PTaskDialogButton;

          nDefaultRadioButton: Integer;

          pszVerificationText: LPCWSTR;

          pszExpandedInformation: LPCWSTR;

          pszExpandedControlText: LPCWSTR;

          pszCollapsedControlText: LPCWSTR;

          case Integer of

            0: (hFooterIcon: HICON);

            1: (pszFooterIcon: LPCWSTR;

                pszFooter: LPCWSTR;

                pfCallback: TFTaskDialogCallback;

                lpCallbackData: LONG_PTR;

                cxWidth: UINT  // width of the Task Dialog's client area in DLU's.

                               // If 0, Task Dialog will calculate the ideal width.

              );

          );

  end;

  {$EXTERNALSYM _TASKDIALOGCONFIG}

  _TASKDIALOGCONFIG = TASKDIALOGCONFIG;

  PTaskDialogConfig = ^TTaskDialogConfig;

  TTaskDialogConfig = TASKDIALOGCONFIG;

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

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

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

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

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

{ Task Dialog }



var

  _TaskDialogIndirect: function(const pTaskConfig: TTaskDialogConfig;

    pnButton: PInteger; pnRadioButton: PInteger;

    pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;



  _TaskDialog: function(hwndParent: HWND; hInstance: HINST;

    pszWindowTitle: LPCWSTR; pszMainInstruction: LPCWSTR; pszContent: LPCWSTR;

    dwCommonButtons: DWORD; pszIcon: LPCWSTR; pnButton: PInteger): HRESULT; stdcall;



function TaskDialogIndirect(const pTaskConfig: TTaskDialogConfig;

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

begin

  if Assigned(_TaskDialogIndirect) then

    Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton,

      pfVerificationFlagChecked)

  else

  begin

    InitComCtl;

    Result := E_NOTIMPL;

    if ComCtl32DLL <> 0 then

    begin

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

      if Assigned(_TaskDialogIndirect) then

        Result := _TaskDialogIndirect(pTaskConfig, pnButton, pnRadioButton,

          pfVerificationFlagChecked)

    end;

  end;

end;

查看代码知道, TaskDialogIndirect 直接调用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 函数进行对话框显示, 调用代码如下:

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

      HelpCtx, X, Y, HelpFileName);

DoMessageDlgPosHelp代码:

function DoMessageDlgPosHelp(MessageDialog: TForm; HelpCtx: Longint; X, Y: Integer;

  const HelpFileName: string): Integer;

begin

  with MessageDialog do

    try

      HelpContext := HelpCtx;

      HelpFile := HelpFileName;

      if X >= 0 then Left := X;

      if Y >= 0 then Top := Y;

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

      Result := ShowModal;

    finally

      Free;

    end;

end;

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

下面是CreateMessageDialog代码:

function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;

  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TForm;

const

  mcHorzMargin = 8;

  mcVertMargin = 8;

  mcHorzSpacing = 10;

  mcVertSpacing = 10;

  mcButtonWidth = 50;

  mcButtonHeight = 14;

  mcButtonSpacing = 4;

var

  DialogUnits: TPoint;

  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,

  ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,

  IconTextWidth, IconTextHeight, X, ALeft: Integer;

  B, CancelButton: TMsgDlgBtn;

{$IF DEFINED(CLR)}

  IconID: Integer;

{$ELSE}

  IconID: PChar;

{$IFEND}

  TextRect: TRect;

  LButton: TButton;

begin

  Result := TMessageForm.CreateNew(Application);

  with Result do

  begin

    BiDiMode := Application.BiDiMode;

    BorderStyle := bsDialog;

    Canvas.Font := Font;

    KeyPreview := True;

    PopupMode := pmAuto;

    Position := poDesigned;

    OnKeyDown := TMessageForm(Result).CustomKeyDown;

    DialogUnits := GetAveCharSize(Canvas);

    HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);

    VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);

    HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);

    VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);

    ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);

    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do

    begin

      if B in Buttons then

      begin

        if ButtonWidths[B] = 0 then

        begin

          TextRect := Rect(0,0,0,0);

          Windows.DrawText( canvas.handle,

{$IF DEFINED(CLR)}

            ButtonCaptions[B], -1,

{$ELSE}

            PChar(LoadResString(ButtonCaptions[B])), -1,

{$IFEND}

            TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or

            DrawTextBiDiModeFlagsReadingOnly);

          with TextRect do ButtonWidths[B] := Right - Left + 8;

        end;

        if ButtonWidths[B] > ButtonWidth then

          ButtonWidth := ButtonWidths[B];

      end;

    end;

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

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

    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);

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

      DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or

      DrawTextBiDiModeFlagsReadingOnly);

    IconID := IconIDs[DlgType];

    IconTextWidth := TextRect.Right;

    IconTextHeight := TextRect.Bottom;

{$IF DEFINED(CLR)}

    if DlgType <> mtCustom then

{$ELSE}

    if IconID <> nil then

{$IFEND}

    begin

      Inc(IconTextWidth, 32 + HorzSpacing);

      if IconTextHeight < 32 then IconTextHeight := 32;

    end;

    ButtonCount := 0;

    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do

      if B in Buttons then Inc(ButtonCount);

    ButtonGroupWidth := 0;

    if ButtonCount <> 0 then

      ButtonGroupWidth := ButtonWidth * ButtonCount +

        ButtonSpacing * (ButtonCount - 1);

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

    ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +

      VertMargin * 2;

    Left := (Screen.Width div 2) - (Width div 2);

    Top := (Screen.Height div 2) - (Height div 2);

    if DlgType <> mtCustom then

{$IF DEFINED(CLR)}

      Caption := Captions[DlgType] else

      Caption := Application.Title;

    if DlgType <> mtCustom then

{$ELSE}

      Caption := LoadResString(Captions[DlgType]) else

      Caption := Application.Title;

    if IconID <> nil then

{$IFEND}

      with TImage.Create(Result) do

      begin

        Name := 'Image';

        Parent := Result;

        Picture.Icon.Handle := LoadIcon(0, IconID);

        SetBounds(HorzMargin, VertMargin, 32, 32);

      end;

    TMessageForm(Result).Message := TLabel.Create(Result);

    with TMessageForm(Result).Message do

    begin

      Name := 'Message';

      Parent := Result;

      WordWrap := True;

      Caption := Msg;

      BoundsRect := TextRect;

      BiDiMode := Result.BiDiMode;

      ALeft := IconTextWidth - TextRect.Right + HorzMargin;

      if UseRightToLeftAlignment then

        ALeft := Result.ClientWidth - ALeft - Width;

      SetBounds(ALeft, VertMargin,

        TextRect.Right, TextRect.Bottom);

    end;

    if mbCancel in Buttons then CancelButton := mbCancel else

      if mbNo in Buttons then CancelButton := mbNo else

        CancelButton := mbOk;

    X := (ClientWidth - ButtonGroupWidth) div 2;

    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do

      if B in Buttons then

      begin

        LButton := TButton.Create(Result);

        with LButton do

        begin

          Name := ButtonNames[B];

          Parent := Result;

{$IF DEFINED(CLR)}

          Caption := ButtonCaptions[B];

{$ELSE}

          Caption := LoadResString(ButtonCaptions[B]);

{$IFEND}

          ModalResult := ModalResults[B];

          if B = DefaultButton then

          begin

            Default := True;

            ActiveControl := LButton;

          end;

          if B = CancelButton then

            Cancel := True;

          SetBounds(X, IconTextHeight + VertMargin + VertSpacing,

            ButtonWidth, ButtonHeight);

          Inc(X, ButtonWidth + ButtonSpacing);

          if B = mbHelp then

            OnClick := TMessageForm(Result).HelpButtonClick;

        end;

      end;

  end;

end;

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

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