FastReport 4 和 VCL 样式错误

Question

一些背景信息。我在一家非常小的公司工作，该公司最近将 Delphi 从版本 6 (!!!) 升级到 Rad Studio XE5，并且在 10 多年中情况确实发生了很大变化。大多数事情似乎在 IDE 和框架中都得到了改进，但是我们在使用新的 VCL 样式功能时遇到了很大的问题。它只是非常有缺陷，无法达到我们过去从 Borland 获得的质量。我们已经做了很多调整和变通以使事情正常进行，但一个问题目前确实困扰着我，它与 FastReport 4 中的预览表单有关。

1. 工具栏周围有一个白色边框。
2. 打印对话框中的控件和其他控件未对齐或位置错误

我们真的很想使用 VCL Styles 让我们的软件焕然一新，所以我们希望有解决这些问题的方法。

重现问题的步骤：

1. 创建新的 VCL 表单应用程序
2. 在项目 > 选项 > 应用程序 > 外观中检查 VCL 样式，例如蓝宝石 Kamri。
3. 向表单添加 TfrxReport 报告组件
4. 双击组件 frxReport1 并添加一个页眉带只是为了有一些内容
5. 添加一个TButton并在OnClick事件中调用frxReport1.ShowReport();
6. 运行程序并单击按钮。在预览表单中，您现在看到工具栏被一个看起来很奇怪的白色边框包围。
7. 点击最左边的打印按钮弹出打印对话框，您可以看到分组框和取消按钮是如何定位在客户区之外的。

您有任何解决问题的解决方案或建议吗？

编辑：RRUZ 给出了一个很好的答案，但是他对问题 #1 的解决方案有一些副作用，所以我决定简化代码并手动绘制工具栏周围的边框。像这样：

procedure TToolBarStyleHookEx.PaintNC(Canvas: TCanvas);
begin
  if TToolBar(Control).BorderWidth>0 then
  begin
    Canvas.Pen.Width := 4;
    Canvas.Pen.Color := StyleServices.GetStyleColor(scWindow);
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(2,2,Control.Width-2,Control.Height-1);
  end;
  inherited;
end;

Answer 1

实际上这两个问题似乎都是 VCL 样式的错误。

1) 问：工具栏周围有一个白色边框。

答：TToolBarStyleHook 样式挂钩未处理 BorderWidth 属性。所以你必须创建一个新的样式钩子并覆盖PaintNC 来解决这个问题。

type
  TToolBarStyleHookEx = class(TToolBarStyleHook)
  protected
    procedure PaintNC(Canvas: TCanvas); override;
  end;

{ TToolBarStyleHookEx }
procedure TToolBarStyleHookEx.PaintNC(Canvas: TCanvas);
var
  Details: TThemedElementDetails;
  LStyle: TCustomStyleServices;
  R: TRect;
begin
  if TToolBar(Control).BorderWidth>0 then
  begin
    LStyle := StyleServices;
    R := Rect(0, 0, Control.Width, Control.Height);
    Details.Element := teToolBar;
    Details.Part := 0;
    Details.State := 0;
    if LStyle.HasTransparentParts(Details) then
      LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False);
    LStyle.DrawElement(Canvas.Handle, Details, R);
  end;
  inherited;
end;

然后像这样注册

initialization
  TCustomStyleEngine.RegisterStyleHook(TToolBar, TToolBarStyleHookEx);

2) Q : 打印对话框中的控件和其他控件未对齐或位置错误

A：这似乎是与TFormStyleHook 相关的问题，您有 3 个备选方案。

1）您可以编辑frxPrintDialog单元并增加表单的宽度。

2) 你可以修补表单样式的钩子。

3) 您可以在运行时更改打印对话框的宽度。

检查此代码，它使用HCBT_ACTIVATE 钩子在运行时更改对话框的宽度

var

 hhk: HHOOK;

function CBT_FUNC(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
const
  ClassNameBufferSize = 1024;
var
 hWindow: HWND;
 RetVal : Integer;
 ClassNameBuffer: Array[0..ClassNameBufferSize-1] of Char;
 i : integer;
begin
   Result := CallNextHookEx(hhk, nCode, wParam, lParam);
   if nCode<0 then exit;
   case nCode of
     HCBT_ACTIVATE:
     begin
       hWindow := HWND(wParam);
       if (hWindow>0) then
       begin
          RetVal := GetClassName(wParam, ClassNameBuffer, SizeOf(ClassNameBuffer));
          if (RetVal>0) and SameText(ClassNameBuffer, 'TfrxPrintDialog') then
          for i:= 0 to Screen.FormCount-1 do
          if (SameText(Screen.Forms[i].ClassName, 'TfrxPrintDialog')) and (Screen.Forms[i].Width<=563) then
            Screen.Forms[i].Width:=Screen.Forms[i].Width+8;
       end;
     end;
   end;

end;

Procedure InitHook();
var
  dwThreadID : DWORD;
begin
  dwThreadID := GetCurrentThreadId;
  hhk := SetWindowsHookEx(WH_CBT, @CBT_FUNC, hInstance, dwThreadID);
  if hhk=0 then RaiseLastOSError;
end;

Procedure KillHook();
begin
  if (hhk <> 0) then
    UnhookWindowsHookEx(hhk);
end;

initialization
  InitHook();

finalization
  KillHook();

应用这两个修复后，这将是结果

注意：请将这些问题报告给QC page of Embarcadero。