Delphi TStatusBar SizeGrip и стили VCL

у меня проблема с TStatusBar.

Когда стили VCL включены, sizegrip всегда виден, даже если для свойства SizeGrip установлено значение false.

Есть ли способ это исправить?


person Xenon    schedule 29.06.2013    source источник
comment
Какую версию Делфи вы используете?   -  person lurker    schedule 29.06.2013
comment
XE3, извините, что не указал.   -  person Xenon    schedule 29.06.2013


Ответы (1)


Проблема находится в методе Paint класса TStatusBarStyleHook, код VCl не проверяет значение свойства SizeGrip и всегда рисует захват. обходным путем является создание нового хука стиля, полученного из класса TStatusBarStyleHook, и переопределение метода рисования.

Попробуйте этот образец

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

введите здесь описание изображения

person RRUZ    schedule 29.06.2013
comment
Спасибо @RRUZ, это сработало как шарм. И спасибо за ваши VCL Styles Utils, вы молодцы! - person Xenon; 29.06.2013