mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: TKASToolLabel control

Browse source
This commit is contained in:
Alexander Koblov 2025-09-28 23:42:22 +03:00
commit 5cb3b065a2
1 changed files with 37 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

38
components/KASToolBar/kastoolbar.pas
View file

@ -85,6 +85,13 @@ type
constructor Create(AOwner: TComponent; Item: TKASToolItem); override;
end;
{ TKASToolLabel }
TKASToolLabel = class(TKASToolButton)
protected
procedure Paint; override;
end;
{ TKASToolBar }
TKASToolBar = class(TToolBar, IToolOwner)
@ -206,7 +213,7 @@ procedure Register;
implementation
uses
Themes, Types, Math, ActnList, DCOSUtils;
Themes, Types, Math, ActnList, LCLType, LCLIntf, DCOSUtils;
type
PToolItemExecutor = ^TToolItemExecutor;
@ -1222,5 +1229,34 @@ begin
ControlStyle:= ControlStyle + [csAutoSize0x0];
end;
{ TKASToolLabel }
procedure TKASToolLabel.Paint;
const
cAlignment: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
R: TRect;
Flags: Longint;
LabelText: String;
begin
R:= ClientRect;
Canvas.Font:= Font;
LabelText:= Caption;
InflateRect(R, -8, 0);
Canvas.Brush.Color:= Color;
Canvas.Brush.Style:= bsClear;
Flags:= DT_EXPANDTABS or DT_VCENTER;
Flags:= Flags or DT_SINGLELINE or DT_NOPREFIX;
if UseRightToLeftReading then
begin
Flags:= Flags or DT_RTLREADING;
end;
Flags:= Flags or cAlignment[BidiFlipAlignment(Self.Alignment, UseRightToLeftAlignment)];
DrawText(Canvas.Handle, PAnsiChar(LabelText), Length(LabelText), R, Flags or DT_NOCLIP);
end;
end.