3
我有一個TStatusBar的問題。德爾福TStatusBar SizeGrip和VCL樣式
啓用VCL樣式時,即使SizeGrip屬性設置爲false,sizegrip也始終可見。
有沒有辦法解決它?
我有一個TStatusBar的問題。德爾福TStatusBar SizeGrip和VCL樣式
啓用VCL樣式時,即使SizeGrip屬性設置爲false,sizegrip也始終可見。
有沒有辦法解決它?
此問題位於TStatusBarStyleHook
類的Paint
方法中,VCI代碼未檢查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);
謝謝@RRUZ它像一個魅力工作。並感謝你的VCL Styles Utils,你搖滾! – Xenon
您正在使用什麼版本的Delphi? – lurker
XE3,對不起,我沒有指定它。 – Xenon