当前位置 : 主页 > 编程语言 > delphi >

Delphi TStatusBar SizeGrip和VCL样式

来源:互联网 收集:自由互联 发布时间:2021-06-23
我有TStatusBar的问题. 启用VCL样式后,即使SizeGrip属性设置为false,sizegrip也始终可见. 有办法解决吗? 该问题位于TStatusBarStyleHook类的Paint方法中,VCl代码不检查SizeGrip属性的值并始终绘制控件
我有TStatusBar的问题.

启用VCL样式后,即使SizeGrip属性设置为false,sizegrip也始终可见.

有办法解决吗?

该问题位于TStatusBarStyleHook类的Paint方法中,VCl代码不检查SizeGrip属性的值并始终绘制控件.解决方法是创建一个从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);

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

别忘了像这样注册新式钩子

TStyleManager.Engine.RegisterStyleHook(TCustomStatusBar, TStatusBarStyleHookFix);
TStyleManager.Engine.RegisterStyleHook(TStatusBar, TStatusBarStyleHookFix);
网友评论