我已经编写了一个TOpenPictDialog(源代码见下文)组件,该组件在调用时在某些情况下最终会失败

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

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

非常奇怪的是,在以下情况之一下,它确实可以很好地工作(除了TListView在调整大小时闪烁):

a)在调用形式的“用法”中添加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.

最佳答案

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

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

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

10-08 08:17