paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 06:38:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazControls: Fix DividerBevel for vertical layout / Ensure correct values for very small/thin bevels

Browse Source
This commit is contained in:
Martin 2024-03-27 20:01:18 +01:00
parent 689ef2119f
commit dd49f320f4
1 changed files with 40 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
components/lazcontrols/dividerbevel.pas
View File

@ -50,6 +50,7 @@ type
procedure CalcSize;
procedure Paint; override;
procedure FontChanged(Sender: TObject); override;
procedure BoundsChanged; override;
procedure SetAutoSize(Value: Boolean); override;
procedure TextChanged; override;
procedure CalculatePreferredSize(
@ -178,15 +179,25 @@ procedure TDividerBevel.CalcSize;
begin
if not FNeedCalcSize then exit;
FNeedCalcSize := False;
if Caption = '' then
FTextExtent := Canvas.TextExtent(' ')
else
FTextExtent := Canvas.TextExtent(Caption);
if FBevelWidth < 0 then
if FBevelWidth < 0 then begin
if Orientation = trHorizontal then
Canvas.Font.Orientation := 0
else
Canvas.Font.Orientation := 900;
if Caption = '' then
FTextExtent := Canvas.TextExtent(' ')
else
FTextExtent := Canvas.TextExtent(Caption);
FBevelHeight := Max(3, FTextExtent.cy div 5)
end
else
FBevelHeight := FBevelWidth;
FBevelTop := Max((FTextExtent.cy - FBevelHeight) div 2, 0);
if FOrientation = trHorizontal then
FBevelTop := Max((1 + ClientHeight - FBevelHeight) div 2, 0)
else
FBevelTop := Max((1 + ClientWidth - FBevelHeight) div 2, 0);
end;
procedure TDividerBevel.Paint;
@ -227,8 +238,9 @@ var
gsHorLines: begin
aRect.TopLeft := PaintRect.TopLeft;
aRect.Right := PaintRect.Right;
l := (PaintRect.Bottom - aRect.Top + 1) div 3;
inc(aRect.Top);
l := Max((PaintRect.Bottom - aRect.Top + 1) div 3, 1);
if l > 1 then
inc(aRect.Top);
Canvas.Pen.Color := clBtnShadow;
for w := 0 to l - 1 do
Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
@ -239,9 +251,10 @@ var
end;
gsVerLines: begin
aRect.TopLeft := PaintRect.TopLeft;
l := (PaintRect.Right - aRect.Left + 1) div 3;
aRect.Bottom := PaintRect.Bottom + 1;
inc(aRect.Left);
l := Max((PaintRect.Right - aRect.Left + 1) div 3, 1);
if l > 1 then
inc(aRect.Left);
Canvas.Pen.Color := clBtnShadow;
for w := 0 to l - 1 do
Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
@ -352,12 +365,14 @@ begin
Canvas.Brush.Style := bsClear;
j := Max((FBevelHeight - FTextExtent.cy) div 2, 0);
if aHorizontal then begin
j := Max((ClientHeight - FTextExtent.cy) div 2, 0);
Canvas.Font.Orientation := 0;
if not IsRightToLeft then
Canvas.TextOut(aIndent, j, Caption)
else
Canvas.TextOut(Width - FTextExtent.cx - aIndent, j, Caption);
end else begin
j := Max((ClientWidth - FTextExtent.cy) div 2, 0);
Canvas.Font.Orientation := 900;
Canvas.TextOut(j, aIndent + FTextExtent.cx, Caption);
end;
@ -370,6 +385,12 @@ begin
Invalidate;
end;
procedure TDividerBevel.BoundsChanged;
begin
inherited BoundsChanged;
FNeedCalcSize := True;
end;
procedure TDividerBevel.SetAutoSize(Value: Boolean);
begin
inherited SetAutoSize(Value);
@ -389,8 +410,15 @@ end;
procedure TDividerBevel.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
WithThemeSpace: Boolean);
begin
FNeedCalcSize := True;
CalcSize;
if Orientation = trHorizontal then
Canvas.Font.Orientation := 0
else
Canvas.Font.Orientation := 900;
if Caption = '' then
FTextExtent := Canvas.TextExtent(' ')
else
FTextExtent := Canvas.TextExtent(Caption);
if Orientation = trHorizontal then begin
PreferredHeight := Max(FTextExtent.cy, FBevelHeight);
PreferredWidth := 0;