paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-27 04:44:11 +01:00
Code Issues Packages Projects Releases Wiki Activity

LazControls: add BiDiMode to DividerBevel. Issue #24069, patch from Vojtech Cihak

Browse Source 
git-svn-id: trunk@40592 -
This commit is contained in:
juha 2013-03-19 23:16:39 +00:00
parent 7df1120d89
commit 07867f2b3a
1 changed files with 26 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
components/lazcontrols/dividerbevel.pas
View File

@ -52,15 +52,17 @@ type
published published
property Caption; property Caption;
property Align; property Align;
property Autosize; property AutoSize;
property Anchors; property Anchors;
property BevelStyle: TBevelStyle read FBevelStyle write SetBevelStyle default bsLowered; property BevelStyle: TBevelStyle read FBevelStyle write SetBevelStyle default bsLowered;
property BevelWidth: Integer read FBevelWidth write SetBevelWidth default -1; property BevelWidth: Integer read FBevelWidth write SetBevelWidth default -1;
property BiDiMode;
property BorderSpacing; property BorderSpacing;
property Color; property Color;
property Constraints; property Constraints;
property Font; property Font;
property Hint; property Hint;
property ParentBiDiMode;
property ParentColor; property ParentColor;
property ParentFont; property ParentFont;
property ParentShowHint; property ParentShowHint;
@ -113,7 +115,7 @@ begin
else else
FBevelHeight := FBevelWidth; FBevelHeight := FBevelWidth;
FTextHeight := Max(FTextHeight, FBevelHeight + 2); FTextHeight := Max(FTextHeight, FBevelHeight + 2);
FBevelTop := (FTextHeight - FBevelHeight) div 2; FBevelTop := (FTextHeight - FBevelHeight) div 2 + 1;
end; end;
procedure TDividerBevel.SetBevelStyle(AValue: TBevelStyle); procedure TDividerBevel.SetBevelStyle(AValue: TBevelStyle);
@ -154,13 +156,14 @@ end;
class function TDividerBevel.GetControlClassDefaultSize: TSize; class function TDividerBevel.GetControlClassDefaultSize: TSize;
begin begin
Result.CX := 150; Result.CX := 240;
Result.CY := 17; Result.CY := 17;
end; end;
procedure TDividerBevel.Paint; procedure TDividerBevel.Paint;
var var
aBevel: TGraphicsBevelCut; aBevel: TGraphicsBevelCut;
aIndent, aRight: Integer;
PaintRect: TRect; PaintRect: TRect;
begin begin
CalcSize; CalcSize;
@ -182,23 +185,34 @@ begin
Canvas.Frame3D(PaintRect, 1, aBevel); Canvas.Frame3D(PaintRect, 1, aBevel);
exit; exit;
end; end;
PaintRect.Right := FLeftIndent;
Canvas.Frame3D(PaintRect, 1, aBevel); if FLeftIndent > 0 then
aIndent := FLeftIndent + FCaptionSpacing
else
aIndent := 0;
if not IsRightToLeft then
aRight := FLeftIndent
else
aRight := Width - FTextWidth - FCaptionSpacing - aIndent;
if aRight > 0 then begin
PaintRect.Right := aRight;
Canvas.Frame3D(PaintRect, 1, aBevel);
end;
PaintRect.Top := FBevelTop; PaintRect.Top := FBevelTop;
PaintRect.Bottom := FBevelTop + FBevelHeight; PaintRect.Bottom := FBevelTop + FBevelHeight;
if FLeftIndent > 0 then PaintRect.Left := aRight + FTextWidth + FCaptionSpacing;
PaintRect.Left := FLeftIndent + 2*FCaptionSpacing + FTextWidth if aIndent > 0 then
else PaintRect.Left := PaintRect.Left + FCaptionSpacing;
PaintRect.Left := FTextWidth + FCaptionSpacing;
PaintRect.Right := Width; PaintRect.Right := Width;
Canvas.Frame3D(PaintRect, 1, aBevel); Canvas.Frame3D(PaintRect, 1, aBevel);
Canvas.Brush.Style := bsClear; Canvas.Brush.Style := bsClear;
if FLeftIndent > 0 then if not IsRightToLeft then
Canvas.TextOut(FLeftIndent + FCaptionSpacing, 0, Caption) Canvas.TextOut(aIndent, 0, Caption)
else else
Canvas.TextOut(0, 0, Caption); Canvas.TextOut(Width - FTextWidth - aIndent, 0, Caption)
end; end;
procedure TDividerBevel.FontChanged(Sender: TObject); procedure TDividerBevel.FontChanged(Sender: TObject);