0

我写了一个TOpenPictDialog（源代码见下文）组件，在调用时在某些情况下最终失败

结果：= TDialogFunc(DialogFunc)(DialogData);

在 Dialogs.pas 中。由于 DialogFunc 正确指向 GetOpenFileName，我随后调用 CommDlgExtendedError 进行测试以找出问题所在。它返回 CDERR_FINDRESFAILURE。在这种情况下，对话框根本没有显示。我的测试表单只包含一个按钮和 TOpenPictDialog 组件，当按下按钮时，会调用 OpenPictDialog1->Execute - 仅此而已。

非常奇怪的是，它在以下情况之一下确实可以正常工作（除了 TListView 在调整大小时闪烁）：

a) 在调用表单的“uses”中添加 ExtDlgs b) 将原始 TOpenPictureDialog 添加到表单而不调用它 c) 将包含 TOpenPictDialog 的 PAS 文件添加到项目中（尽管已经安装了 TOpenPictDialog）

如果我用一个调用表单编写一个 C++ Builder 应用程序，我永远不会让 TOpenPictDialog 正常工作（即使我添加了额外的 TOpenPictureDialog 组件）。

unit PictureDlg;

{$R-,H+,X+}

{$IF CompilerVersion > 23} {$DEFINE GE_DXE2} {$IFEND}

interface

{$IFDEF GE_DXE2}
   uses Winapi.Messages, Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls,
     Vcl.Graphics, Vcl.ExtCtrls, Vcl.Buttons, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.Consts, Vcl.ComCtrls;
{$ELSE}
   uses Messages, Windows, SysUtils, Classes, Controls, StdCtrls,
     Graphics, ExtCtrls, Buttons, Dialogs, ExtDlgs, Consts, ComCtrls;
{$ENDIF}

(*$HPPEMIT '// Alias records for C++ code that cannot compile in STRICT mode yet.' *)
(*$HPPEMIT '#if defined(_VCL_ALIAS_RECORDS)' *)
(*$HPPEMIT '#if !defined(STRICT)' *)
// (*$HPPEMIT '  #pragma alias "@Vcl@Extdlgs@TOpenPictDialog@Execute$qqrpv"="@Vcl@Extdlgs@TOpenPictDialog@Execute$qqrp6HWND__"' *)
(*$HPPEMIT '#endif' *)
(*$HPPEMIT '#endif' *)

type

{ TOpenPictDialog }

  TOpenPictDialog = class(TOpenDialog)
  private
    FListView: TListView;
    FTopLabel, FBottomLabel: TStaticText;
    FImageCtrl: TImage;
    FSavedFilename: string;
    FOldDialogWndProc: Pointer;
    FDialogMethodInstance: Pointer;
    FDialogHandle: THandle;
    function  IsFilterStored: Boolean;
    procedure DialogWndProc(var Msg: TMessage);
  protected
    procedure DoClose; override;
    procedure DoSelectionChange; override;
    procedure DoShow; override;
    function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override;
  published
    property Filter stored IsFilterStored;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute(ParentWnd: HWND): Boolean; override;
    property DialogListView: TListView read FListView;
    property DialogImage: TImage read FImageCtrl;
    property TopLabel: TStaticText read FTopLabel;
    property BottomLabel: TStaticText read FBottomLabel;
  end;

procedure Register;

implementation

uses 
{$IFDEF GE_DXE2}
{$IF DEFINED(CLR)}
  System.Runtime.InteropServices, System.Reflection, System.Security.Permissions, System.IO,
{$IFEND}
  System.Math, Vcl.Forms, Winapi.CommDlg, Winapi.Dlgs, System.Types, Winapi.ShlObj, Winapi.ActiveX;
{$ELSE}
{$IF DEFINED(CLR)}
  InteropServices, Reflection, Permissions, IO,
{$IFEND}
  Math, Forms, CommDlg, Dlgs, Types, ShlObj, ActiveX;
{$ENDIF}

{ TOpenPictDialog }

constructor TOpenPictDialog.Create(AOwner: TComponent);
begin
  FDialogHandle := 0;
  FDialogMethodInstance := NIL;

  inherited Create(AOwner);
  Filter := GraphicFilter(TGraphic);

  FListView := TListView.Create(Self);
  FImageCtrl := TImage.Create(Self);

  with FListView do
  begin
    Name := 'ListView';
    SetBounds(204, 5, 169, 200);
    BevelOuter := bvNone;
    BorderWidth := 6;
    TabOrder := 1;
    Color := clWindow;
    ParentDoubleBuffered := false;
    DoubleBuffered := true;
    OwnerDraw := true;
    Ctl3D := true;

    with FImageCtrl do
    begin
       Picture := nil;
       Name := 'Image';
       Parent := FListView;
    end;
  end;

  FTopLabel := TStaticText.Create(Self);
  with FTopLabel do
  begin
   Name := 'TopLabel';
   SetBounds(6, 6, 157, 23);
   AutoSize := False;
   Caption := 'Preview:';
  end;

  FBottomLabel := TStaticText.Create(Self);
  with FBottomLabel do
  begin
   Name := 'BottomLabel';
   SetBounds(6, 6, 157, 23);
   AutoSize := False;
   Caption := 'Image size: 208 x 149 px';
   Alignment := taCenter;
  end;
end;

procedure TOpenPictDialog.DialogWndProc(var Msg: TMessage);
var
  PreviewRect, ListViewRect, WindowRect, LabelRect: TRect;
  WndControl: HWND;

begin
    Msg.Result := CallWindowProc(FOldDialogWndProc, FDialogHandle, Msg.Msg, Msg.WParam, Msg.LParam);

    if ((Msg.Msg = WM_WINDOWPOSCHANGED) and
            ((TWMWindowPosMsg(Msg).WindowPos.Flags and SWP_NOSIZE) = 0)) or
            (Msg.Msg = WM_SHOWWINDOW) then begin

        PreviewRect := FListView.BoundsRect;

        GetWindowRect(Handle, WindowRect);

        WndControl := FindWindowEx(FDialogHandle, 0, 'SHELLDLL_DefView', nil);
        WndControl := FindWindowEx(WndControl, 0, 'SysListView32', nil);

        if WndControl <> 0 then begin
            GetWindowRect(WndControl, ListViewRect);
            PreviewRect.Top := ListViewRect.Top - WindowRect.Top;
            PreviewRect.Bottom := PreviewRect.Top + ListViewRect.Bottom - ListViewRect.Top;

           if (not EqualRect(PreviewRect, FListView.BoundsRect)) then
              FListView.BoundsRect := PreviewRect;

            LabelRect := PreviewRect;
            Dec(LabelRect.Top, 24);
            LabelRect.Bottom := LabelRect.Top + 16;

            FTopLabel.BoundsRect := LabelRect;

            LabelRect := PreviewRect;
            LabelRect.Top := PreviewRect.Bottom + 9;
            LabelRect.Bottom := LabelRect.Top + 16;

            FBottomLabel.BoundsRect := LabelRect;
        end;
    end;
end;

procedure TOpenPictDialog.DoSelectionChange;
var
  FullName: string;

  function ValidFile(const FileName: string): Boolean;
  begin
    Result := FileGetAttr(FileName) <> -1;
  end;

begin
  FullName := FileName;
  if FullName <> FSavedFilename then
  begin
    FSavedFilename := FullName;
  end;
  inherited DoSelectionChange;
end;

procedure TOpenPictDialog.DoClose;
begin
  if Assigned(FDialogMethodInstance) then begin
    SetWindowLong(FDialogHandle, GWL_WNDPROC, Integer(FOldDialogWndProc));
    FreeObjectInstance(FDialogMethodInstance);
  end;

  FDialogHandle := 0;
  FDialogMethodInstance := NIL;

  inherited DoClose;
  { Hide any hint windows left behind }
  Application.HideHint;
end;

procedure TOpenPictDialog.DoShow;
var
  PreviewRect, StaticRect, OldDialogRect: TRect;
  DialogWidth, DialogHeight, NewLeft, NewTop: integer;
const
  SizeIncrease = 25;
begin
  FDialogHandle := GetParent(Handle);
  GetWindowRect(FDialogHandle, OldDialogRect);
  DialogWidth := OldDialogRect.Right - OldDialogRect.Left + SizeIncrease;
  DialogHeight := OldDialogRect.Bottom - OldDialogRect.Top;
  NewLeft := (Screen.Width - DialogWidth) div 2;
  NewTop := (Screen.Height - DialogHeight) div 2;

  GetWindowRect(Handle, PreviewRect);

  MoveWindow(FDialogHandle, NewLeft, NewTop, DialogWidth, DialogHeight, true);
  MoveWindow(Handle, 0, 0, PreviewRect.Right - PreviewRect.Left + SizeIncrease, PreviewRect.Bottom - PreviewRect.Top, false);

  StaticRect := GetStaticRect;
  GetClientRect(Handle, PreviewRect);
  PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
  Inc(PreviewRect.Top, 4);
  Dec(PreviewRect.Right, 8);
  Dec(PreviewRect.Bottom, 20);
  FListView.BoundsRect := PreviewRect;

  FDialogMethodInstance := MakeObjectInstance(DialogWndProc);
  FOldDialogWndProc := Pointer(SetWindowLong(FDialogHandle, GWL_WNDPROC, Integer(FDialogMethodInstance)));

  FSavedFilename := '';
  FListView.ParentWindow := Handle;
  FTopLabel.ParentWindow := Handle;
  FBottomLabel.ParentWindow := Handle;

  inherited DoShow;
end;

[UIPermission(SecurityAction.LinkDemand, Window=UIPermissionWindow.SafeSubWindows)]
function TOpenPictDialog.Execute(ParentWnd: HWND): Boolean;
begin
  if NewStyleControls and not (ofOldStyleDialog in Options) and not
     ((Win32MajorVersion >= 6) and UseLatestCommonDialogs) then
    Template := 'DLGTEMPLATE'
  else
{$IF DEFINED(CLR)}
    Template := '';
{$ELSE}
    Template := nil;
{$IFEND}
  Result := inherited Execute(ParentWnd);
end;

function TOpenPictDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
  // This makes sense ONLY if you are compiling with a run-time packages
  // Thanks to Peter Below (www.delphifaq.com)
  TOpenfilename(Dialogdata).hInstance := FindClassHInstance(Classtype);
  Result := inherited TaskModalDialog(DialogFunc, DialogData);
end;

function TOpenPictDialog.IsFilterStored: Boolean;
begin
  Result := not (Filter = GraphicFilter(TGraphic));
end;

procedure Register;
begin
  RegisterComponents('Dialogs', [TOpenPictDialog]);
end;

end.
4

1 回答 1

1

当您从ExtDlgs.pas复制代码开始编写您的代码时，您复制的不够多。特别是，您没有复制$R链接相关ExtDlgs.rc文件的指令，该文件包含描述自定义对话框的附加布局的对话框资源。

您的代码告诉 API 使用名为 DLGTEMPLATE 的对话框资源，但您尚未在程序中包含该资源。这就解释了为什么你得到的错误代码是关于找不到资源的。使用 ExtDlgs 单元具有链接该单元的相关资源的副作用。

将ExtDlgs.rc中的对话框模板复制到您自己的 RC 文件中，并像ExtDlgs.pas一样链接它。但是，为资源使用不同的名称，以避免与现有 DLGTEMPLATE 资源发生名称冲突。相应地调整您的代码。

于 2014-05-22T13:11:51.747 回答