Question

i have a problem with TStatusBar.

When VCL Styles are enabled the sizegrip is always visible even if the SizeGrip property is set to false.

Is there a way to fix it?

Was it helpful?

Solution

The issue is located in the Paint method of the TStatusBarStyleHook class, the VCl code is not checking the value of the SizeGrip property and always draw the grip. the workaround is create a new style hook derived from the TStatusBarStyleHook class and override the paint method.

Try this sample

uses
  Winapi.CommCtrl,
  Vcl.Styles,
  Vcl.Themes;

 type
 TStatusBarStyleHookFix=class(TStatusBarStyleHook)
 protected
    procedure Paint(Canvas: TCanvas); override;
 end;

 TCustomStatusBarHelper= class helper for TCustomStatusBar
  private
    function GetCanvas: TCanvas;
    procedure SetCanvas(const Value: TCanvas);
  public
    property  CanvasRW : TCanvas read GetCanvas write SetCanvas;
 end;



{ TCustomStatusBarHelper }

function TCustomStatusBarHelper.GetCanvas: TCanvas;
begin
   Result:=Canvas;
end;

procedure TCustomStatusBarHelper.SetCanvas(const Value: TCanvas);
begin
  Self.FCanVas:=Value;
end;


{ TStatusBarStyleHookFix }

procedure TStatusBarStyleHookFix.Paint(Canvas: TCanvas);
const
  AlignStyles: array [TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  LServices : TCustomStyleServices;
  LGripRect: TRect;
  LDetails: TThemedElementDetails;
  LText: string;
  LCanvas: TCanvas;
  Res, Count, I: Integer;
  Idx, Flags: Cardinal;
  Borders: array [0..2] of Integer;
  LRect : TRect;
begin
  LServices:=StyleServices;
  if not LServices.Available then
    Exit;

  LDetails := LServices.GetElementDetails(tsStatusRoot);
  LServices.DrawElement(Canvas.Handle, LDetails, Rect(0, 0, Control.Width, Control.Height));

  if SendMessage(Handle, SB_ISSIMPLE, 0, 0) > 0 then
  begin
    LRect := Control.ClientRect;
    FillChar(Borders, SizeOf(Borders), 0);
    SendMessage(Handle, SB_GETBORDERS, 0, IntPtr(@Borders));
    LRect.Left := Borders[0] + Borders[2];
    LRect.Top := Borders[1];
    LRect.Bottom := LRect.Bottom - Borders[1];
    LRect.Right := LRect.Right - Borders[2];

    LDetails := LServices.GetElementDetails(tsPane);
    LServices.DrawElement(Canvas.Handle, LDetails, LRect);

    //draw the grip only if the  SizeGrip property is true
    if TCustomStatusBar(Control).SizeGrip then
    begin
      LGripRect := Control.ClientRect;
      LGripRect.Left := LGripRect.Right - LRect.Height;
      LDetails := LServices.GetElementDetails(tsGripper);
      LServices.DrawElement(Canvas.Handle, LDetails, LGripRect);
    end;

    LDetails := LServices.GetElementDetails(tsPane);
    SetLength(LText, Word(SendMessage(Handle, SB_GETTEXTLENGTH, 0, 0)));
    if Length(LText) > 0 then
    begin
     SendMessage(Handle, SB_GETTEXT, 0, IntPtr(@LText[1]));
     Flags := Control.DrawTextBiDiModeFlags(DT_LEFT);
     DrawControlText(Canvas, LDetails, LText, LRect, Flags);
    end;
  end
  else
  begin
    if Control is TStatusBar then
      Count := TStatusBar(Control).Panels.Count
    else
      Count := SendMessage(Handle, SB_GETPARTS, 0, 0);
    for I := 0 to Count - 1 do
    begin
      LRect := Rect(0, 0, 0, 0);
      SendMessage(Handle, SB_GETRECT, I, IntPtr(@LRect));
      if IsRectEmpty(LRect) then
        Continue;
      LDetails := LServices.GetElementDetails(tsPane);
      LServices.DrawElement(Canvas.Handle, LDetails, LRect);
      //draw the grip only if the  SizeGrip property is true
      if TCustomStatusBar(Control).SizeGrip and (I = Count - 1) then
      begin
        LGripRect := Control.ClientRect;
        LGripRect.Left := LGripRect.Right - LRect.Height;
        LDetails := LServices.GetElementDetails(tsGripper);
        LServices.DrawElement(Canvas.Handle, LDetails, LGripRect);
      end;
      LDetails := LServices.GetElementDetails(tsPane);
      InflateRect(LRect, -1, -1);
      if Control is TCustomStatusBar then
        Flags := Control.DrawTextBiDiModeFlags(AlignStyles[TCustomStatusBar(Control).Panels[I].Alignment])
      else
        Flags := Control.DrawTextBiDiModeFlags(DT_LEFT);
      Idx := I;
      SetLength(LText, Word(SendMessage(Handle, SB_GETTEXTLENGTH, Idx, 0)));
      if Length(LText) > 0 then
      begin
        Res := SendMessage(Handle, SB_GETTEXT, Idx, IntPtr(@LText[1]));
        if (Res and SBT_OWNERDRAW = 0) then
          DrawControlText(Canvas, LDetails, LText, LRect, Flags)
        else
        if (Control is TCustomStatusBar) and Assigned(TCustomStatusBar(Control).OnDrawPanel) then
        begin
          LCanvas := TCustomStatusBar(Control).Canvas;
          TCustomStatusBar(Control).CanvasRW := Canvas;
          try
            TCustomStatusBar(Control).OnDrawPanel(TCustomStatusBar(Control), TCustomStatusBar(Control).Panels[I], LRect);
          finally
            TCustomStatusBar(Control).CanvasRW := LCanvas;
          end;
        end;
      end
      else if (Control is TCustomStatusBar) then
       if (TCustomStatusBar(Control).Panels[I].Style <> psOwnerDraw) then
         DrawControlText(Canvas, LDetails, TCustomStatusBar(Control).Panels[I].Text, LRect, Flags)
       else
         if Assigned(TCustomStatusBar(Control).OnDrawPanel) then
         begin
           LCanvas := TCustomStatusBar(Control).Canvas;
           TCustomStatusBar(Control).CanvasRW := Canvas;
           try
             TCustomStatusBar(Control).OnDrawPanel(TCustomStatusBar(Control), TCustomStatusBar(Control).Panels[I], LRect);
           finally
             TCustomStatusBar(Control).CanvasRW := LCanvas;
           end;
         end;
    end;
  end;

end;

Don't forget register the new style hook like so

TStyleManager.Engine.RegisterStyleHook(TCustomStatusBar, TStatusBarStyleHookFix);
TStyleManager.Engine.RegisterStyleHook(TStatusBar, TStatusBarStyleHookFix);

enter image description here

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