Решение проблемы с SizeGrip в TStatusBar при включенных VCL Styles в Delphi

Delphi , Компоненты и Классы , TStatusBar

При использовании VCL Styles в Delphi, пользователи могут столкнуться с проблемой, когда SizeGrip в TStatusBar отображается всегда, даже если свойство SizeGrip установлено в False. В данной статье мы рассмотрим решение этой проблемы.

Описание проблемы

При активации VCL Styles, SizeGrip в TStatusBar отображается даже если свойство SizeGrip установлено в False.

Пример кода

Для решения этой проблемы можно создать новый стиль-hook, унаследованный от TStatusBarStyleHook, и переопределить метод Paint. Ниже приведен пример кода, решающий проблему:

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

    // Рисовать SizeGrip только если свойство SizeGrip установлено в 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);

      // Рисовать SizeGrip только если свойство SizeGrip установлено в 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;

Не забудьте зарегистрировать новый стиль-hook следующим образом:

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

Этот подход решает проблему отображения SizeGrip в TStatusBar при активации VCL Styles в Delphi.

Создано по материалам из источника по ссылке.

Решение проблемы с SizeGrip в TStatusBar при включенных VCL Styles в Delphi заключается в создании нового стиля-hook, унаследованного от TStatusBarStyleHook, и переопределения метода Paint для корректного отображения SizeGrip только если свойство SizeGrip

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TStatusBar ::