Question

一些背景信息。我在一家非常小的公司工作，他最近将Delphi从版本6（!!!）升级到Rad Studio XE5，并且在10年多的时间里确实发生了很大变化。 IDE和框架中的大多数内容似乎都有所改进，但我们在使用新的VCL样式功能时遇到了很大问题。这只是非常马车，并且与我们过去从Borland回来的质量不相上下。我们已经做了很多调整并努力使事情顺利进行，但是目前我遇到的一个问题就是烦恼，而且它与FastReport 4中的预览表格有关。

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

我们真的想使用VCL样式为我们的软件带来全新的外观，所以我们希望有这些问题的解决方案。

重现问题的步骤：

创建新的VCL表单应用程序
检查项目中的VCL样式＆gt;选项＆gt;申请＆gt;外观，例如Sapphire Kamri。
将TfrxReport报告组件添加到表单
双击组件frxReport1并添加页眉带以获得一些内容
添加TButton并在OnClick事件中，调用frxReport1.ShowReport（）;
运行程序并单击按钮。在预览表单中，您现在看到工具栏周围有一个看起来很奇怪的白色边框。
单击最左侧的打印按钮以打开打印对话框，您可以看到组框和取消按钮如何位于客户区域之外。

您有解决问题的方法或建议吗？

enter image description here

编辑：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 Styles的错误。

1）问：工具栏周围有白色边框。

答：不处理BorderWidth属性的TToolBarStyleHook样式挂钩。所以你必须创建一个新的样式钩子并覆盖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）你可以修补表单样式钩子。

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();

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

enter image description here

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

FastReport 4和VCL样式错误

1 个答案: