delphi - FastReport 4 和 VCL 样式错误

Question

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

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

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

重现问题的步骤:

1. 创建新的 VCL 表单应用程序
2. 在“项目”>“选项”>“应用程序”>“外观”中检查 VCL 样式，例如蓝 gem 卡姆里。
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 样式 Hook 不处理 BorderWidth 属性。因此您必须创建一个新的样式 Hook 并覆盖 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) 问:打印对话框中的控件和其他控件未对齐或位置错误

答:这似乎是与 TFormStyleHook 有关的问题，您有 3 个替代方案。

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

2)您可以修补表单样式 Hook 。

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

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

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 .