Question

Some background info. I work at a very small company who has recently upgraded Delphi from version 6 (!!!) to Rad Studio XE5 and things have certainly changed a lot in 10+ years. Most things seems to have been improved in the IDE and framework, but we're having big problems with the new VCL Styles feature. It's just very buggy and not up to par with the quality we were used to from Borland back in the day. We have done lots of tweaks and work arounds to get things working but one issue is really bugging me at the moment and it has to do with the preview form in FastReport 4.

  1. The toolbar gets a white border around it.
  2. Controls in the print dialog and others are misaligned or wrongly positioned

We really want to use VCL Styles to give our software a new fresh look, so we hope there is a solution to these problems.

Steps to reproduce the issues:

  1. Create a new VCL Forms Application
  2. Check a VCL Style in Project > Options > Application > Appearance, e.g. Sapphire Kamri.
  3. Add a TfrxReport report Component to the form
  4. Double click the component frxReport1 and add a Page Header band just to have some content
  5. Add a TButton and in OnClick event, call frxReport1.ShowReport();
  6. Run the program and click on the button. In the preview form you now see that the toolbar is surrounded by a white border which looks weird.
  7. Click the leftmost print button to bring up the print dialog and you can see how the group boxes and cancel button is positioned outside of the client area.

Do you have any solutions or suggestions to solve the issues?

enter image description here

Edit: RRUZ gave a good answer, but there were some side effects to his solution to problem #1 so I decided to simplify the code and just paint the border around the toolbar manually. Like this:

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;
Was it helpful?

Solution

Effectively both issues it seems VCL Styles bugs.

1) Q: The toolbar gets a white border around it.

A: The TToolBarStyleHook Style hook in not handling the BorderWidth property. so you must create a new style hook and override the PaintNC to overcome this issue.

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;

and register like so

initialization
  TCustomStyleEngine.RegisterStyleHook(TToolBar, TToolBarStyleHookEx);

2) Q : Controls in the print dialog and others are misaligned or wrongly positioned

A: It seems a issue related with the TFormStyleHook, you had 3 alternatives.

1) you can edit the frxPrintDialog unit and increase the width of the form.

2) you can patch the form style hook.

3) You can change the width of the print dialog in run-time.

Check this code which changes the width of the dialog in run-time using a 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();

After of apply both fixes this will be the result

enter image description here

enter image description here

Note: please report these issues to the QC page of Embarcadero.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top