• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

Delphi对话框实现源码分析

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

 

简介

在这篇文章中，我将大概的从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解析

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
C#调用matlab动态链接库发布时间：2022-07-18
下一篇：
一个简单的画世界地图以及坐标点的matlab方法发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap