paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-02 21:07:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

LazControls: DividerBevel improvements by Vojtech Cihak. New published properties etc. Issue #24069

Browse Source 
git-svn-id: trunk@40582 -
This commit is contained in:
juha 2013-03-18 17:14:24 +00:00
parent d16cdcf50c
commit a2a2d1599a
1 changed files with 66 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
components/lazcontrols/dividerbevel.pas
View File

@ -17,14 +17,15 @@ interface
uses
Classes, LResources, Forms, Controls, Graphics, Dialogs, Types,
LCLType, LCLIntf, LCLProc, math, ExtCtrls;
LCLType, LCLIntf, LCLProc, math, GraphType, ExtCtrls;
type
{ TDividerBevel }
TDividerBevel = class(TGraphicControl)
private
FBevelStyle: TBevelStyle;
FBevelWidth: Integer;
FCaptionSpacing: Integer;
FLeftIndent: Integer;
FTextHeight, FTextWidth: Integer;
@ -32,8 +33,9 @@ type
FBevelHeight: Integer;
FNeedCalcSize: Boolean;
FTransparent: Boolean;
procedure CalcSize;
procedure SetBevelStyle(AValue: TBevelStyle);
procedure SetBevelWidth(AValue: Integer);
procedure SetCaptionSpacing(const AValue: Integer);
procedure SetLeftIndent(const AValue: Integer);
procedure SetTransparent(AValue: Boolean);
@ -43,7 +45,7 @@ type
procedure FontChanged(Sender: TObject); override;
procedure TextChanged; override;
procedure CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer;
var PreferredWidth, PreferredHeight: Integer;
WithThemeSpace: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
@ -52,6 +54,8 @@ type
property Align;
property Autosize;
property Anchors;
property BevelStyle: TBevelStyle read FBevelStyle write SetBevelStyle default bsLowered;
property BevelWidth: Integer read FBevelWidth write SetBevelWidth default -1;
property BorderSpacing;
property Color;
property Constraints;
@ -60,9 +64,20 @@ type
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Transparent: Boolean read FTransparent write SetTransparent default True;
property Visible;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
published
property CaptionSpacing: Integer read FCaptionSpacing write SetCaptionSpacing
default 10;
@ -86,30 +101,46 @@ var
TextExt: TSize;
begin
if not FNeedCalcSize then exit;
FNeedCalcSize := True;
FNeedCalcSize := False;
if Caption = '' then
TextExt := Canvas.TextExtent(' ')
else
TextExt := Canvas.TextExtent(Caption);
FTextHeight := TextExt.cy;
FTextWidth := TextExt.cx;
FBevelHeight := Max(3, FTextHeight div 5);
if FBevelWidth < 0 then
FBevelHeight := Max(3, FTextHeight div 5)
else
FBevelHeight := FBevelWidth;
FTextHeight := Max(FTextHeight, FBevelHeight + 2);
FBevelTop := (FTextHeight - FBevelHeight) div 2;
end;
procedure TDividerBevel.SetBevelStyle(AValue: TBevelStyle);
begin
if FBevelStyle = AValue then Exit;
FBevelStyle := AValue;
Invalidate;
end;
procedure TDividerBevel.SetBevelWidth(AValue: Integer);
begin
if FBevelWidth = AValue then Exit;
FBevelWidth := AValue;
FNeedCalcSize := True;
Invalidate;
end;
procedure TDividerBevel.SetCaptionSpacing(const AValue: Integer);
begin
if FCaptionSpacing = AValue then
exit;
if FCaptionSpacing = AValue then Exit;
FCaptionSpacing := AValue;
Invalidate;
end;
procedure TDividerBevel.SetLeftIndent(const AValue: Integer);
begin
if FLeftIndent = AValue then
exit;
if FLeftIndent = AValue then Exit;
FLeftIndent := AValue;
Invalidate;
end;
@ -129,6 +160,7 @@ end;
procedure TDividerBevel.Paint;
var
aBevel: TGraphicsBevelCut;
PaintRect: TRect;
begin
CalcSize;
@ -137,27 +169,36 @@ begin
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(ClientRect);
end;
if FBevelStyle = bsLowered then
aBevel := bvLowered
else
aBevel := bvRaised;
Canvas.Pen.Color := Font.Color;
PaintRect.Top := FBevelTop;
PaintRect.Bottom := FBevelTop + FBevelHeight;
PaintRect.Left := 0;
if Caption = '' then begin
PaintRect.Right := Width;
Canvas.Frame3D(PaintRect, 1, bvLowered);
Canvas.Frame3D(PaintRect, 1, aBevel);
exit;
end;
PaintRect.Right := FLeftIndent;
Canvas.Frame3D(PaintRect, 1, bvLowered);
Canvas.Frame3D(PaintRect, 1, aBevel);
PaintRect.Top := FBevelTop;
PaintRect.Bottom := FBevelTop + FBevelHeight;
PaintRect.Left := FLeftIndent + 2*FCaptionSpacing + FTextWidth;
if FLeftIndent > 0 then
PaintRect.Left := FLeftIndent + 2*FCaptionSpacing + FTextWidth
else
PaintRect.Left := FTextWidth + FCaptionSpacing;
PaintRect.Right := Width;
Canvas.Frame3D(PaintRect, 1, bvLowered);
Canvas.Frame3D(PaintRect, 1, aBevel);
Canvas.Brush.Style := bsClear;
Canvas.TextOut(FLeftIndent + FCaptionSpacing, 0, Caption);
if FLeftIndent > 0 then
Canvas.TextOut(FLeftIndent + FCaptionSpacing, 0, Caption)
else
Canvas.TextOut(0, 0, Caption);
end;
procedure TDividerBevel.FontChanged(Sender: TObject);
@ -174,13 +215,15 @@ begin
Invalidate;
end;
procedure TDividerBevel.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
procedure TDividerBevel.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
WithThemeSpace: Boolean);
begin
if WithThemeSpace then ;
FNeedCalcSize := True;
CalcSize;
PreferredWidth := FTextWidth + 2*FLeftIndent + 2*FCaptionSpacing;
if FLeftIndent > 0 then
PreferredWidth := FTextWidth + 2*(FLeftIndent + FCaptionSpacing)
else
PreferredWidth := 2*FTextWidth + FCaptionSpacing;
PreferredHeight := FTextHeight;
end;
@ -188,14 +231,17 @@ constructor TDividerBevel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csSetCaption];
FBevelStyle := bsLowered;
FBevelWidth := -1;
FCaptionSpacing := 10;
FTransparent := True;
LeftIndent := 60;
FNeedCalcSize := True;
if (AOwner = nil) or not(csLoading in AOwner.ComponentState) then
if (AOwner = nil) or not (csLoading in AOwner.ComponentState) then
Font.Style := Font.Style + [fsBold];
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, CX, CY);
end;
end.