4

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

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

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

重现问题的步骤：

  1. 创建一个新的 VCL 表单应用程序
  2. 在 Project > Options > Application > Appearance 中检查 VCL Style，例如 Sapphire Kamri。
  3. 向表单添加 TfrxReport 报告组件
  4. 双击组件 frxReport1 并添加一个 Page Header band 只是为了有一些内容
  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;
4

1 回答 1

5

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

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

A: TToolBarStyleHookStyle 钩子没有处理 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();

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

在此处输入图像描述

在此处输入图像描述

注意：请向Embarcadero 的 QC 页面报告这些问题。

于 2014-04-23T15:51:35.527 回答