DLL中的VCL样式问题

Dev*_*Dev 8 delphi dll delphi-xe2 vcl-styles

我开发了一个具有一种形式的DLL.我使用下面的代码为它设置了一个样式.

library TestLib;

uses Vcl.Themes, Vcl.Styles,....
.
.
exports
   function1,
   function2;

begin
   TStyleManager.TrySetStyle('Style1');
end.
Run Code Online (Sandbox Code Playgroud)

当我加载此DLL并调用function1打开此窗体.表单打开时应用了样式.

现在,当我最小化该窗口时,我收到了访问冲突.包括Maximize&Restore在内的一切都运行良好.此外,所有功能都正常.

我想这不是处理由此表单的Minimize事件生成的消息.请指教.

注意:当我删除样式时,一切正常.

Call Stack

:0976742b TWinControl.HandleNeeded + $3
:0978ad8a TStyleManager.HandleMessage + $56
:09762a3c TWinControl.DoHandleStyleMessage + $14
:0972e6be TCustomForm.WndProc + $612
:09763c2b TWinControl.MainWndProc + $2F
Run Code Online (Sandbox Code Playgroud)

更新:SSCCE

Project1.EXE(有一个表单Unit1.pas/dfm)

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function InitDLL: Boolean;
  end;

var
  Form1: TForm1;

implementation

const
   cLIBRARY = 'Project2.dll';

var
   DLLHandle : THandle;
   showfrm: procedure;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if InitDLL then
      showfrm;
end;

function TForm1.InitDLL: Boolean;
begin
   if DLLHandle = 0 then
   begin
      DLLHandle := LoadLibrary(PChar(cLIBRARY));
      if DLLHandle <> 0 then
      begin
         @showfrm := GetProcAddress(DLLHandle, 'showfrm');
      end
      else
      begin
         Result := False;
         raise Exception.Create('Error loading DLL: ' + cLIBRARY);
      end;
   end;

   Result := (DLLHandle > 0);
end;

{$R *.dfm}

end.
Run Code Online (Sandbox Code Playgroud)

创建一个DLL Project2.dll,其中unit2作为任何表单,unit3将调用该表单.将样式(比如AnyStyle1)添加到此dll作为资源.

library Project2;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

{$R *.dres}

uses
  ShareMem,
  Vcl.Themes,
  Vcl.Styles,
  Vcl.Dialogs,
  System.SysUtils,
  System.Classes,
  Unit2 in 'Unit2.pas' {Form2},
  Unit3 in 'Unit3.pas';

{$R *.res}

exports
showfrm;

begin
   if TStyleManager.TrySetStyle('AnyStyle1') then
   begin
      ShowMessage('True');
   end
   else
      ShowMessage('False');
end.
Run Code Online (Sandbox Code Playgroud)

unit3.pas

unit Unit3;

interface

uses Unit2;

   procedure showfrm;

implementation
   procedure showfrm;
   begin
      with TForm2.Create(nil) do
         Show;
   end;
end.
Run Code Online (Sandbox Code Playgroud)

现在按Unit2窗口的最小化按钮.您将获得访问冲突.

Ser*_*yuz 6

访问冲突的原因是,Delphi XE2中的vcl样式似乎没有考虑到dll中的VCL样式.AV被抛出在WM_SIZE表单样式钩子的处理程序中:

procedure TFormStyleHook.WMSize(var Message: TWMSize);
begin
  if IsIconic(Handle) and (Application.MainForm.Handle <> Handle) then
    InvalidateNC;

  ...
Run Code Online (Sandbox Code Playgroud)

样式钩子测试是否在主窗体上处理消息,但是在dll中没有主窗体.访问未分配引用的句柄会导致异常.


下面的解决方法引入了一个后代样式钩子来防止这种情况,它绕过了对主窗体的检查,并让消息的处理继续进行TWinControl.

这是dll中整个修改后的"unit3":

unit Unit3;

interface

uses forms, messages, themes, windows, Unit2;

procedure showfrm;

implementation

type
  TForm2StyleHook = class(TFormStyleHook)
  private
    procedure WMSize(var Message: TWMSIZE); message WM_SIZE;
  end;

procedure TForm2StyleHook.WMSize(var Message: TWMSIZE);
begin
  if IsIconic(Handle) then begin
    // duplicate the code in ascendant, for whatever it serves
    InvalidateNC;
    // the rest of the code in ascendant class is related with MDI

    Handled := False; // if this is set to true TWinControl.WndProc returns
  end else
    inherited;
end;

procedure showfrm;
begin
  TStyleManager.Engine.RegisterStyleHook(TForm2, TForm2StyleHook);

  with TForm2.Create(nil) do
    Show;
end;

end.
Run Code Online (Sandbox Code Playgroud)

还要注意在考虑在dll中使用样式时继续遇到类似问题的可能性.