2632 lines
74 KiB
ObjectPascal
2632 lines
74 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
* BGRAExpandPanels Version 1.0 *
|
|
* *
|
|
* *
|
|
* (c) Massimo Magnano, Alexander Roth *
|
|
* *
|
|
* *
|
|
********************************************************************************
|
|
|
|
See BcExpandPanels.txt for changelog and to-do
|
|
}
|
|
|
|
unit BCExpandPanels;
|
|
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
// for debugging purposes
|
|
//{$DEFINE DEBUG_PAINT}
|
|
|
|
interface
|
|
|
|
uses
|
|
Controls, Classes, ExtCtrls, Graphics, Math, LResources, Dialogs, SysUtils,
|
|
Buttons, Themes, Types, Menus, BCPanel;
|
|
|
|
type
|
|
TBCExpandPanelsBehaviour = (EPHotMouse, EPMultipanel, EPSinglePanel);
|
|
// TBoundEvent=procedure(sender:TObject; ALeft, ATop, AWidth, AHeight: integer) of object;
|
|
TAnimationEvent = procedure(Sender: TObject; deltaLeft, deltaTop, deltaWidth, deltaHeight: integer) of object;
|
|
TNormalProcedure = procedure of object;
|
|
|
|
|
|
{ TBCBoundButton }
|
|
|
|
TGlyphLayout =
|
|
(
|
|
glLeft,
|
|
glRight,
|
|
glNone
|
|
);
|
|
|
|
TGlyphKind =
|
|
(
|
|
gkArrows,
|
|
gkClose,
|
|
gkMinMax
|
|
);
|
|
|
|
TTextLayout =
|
|
(
|
|
tlLeft,
|
|
tlRight,
|
|
tlCenter,
|
|
tlNone
|
|
);
|
|
|
|
TBCBoundButtonStyle = (bbsButton, bbsTab, bbsLine, bbsLineDouble,
|
|
bbsLineTop, bbsLineBottom, bbsLineDoubleTop, bbsLineDoubleBottom);
|
|
|
|
TBCBoundButton = class(TCustomSpeedButton)
|
|
private
|
|
rColorExpanded: TColor;
|
|
rColorHighlight: TColor;
|
|
rColorShadow: TColor;
|
|
rGlyphKind: TGlyphKind;
|
|
rGlyphLayout: TGlyphLayout;
|
|
rStyle: TBCBoundButtonStyle;
|
|
rTabWidth: Integer;
|
|
rTextLayout: TTextLayout;
|
|
|
|
procedure setColorExpanded(AValue: TColor);
|
|
procedure SetColorHighlight(AValue: TColor);
|
|
procedure SetColorShadow(AValue: TColor);
|
|
procedure SetGlyphKind(AValue: TGlyphKind);
|
|
procedure SetGlyphLayout(AValue: TGlyphLayout);
|
|
procedure SetStyle(AValue: TBCBoundButtonStyle);
|
|
procedure SetTabWidth(AValue: Integer);
|
|
procedure SetTextLayout(AValue: TTextLayout);
|
|
|
|
protected
|
|
rGlyph :TButtonGlyph;
|
|
rUserGlyphExpanded,
|
|
rUserGlyphCollapsed,
|
|
rGlyphExpanded,
|
|
rGlyphCollapsed :TBitmap;
|
|
|
|
procedure SetGlyphCollapsed(AValue: TBitmap);
|
|
procedure SetGlyphExpanded(AValue: TBitmap);
|
|
procedure LoadGlyph(GlyphDST :TBitmap; ResName :String);
|
|
procedure BuildGlyphs;
|
|
procedure Paint; override;
|
|
procedure Loaded; override;
|
|
|
|
(* property AllowAllUp;
|
|
property Down;
|
|
property Glyph;
|
|
property GroupIndex;
|
|
property Height; //Don't Decrease visibility :-O
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Layout;
|
|
property Left;
|
|
property Margin;
|
|
property Name;
|
|
property NumGlyphs;
|
|
property Spacing;
|
|
property ShowCaption;
|
|
property Tag;
|
|
property Top;
|
|
property Width;
|
|
property Transparent;
|
|
*)
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
published
|
|
property Caption;
|
|
property Color nodefault;
|
|
property ColorExpanded: TColor read rColorExpanded write setColorExpanded;
|
|
property ColorHighlight: TColor read rColorHighlight write SetColorHighlight default clDefault;
|
|
property ColorShadow: TColor read rColorShadow write SetColorShadow default clDefault;
|
|
property Font;
|
|
property Flat;
|
|
property GlyphExpanded: TBitmap read rUserGlyphExpanded write SetGlyphExpanded;
|
|
property GlyphCollapsed: TBitmap read rUserGlyphCollapsed write SetGlyphCollapsed;
|
|
|
|
property GlyphLayout: TGlyphLayout read rGlyphLayout write SetGlyphLayout default glNone;
|
|
property GlyphKind: TGlyphKind read rGlyphKind write SetGlyphKind default gkArrows;
|
|
|
|
property ShowAccelChar;
|
|
property TextLayout: TTextLayout read rTextLayout write SetTextLayout default tlLeft;
|
|
property Style: TBCBoundButtonStyle read rStyle write SetStyle default bbsButton;
|
|
|
|
//Negative Values is the % of Total Width, Positive is a Fixed Width
|
|
property TabWidth: Integer read rTabWidth write SetTabWidth default -50;
|
|
end;
|
|
|
|
{ TBCExpandPanel }
|
|
|
|
TBCExpandPanel = class(TBCPanel)
|
|
private
|
|
FEPManagesCollapsing: TNotifyEvent;
|
|
FButton: TBCBoundButton;
|
|
FButtonSize: integer;
|
|
FCollapseKind: TAnchorKind;
|
|
FCollapsed: boolean;
|
|
FAnimated: boolean;
|
|
FOnExpand: TNotifyEvent;
|
|
FOnPreExpand: TNotifyEvent;
|
|
FOnAnimate: TAnimationEvent;
|
|
FOnCollapse: TNotifyEvent;
|
|
FOnPreCollapse: TNotifyEvent;
|
|
FOnButtonClick: TNotifyEvent;
|
|
FInternalOnAnimate: TAnimationEvent;
|
|
FButtonPosition: TAnchorKind;
|
|
FExpandedButtonColor: TColor;
|
|
FCollapsedButtonColor: TColor;
|
|
FExpandedSize: integer;
|
|
FAnimationSpeed: real;
|
|
FTextAlignment: TAlignment;
|
|
rBevelColorHighlight: TColor;
|
|
rBevelColorShadow: TColor;
|
|
rBevelRounded: Boolean;
|
|
StopCircleActions: boolean;
|
|
FAnimating: boolean;
|
|
FVisibleTotal: boolean;
|
|
|
|
TargetAnimationSize: integer;
|
|
EndProcedureOfAnimation: TNormalProcedure;
|
|
|
|
Timer: TTimer;
|
|
|
|
function GetEnabled: Boolean;
|
|
procedure SetBevelColorHighlight(AValue: TColor);
|
|
procedure SetBevelColorShadow(AValue: TColor);
|
|
procedure SetBevelRounded(AValue: Boolean);
|
|
procedure SetEnabled(AValue: Boolean);
|
|
procedure setExpandedSize(Value: integer);
|
|
procedure setButtonSize(Value: integer);
|
|
|
|
procedure setButtonPosition(Value: TAnchorKind);
|
|
procedure setCollapseKind(Value: TAnchorKind);
|
|
procedure setAnimationSpeed(Value: real);
|
|
procedure setCollapsed(Value: boolean);
|
|
|
|
procedure PositionButton;
|
|
|
|
procedure SetRelevantSize(comp: TControl; AKind: TAnchorKind; ASize: Integer);
|
|
function RelevantSize(comp: TControl; akind: TAnchorKind): integer;
|
|
function RelevantOrthogonalSize(comp: TControl; akind: TAnchorKind): integer;
|
|
function DeltaCoordinates(deltaMove, deltaSize: integer): TRect; // the outpot (left,top right, bottom) has all the information: left and top encode the movement. rigth and bottom the size changes
|
|
|
|
|
|
procedure Animate(aTargetSize: integer);
|
|
procedure SetTextAlignment(AValue: TAlignment);
|
|
|
|
procedure TimerAnimateSize(Sender: TObject);
|
|
procedure EndTimerCollapse;
|
|
procedure EndTimerExpand;
|
|
procedure UpdateAll;
|
|
|
|
procedure ButtonClick(Sender: TObject);
|
|
procedure DoCollapse;
|
|
procedure DoExpand;
|
|
procedure AdjustClientRect(var ARect: TRect); override;
|
|
|
|
property InternalOnAnimate: TAnimationEvent read FInternalOnAnimate write FInternalOnAnimate;
|
|
property EPManagesCollapsing: TNotifyEvent read FEPManagesCollapsing write FEPManagesCollapsing;
|
|
protected
|
|
procedure Loaded; override;
|
|
procedure CreateWnd; override;
|
|
procedure Paint; override;
|
|
public
|
|
property Animating: boolean read FAnimating;
|
|
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
|
|
published
|
|
property TextAlignment: TAlignment read FTextAlignment write SetTextAlignment;
|
|
property Enabled: Boolean read GetEnabled write SetEnabled;
|
|
property CollapseKind: TAnchorKind read FCollapseKind write setCollapseKind; //To where should it collapse?
|
|
property ExpandedSize: integer read FExpandedSize write setExpandedSize;
|
|
property ButtonPosition: TAnchorKind read FButtonPosition write setButtonPosition;
|
|
property ButtonSize: integer read FButtonSize write setButtonSize;
|
|
|
|
property Button: TBCBoundButton read FButton;
|
|
|
|
property AnimationSpeed: real read FAnimationSpeed write setAnimationSpeed;
|
|
property Animated: boolean read FAnimated write FAnimated default True;
|
|
property Collapsed: boolean read FCollapsed write setCollapsed default False;
|
|
|
|
property BevelColorHighlight: TColor read rBevelColorHighlight write SetBevelColorHighlight default clBtnHighlight;
|
|
property BevelColorShadow: TColor read rBevelColorShadow write SetBevelColorShadow default clBtnShadow;
|
|
property BevelRounded: Boolean read rBevelRounded write SetBevelRounded default True;
|
|
|
|
property OnAnimate: TAnimationEvent read FOnAnimate write FOnAnimate;
|
|
property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
|
|
property OnPreExpand: TNotifyEvent read FOnPreExpand write FOnPreExpand;
|
|
property OnExpand: TNotifyEvent read FOnExpand write FOnExpand;
|
|
property OnCollapse: TNotifyEvent read FOnCollapse write FOnCollapse;
|
|
property OnPreCollapse: TNotifyEvent read FOnPreCollapse write FOnPreCollapse;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{==============================================================================
|
|
Class: TBCExpandPanels
|
|
Description:
|
|
==============================================================================}
|
|
|
|
{ TBCExpandPanels }
|
|
|
|
TBCExpandPanels = class(TComponent)
|
|
private
|
|
{ Private-Deklarationen }
|
|
PanelArray: TList;
|
|
|
|
// Properties
|
|
FArrangeKind: TAnchorKind;
|
|
FButtonPosition, FCollapseKind: TAnchorKind;
|
|
FButtonGlyphKind: TGlyphKind;
|
|
FButtonGlyphLayout: TGlyphLayout;
|
|
FButtonStyle: TBCBoundButtonStyle;
|
|
FButtonTabWidth: Integer;
|
|
FButtonTextLayout: TTextLayout;
|
|
FOrthogonalAbove: integer;
|
|
FAbove: integer;
|
|
FOrthogonalSize: integer;
|
|
FBehaviour: TBCExpandPanelsBehaviour;
|
|
FOnArrangePanels: TNotifyEvent;
|
|
FFixedSize: integer;
|
|
FUseFixedSize: boolean;
|
|
FAutoCollapseIfTooHigh: boolean;
|
|
|
|
FUseClientSize: boolean;
|
|
|
|
function RelevantAbove(comp: TControl): integer;
|
|
function RelevantOrthogonalAbove(comp: TControl): integer;
|
|
function RelevantSize(comp: TControl): integer;
|
|
function RelevantOrthogonalSize(comp: TControl): integer;
|
|
procedure setButtonGlyphKind(AValue: TGlyphKind);
|
|
procedure setButtonGlyphLayout(AValue: TGlyphLayout);
|
|
procedure setButtonStyle(AValue: TBCBoundButtonStyle);
|
|
procedure SetButtonTabWidth(AValue: Integer);
|
|
procedure setButtonTextLayout(AValue: TTextLayout);
|
|
procedure WriteRelevantAbove(comp: TBCExpandPanel; above: integer);
|
|
procedure WriteRelevantSize(comp: TBCExpandPanel; size: integer);
|
|
procedure WriteRelevantOrthogonalSize(comp: TBCExpandPanel; size: integer);
|
|
procedure WriteRelevantOrthogonalAbove(comp: TBCExpandPanel; size: integer);
|
|
|
|
procedure setArrangeKind(Value: TAnchorKind);
|
|
procedure setButtonPosition(Value: TAnchorKind);
|
|
procedure setCollapseKind(Value: TAnchorKind);
|
|
procedure setUseClientSize(Value: boolean);
|
|
procedure setUseFixedSize(Value: boolean);
|
|
procedure setAutoCollapseIfTooHigh(Value: boolean);
|
|
procedure setFixedSize(Value: integer);
|
|
procedure setOrthogonalAbove(Value: integer);
|
|
procedure setAbove(Value: integer);
|
|
procedure setOrthogonalSize(Value: integer);
|
|
procedure setBehaviour(Value: TBCExpandPanelsBehaviour);
|
|
|
|
procedure MakeCorrectButtonClickPointers;
|
|
|
|
procedure RollOutOnAnimate(Sender: TObject; deltaLeft, deltaTop, deltaWidth, deltaHeight: integer);
|
|
|
|
procedure RollOutClick(Sender: TObject);
|
|
procedure HotTrackSetActivePanel(Value: integer);
|
|
procedure DelLastPanel;
|
|
|
|
procedure RollOut1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
|
|
protected
|
|
{ Protected-Deklarationen }
|
|
public
|
|
{ Public-Deklarationen }
|
|
|
|
property OrthogonalAbove: integer read FOrthogonalAbove write setOrthogonalAbove;
|
|
property Above: integer read FAbove write setAbove;
|
|
property OrthogonalSize: integer read FOrthogonalSize write setOrthogonalSize;
|
|
|
|
function IdxOfPanel(aname: string): integer; overload;
|
|
|
|
procedure CollapseIfTooHigh;
|
|
// procedure SetCorrectSize;
|
|
procedure AddPanel(rollout: TBCExpandPanel);
|
|
procedure InsertPanel(idx: integer; rollout: TBCExpandPanel);
|
|
function DeltePanel(aname: string): boolean; overload;
|
|
function DeltePanel(idx: integer): boolean; overload;
|
|
procedure DelteLastPanel;
|
|
procedure ArrangePanels;
|
|
function Count: integer;
|
|
function Panel(idx: integer): TBCExpandPanel;
|
|
|
|
property CollapseKind: TAnchorKind read FCollapseKind write setCollapseKind;
|
|
property ButtonPosition: TAnchorKind read FButtonPosition write setButtonPosition;
|
|
property ButtonGlyphLayout: TGlyphLayout read FButtonGlyphLayout write setButtonGlyphLayout;
|
|
property ButtonGlyphKind: TGlyphKind read FButtonGlyphKind write setButtonGlyphKind;
|
|
property ButtonStyle: TBCBoundButtonStyle read FButtonStyle write setButtonStyle;
|
|
property ButtonTabWidth: Integer read FButtonTabWidth write SetButtonTabWidth;
|
|
property ButtonTextLayout: TTextLayout read FButtonTextLayout write setButtonTextLayout;
|
|
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
{ Published-Deklarationen }
|
|
|
|
// property FixedHeight:integer read FFixedHeight write setFixedSize;
|
|
// property UseFixedHeight:boolean read FUseFixedHeight write setUseFixedSize;
|
|
// property UseClientHeight:boolean read FUseClientHeight write setUseClientSize;
|
|
// property AutoCollapseIfTooHigh:boolean read FAutoCollapseIfTooHigh write setAutoCollapseIfTooHigh;
|
|
property ArrangeKind: TAnchorKind read FArrangeKind write setArrangeKind;
|
|
property OnArrangePanels: TNotifyEvent read FOnArrangePanels write FOnArrangePanels;
|
|
property Behaviour: TBCExpandPanelsBehaviour read FBehaviour write setBehaviour;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses GraphType, LCLProc;
|
|
|
|
const
|
|
//GrayScale a Color : Taken from BGRABitmap package
|
|
redWeightShl10 = 306; // = 0.299
|
|
greenWeightShl10 = 601; // = 0.587
|
|
blueWeightShl10 = 117; // = 0.114
|
|
|
|
|
|
procedure korrigiere(var w: real; min, max: real);
|
|
var
|
|
temp: real;
|
|
begin
|
|
if max < min then
|
|
begin
|
|
temp := min;
|
|
min := max;
|
|
max := temp;
|
|
end;
|
|
|
|
if w < min then
|
|
w := min;
|
|
if w > max then
|
|
w := max;
|
|
end;
|
|
|
|
|
|
//Function copied from BGRABitmap package may work ;-)
|
|
function Grayscale(AColor :TColor):TColor;
|
|
Var
|
|
rColor, gray :Integer;
|
|
|
|
begin
|
|
rColor :=ColorToRGB(AColor);
|
|
gray := (Red(rColor) * redWeightShl10 + Green(rColor) * greenWeightShl10 + Blue(rColor) * blueWeightShl10 + 512) shr 10;
|
|
Result :=RGBToColor(gray, gray, gray);
|
|
end;
|
|
|
|
function GetHighlightColor(BaseColor: TColor; Value:Integer): TColor;
|
|
Var
|
|
rColor :Integer;
|
|
|
|
begin
|
|
rColor :=ColorToRGB(BaseColor);
|
|
Result := RGBToColor(
|
|
Min(Red(rColor) + Value, $FF),
|
|
Min(Green(rColor) + Value, $FF),
|
|
Min(Blue(rColor) + Value, $FF));
|
|
end;
|
|
|
|
function GetShadowColor(BaseColor: TColor; Value:Integer): TColor;
|
|
Var
|
|
rColor :Integer;
|
|
|
|
begin
|
|
rColor :=ColorToRGB(BaseColor);
|
|
Result := RGBToColor(
|
|
Max(Red(rColor) - Value, $22),
|
|
Max(Green(rColor) - Value, $22),
|
|
Max(Blue(rColor) - Value, $22));
|
|
end;
|
|
|
|
//Canvas Draw Functions
|
|
procedure Frame3d_Rounded(Canvas: TCanvas;
|
|
var ARect: TRect; const FrameWidth : integer; RX, RY:Integer;
|
|
const Style : TGraphicsBevelCut;
|
|
ShadowColor, HighlightColor, InternalColor: TColor);
|
|
var
|
|
DRect: TRect;
|
|
|
|
procedure drawUP;
|
|
begin
|
|
inc(DRect.Left,1); inc(DRect.Top,1);
|
|
|
|
//is outside the Rect but in this way we don't have a hole of 1 px
|
|
inc(DRect.Right,1); inc(DRect.Bottom,1);
|
|
|
|
Canvas.Brush.Color :=ShadowColor;
|
|
Canvas.Brush.Style :=bsSolid;
|
|
Canvas.Pen.Color := clNone;
|
|
Canvas.Pen.Width := 1; //The Shadow is always 1 Pixel
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.RoundRect(DRect, RX,RY);
|
|
|
|
dec(DRect.Left,1); dec(DRect.Top,1);
|
|
dec(DRect.Right,2); dec(DRect.Bottom,2);
|
|
Canvas.Brush.Color :=InternalColor;
|
|
|
|
if (InternalColor = clNone)
|
|
then Canvas.Brush.Style :=bsClear
|
|
else Canvas.Brush.Style :=bsSolid;
|
|
|
|
Canvas.Pen.Color :=HighlightColor;
|
|
Canvas.Pen.Width := FrameWidth;
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.RoundRect(DRect, RX,RY);
|
|
|
|
Inc(ARect.Top, FrameWidth);
|
|
Inc(ARect.Left, FrameWidth);
|
|
Dec(ARect.Right, FrameWidth+1); //+The Shadow (1 Pixel) +1?
|
|
Dec(ARect.Bottom, FrameWidth+1);
|
|
end;
|
|
|
|
procedure drawFLAT;
|
|
begin
|
|
Canvas.Brush.Color := InternalColor;
|
|
|
|
if (InternalColor = clNone)
|
|
then Canvas.Brush.Style :=bsClear
|
|
else Canvas.Brush.Style :=bsSolid;
|
|
|
|
Canvas.Pen.Color := clNone;
|
|
Canvas.Pen.Width := FrameWidth;
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.RoundRect(DRect, RX,RY);
|
|
end;
|
|
|
|
procedure drawDOWN;
|
|
begin
|
|
Canvas.Brush.Color :=ShadowColor;
|
|
Canvas.Brush.Style :=bsSolid;
|
|
Canvas.Pen.Color := clNone;
|
|
Canvas.Pen.Width := 1;
|
|
Canvas.Pen.Style := psClear;
|
|
Canvas.RoundRect(DRect, RX,RY);
|
|
|
|
inc(DRect.Left,1); inc(DRect.Top,1);
|
|
Canvas.Brush.Color :=InternalColor;
|
|
|
|
if (InternalColor = clNone)
|
|
then Canvas.Brush.Style :=bsClear
|
|
else Canvas.Brush.Style :=bsSolid;
|
|
|
|
Canvas.Pen.Color :=HighlightColor;
|
|
Canvas.Pen.Width := FrameWidth;
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.RoundRect(DRect, RX,RY);
|
|
|
|
Inc(ARect.Top, FrameWidth+1); //+The Shadow (1 Pixel)
|
|
Inc(ARect.Left, FrameWidth+1);
|
|
Dec(ARect.Right, FrameWidth);
|
|
Dec(ARect.Bottom, FrameWidth);
|
|
end;
|
|
|
|
begin
|
|
DRect :=ARect;
|
|
Case Style of
|
|
bvNone: drawFLAT;
|
|
bvSpace: begin
|
|
drawFLAT;
|
|
InflateRect(ARect, -FrameWidth, -FrameWidth);
|
|
end;
|
|
bvRaised: drawUP;
|
|
bvLowered: drawDOWN;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetColorHighlight(AValue: TColor);
|
|
begin
|
|
if (rColorHighlight <> AValue) then
|
|
begin
|
|
rColorHighlight := AValue;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.setColorExpanded(AValue: TColor);
|
|
begin
|
|
if (rColorExpanded <> AValue) then
|
|
begin
|
|
rColorExpanded := AValue;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetColorShadow(AValue: TColor);
|
|
begin
|
|
if (rColorShadow <> AValue) then
|
|
begin
|
|
rColorShadow := AValue;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetGlyphKind(AValue: TGlyphKind);
|
|
begin
|
|
if (rGlyphKind <> AValue) then
|
|
begin
|
|
rGlyphKind:=AValue;
|
|
|
|
if not(csLoading in ComponentState) then
|
|
begin
|
|
BuildGlyphs;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetGlyphLayout(AValue: TGlyphLayout);
|
|
begin
|
|
if (rGlyphLayout <> AValue) then
|
|
begin
|
|
rGlyphLayout := AValue;
|
|
|
|
if not(csLoading in ComponentState) then
|
|
begin
|
|
BuildGlyphs;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetStyle(AValue: TBCBoundButtonStyle);
|
|
begin
|
|
if (rStyle <> AValue) then
|
|
begin
|
|
rStyle:=AValue;
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetTabWidth(AValue: Integer);
|
|
begin
|
|
if (rTabWidth <> AValue) then
|
|
begin
|
|
rTabWidth:=AValue;
|
|
if not(csLoading in ComponentState) and (rStyle = bbsTab)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetTextLayout(AValue: TTextLayout);
|
|
begin
|
|
if (rTextLayout <> AValue) then
|
|
begin
|
|
rTextLayout := AValue;
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetGlyphCollapsed(AValue: TBitmap);
|
|
begin
|
|
rUserGlyphCollapsed.Assign(AValue);
|
|
if not(csLoading in ComponentState) then
|
|
begin
|
|
BuildGlyphs;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.SetGlyphExpanded(AValue: TBitmap);
|
|
begin
|
|
rUserGlyphExpanded.Assign(AValue);
|
|
if not(csLoading in ComponentState) then
|
|
begin
|
|
BuildGlyphs;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.LoadGlyph(GlyphDST: TBitmap; ResName: String);
|
|
Var
|
|
rGlyphO: TPortableNetworkGraphic;
|
|
|
|
begin
|
|
rGlyphO :=TPortableNetworkGraphic.Create;
|
|
rGlyphO.LoadFromLazarusResource(ResName);
|
|
GlyphDST.Assign(rGlyphO);
|
|
FreeAndNil(rGlyphO);
|
|
end;
|
|
|
|
procedure TBCBoundButton.BuildGlyphs;
|
|
begin
|
|
if (rGlyphLayout <> glNone) then
|
|
begin
|
|
if (rUserGlyphCollapsed.Empty)
|
|
then Case rGlyphKind of
|
|
gkArrows: case TBCExpandPanel(Owner).CollapseKind of
|
|
akTop: LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_BOTTOM');
|
|
akLeft: LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_RIGHT');
|
|
akRight: LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_LEFT');
|
|
akBottom: LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_TOP');
|
|
end;
|
|
gkClose: LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_CLOSE');
|
|
gkMinMax: if (TBCExpandPanel(Owner).CollapseKind in [akTop, akBottom])
|
|
then LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_MAX_H')
|
|
else LoadGlyph(rGlyphCollapsed, 'BCEXP_PANEL_MAX_V');
|
|
end
|
|
else rGlyphCollapsed.Assign(rUserGlyphCollapsed);
|
|
|
|
if (rUserGlyphExpanded.Empty)
|
|
then Case rGlyphKind of
|
|
gkArrows: case TBCExpandPanel(Owner).CollapseKind of
|
|
akTop: LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_TOP');
|
|
akLeft: LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_LEFT');
|
|
akRight: LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_RIGHT');
|
|
akBottom: LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_BOTTOM');
|
|
end;
|
|
gkClose: LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_CLOSE');
|
|
gkMinMax: if (TBCExpandPanel(Owner).CollapseKind in [akTop, akBottom])
|
|
then LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_MIN_H')
|
|
else LoadGlyph(rGlyphExpanded, 'BCEXP_PANEL_MIN_V');
|
|
end
|
|
else rGlyphExpanded.Assign(rUserGlyphExpanded);
|
|
end;
|
|
end;
|
|
|
|
procedure TBCBoundButton.Paint;
|
|
var
|
|
paintRect, fRect :TRect;
|
|
xColor,
|
|
xHColor,
|
|
xSColor :TColor;
|
|
middleX,
|
|
middleY,
|
|
txtWidth,
|
|
txtLeft,
|
|
txtTop,
|
|
glyphLeft,
|
|
glyphTop :Integer;
|
|
xCaption :String;
|
|
FButtonPosition :TAnchorKind;
|
|
FCollapsed, Rounded :Boolean;
|
|
|
|
|
|
procedure drawGlyph(var ATop, ALeft :Integer);
|
|
var
|
|
AWidth, AHeight :Integer;
|
|
|
|
begin
|
|
AWidth :=paintRect.Right-paintRect.Left-2;
|
|
AHeight :=paintRect.Bottom-paintRect.Top-2;
|
|
|
|
if FCollapsed
|
|
then rGlyph.Glyph.Assign(rGlyphCollapsed)
|
|
else rGlyph.Glyph.Assign(rGlyphExpanded);
|
|
|
|
//We must Calculate the Real Position of the Glyph
|
|
Case FButtonPosition of
|
|
akTop,
|
|
akBottom : begin
|
|
if (rGlyphLayout = glLeft)
|
|
then begin
|
|
ALeft :=2;
|
|
ATop :=middleY-(rGlyph.Glyph.Height div 2);
|
|
end
|
|
else begin
|
|
ALeft :=AWidth-rGlyph.Glyph.Width;
|
|
ATop :=middleY-(rGlyph.Glyph.Height div 2);
|
|
end;
|
|
end;
|
|
akLeft :begin
|
|
if (rGlyphLayout = glLeft)
|
|
then begin //Really on Bottom of paintRect
|
|
ALeft :=middleX-(rGlyph.Glyph.Width div 2);
|
|
ATop :=AHeight-rGlyph.Glyph.Height;
|
|
end
|
|
else begin //Really on Top of paintRect
|
|
ALeft :=middleX-(rGlyph.Glyph.Width div 2);
|
|
ATop :=2;
|
|
end;
|
|
end;
|
|
akRight :begin
|
|
if (rGlyphLayout = glLeft)
|
|
then begin //Really on Top of paintRect
|
|
ALeft :=middleX-(rGlyph.Glyph.Width div 2);
|
|
ATop :=2;
|
|
end
|
|
else begin //Really on Bottom of paintRect
|
|
ALeft :=middleX-(rGlyph.Glyph.Width div 2);
|
|
ATop :=AHeight-rGlyph.Glyph.Height;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
rGlyph.Draw(Canvas, paintRect, point(ALeft, ATop), FState, true, 0);
|
|
end;
|
|
|
|
procedure drawBtn(const ABorderStyle : TGraphicsBevelCut);
|
|
var
|
|
xTabWidth,
|
|
tY, tX: Integer;
|
|
|
|
begin
|
|
Case rStyle of
|
|
bbsButton: Frame3d_Rounded(Canvas, paintRect, 1, 5, 5, ABorderStyle, xSColor, xHColor, xColor);
|
|
bbsTab: begin
|
|
fRect :=paintRect;
|
|
|
|
Case FButtonPosition of
|
|
akTop : begin
|
|
//If rTabWidth is Negative Calculate the Tab Width
|
|
if (rTabWidth < 0)
|
|
then xTabWidth :=(fRect.Right-fRect.Left)*-rTabWidth div 100
|
|
else xTabWidth :=rTabWidth;
|
|
|
|
inc(paintRect.Left, middleX-(xTabWidth div 2));
|
|
paintRect.Right:=paintRect.Left+xTabWidth;
|
|
Frame3d_Rounded(Canvas, paintRect, 1, 5, 5, ABorderStyle, xSColor, xHColor, xColor);
|
|
|
|
tY :=fRect.Bottom-2;
|
|
Canvas.Pen.Style:=psSolid;
|
|
Canvas.Pen.Width:=1;
|
|
Canvas.Pen.Color :=xHColor;
|
|
if Rounded
|
|
then Canvas.MoveTo(2, tY)
|
|
else Canvas.MoveTo(0, tY);
|
|
Canvas.LineTo(paintRect.Left-3, tY);
|
|
Canvas.LineTo(paintRect.Left, tY-3);
|
|
|
|
if Rounded
|
|
then Canvas.MoveTo(fRect.Right-4, tY)
|
|
else Canvas.MoveTo(fRect.Right, tY);
|
|
Canvas.LineTo(paintRect.Right+2, tY);
|
|
Canvas.LineTo(paintRect.Right-1, tY-3);
|
|
|
|
Canvas.Pen.Color :=xColor;
|
|
Canvas.MoveTo(paintRect.Left-2, tY);
|
|
Canvas.LineTo(paintRect.Right+2, tY);
|
|
dec(tY);
|
|
Canvas.MoveTo(paintRect.Left-1, tY);
|
|
Canvas.LineTo(paintRect.Right+1, tY);
|
|
|
|
tY :=fRect.Bottom-1;
|
|
if FCollapsed then Canvas.Pen.Color :=xSColor;
|
|
if Rounded
|
|
then begin
|
|
Canvas.MoveTo(fRect.Left+2, tY);
|
|
Canvas.LineTo(fRect.Right-3, tY);
|
|
end
|
|
else begin
|
|
Canvas.MoveTo(fRect.Left, tY);
|
|
Canvas.LineTo(fRect.Right, tY);
|
|
end;
|
|
end;
|
|
akBottom : begin
|
|
if (rTabWidth < 0)
|
|
then xTabWidth :=(fRect.Right-fRect.Left)*-rTabWidth div 100
|
|
else xTabWidth :=rTabWidth;
|
|
|
|
inc(paintRect.Left, middleX-(xTabWidth div 2));
|
|
paintRect.Right:=paintRect.Left+xTabWidth;
|
|
dec(paintRect.Top);
|
|
Frame3d_Rounded(Canvas, paintRect, 1, 5, 5, ABorderStyle, xSColor, xHColor, xColor);
|
|
|
|
Canvas.Pen.Style:=psSolid;
|
|
Canvas.Pen.Width:=1;
|
|
Canvas.Pen.Color :=xHColor;
|
|
if Rounded
|
|
then Canvas.MoveTo(2, 1)
|
|
else Canvas.MoveTo(0, 1);
|
|
Canvas.LineTo(paintRect.Left-3, 1);
|
|
Canvas.LineTo(paintRect.Left, 4);
|
|
|
|
if Rounded
|
|
then Canvas.MoveTo(fRect.Right-4, 1)
|
|
else Canvas.MoveTo(fRect.Right, 1);
|
|
Canvas.LineTo(paintRect.Right+2, 1);
|
|
Canvas.LineTo(paintRect.Right-1, 4);
|
|
|
|
Canvas.Pen.Color :=xColor;
|
|
Canvas.MoveTo(paintRect.Left-2, 1);
|
|
Canvas.LineTo(paintRect.Right+2, 1);
|
|
Canvas.MoveTo(paintRect.Left-1, 2);
|
|
Canvas.LineTo(paintRect.Right+1, 2);
|
|
|
|
if FCollapsed then Canvas.Pen.Color :=xSColor;
|
|
if Rounded
|
|
then begin
|
|
Canvas.MoveTo(fRect.Left+2, 0);
|
|
Canvas.LineTo(fRect.Right-3, 0);
|
|
end
|
|
else begin
|
|
Canvas.MoveTo(fRect.Left, 0);
|
|
Canvas.LineTo(fRect.Right, 0);
|
|
end;
|
|
end;
|
|
akLeft : begin
|
|
if (rTabWidth < 0)
|
|
then xTabWidth :=(fRect.Bottom-fRect.Top)*-rTabWidth div 100
|
|
else xTabWidth :=rTabWidth;
|
|
|
|
inc(paintRect.Top, middleY-(xTabWidth div 2));
|
|
paintRect.Bottom:=paintRect.Top+xTabWidth;
|
|
Frame3d_Rounded(Canvas, paintRect, 1, 5, 5, ABorderStyle, xSColor, xHColor, xColor);
|
|
|
|
tX :=fRect.Right-2;
|
|
Canvas.Pen.Style:=psSolid;
|
|
Canvas.Pen.Width:=1;
|
|
Canvas.Pen.Color :=xHColor;
|
|
|
|
if Rounded
|
|
then Canvas.MoveTo(tX, 2)
|
|
else Canvas.MoveTo(tX, 0);
|
|
Canvas.LineTo(tX, paintRect.Top-3);
|
|
Canvas.LineTo(tX-3, paintRect.Top);
|
|
|
|
if Rounded
|
|
then Canvas.MoveTo(tX, fRect.Bottom-4)
|
|
else Canvas.MoveTo(tX, fRect.Bottom);
|
|
Canvas.LineTo(tX, paintRect.Bottom+2);
|
|
Canvas.LineTo(tX-3, paintRect.Bottom-1);
|
|
|
|
Canvas.Pen.Color :=xColor;
|
|
Canvas.MoveTo(tX, paintRect.Top-2);
|
|
Canvas.LineTo(tX, paintRect.Bottom+2);
|
|
dec(tX);
|
|
Canvas.MoveTo(tX, paintRect.Top-1);
|
|
Canvas.LineTo(tX, paintRect.Bottom+1);
|
|
|
|
tX :=fRect.Right-1;
|
|
if FCollapsed then Canvas.Pen.Color :=xSColor;
|
|
if Rounded
|
|
then begin
|
|
Canvas.MoveTo(tX, fRect.Top+2);
|
|
Canvas.LineTo(tX, fRect.Bottom-3);
|
|
end
|
|
else begin
|
|
Canvas.MoveTo(tX, fRect.Top);
|
|
Canvas.LineTo(tX, fRect.Bottom);
|
|
end;
|
|
end;
|
|
akRight : begin
|
|
if (rTabWidth < 0)
|
|
then xTabWidth :=(fRect.Bottom-fRect.Top)*-rTabWidth div 100
|
|
else xTabWidth :=rTabWidth;
|
|
|
|
inc(paintRect.Top, middleY-(xTabWidth div 2));
|
|
paintRect.Bottom:=paintRect.Top+xTabWidth;
|
|
dec(paintRect.Left);
|
|
Frame3d_Rounded(Canvas, paintRect, 1, 5, 5, ABorderStyle, xSColor, xHColor, xColor);
|
|
|
|
Canvas.Pen.Style:=psSolid;
|
|
Canvas.Pen.Width:=1;
|
|
Canvas.Pen.Color :=xHColor;
|
|
if Rounded
|
|
then Canvas.MoveTo(1, 2)
|
|
else Canvas.MoveTo(1, 0);
|
|
Canvas.LineTo(1, paintRect.Top-3);
|
|
Canvas.LineTo(4, paintRect.Top);
|
|
|
|
if Rounded
|
|
then Canvas.MoveTo(1, fRect.Bottom-4)
|
|
else Canvas.MoveTo(1, fRect.Bottom);
|
|
Canvas.LineTo(1, paintRect.Bottom+2);
|
|
Canvas.LineTo(4, paintRect.Bottom-1);
|
|
|
|
Canvas.Pen.Color :=xColor;
|
|
Canvas.MoveTo(1, paintRect.Top-2);
|
|
Canvas.LineTo(1, paintRect.Bottom+2);
|
|
Canvas.MoveTo(2, paintRect.Top-1);
|
|
Canvas.LineTo(2, paintRect.Bottom+1);
|
|
|
|
if FCollapsed then Canvas.Pen.Color :=xSColor;
|
|
if Rounded
|
|
then begin
|
|
Canvas.MoveTo(0, fRect.Top+2);
|
|
Canvas.LineTo(0, fRect.Bottom-3);
|
|
end
|
|
else begin
|
|
Canvas.MoveTo(0, fRect.Top);
|
|
Canvas.LineTo(0, fRect.Bottom);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure drawText;
|
|
Var
|
|
DTop, DLeft,
|
|
AWidth, AHeight,
|
|
txtH :Integer;
|
|
|
|
procedure CalcCuttedCaption(MaxWidth :Integer);
|
|
Var
|
|
txtMaxChars :Integer;
|
|
|
|
begin
|
|
txtWidth :=0;
|
|
if (MaxWidth < Canvas.TextWidth('...'))
|
|
then xCaption :=''
|
|
else begin
|
|
txtMaxChars :=Canvas.TextFitInfo(xCaption, MaxWidth);
|
|
txtWidth :=Canvas.TextWidth(xCaption);
|
|
while (txtWidth > MaxWidth) do
|
|
begin
|
|
dec(txtMaxChars, 3); //-1 Chars fit better, -3 Chars for more speed
|
|
xCaption :=Copy(xCaption, 0, txtMaxChars)+'...';
|
|
txtWidth :=Canvas.TextWidth(xCaption);
|
|
end;
|
|
end;
|
|
(* Original Code, Test Speed
|
|
if (txtW > AWidth)
|
|
then begin
|
|
txtMaxChars :=Canvas.TextFitInfo(xCaption, AWidth);
|
|
xCaption :=Copy(xCaption, 0, txtMaxChars-3)+'...';
|
|
txtW :=Canvas.TextWidth(xCaption);
|
|
if (txtW > AWidth)
|
|
then xCaption :='';
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
begin
|
|
txtH :=Canvas.TextHeight(xCaption);
|
|
AWidth :=paintRect.Right-paintRect.Left-2;
|
|
AHeight :=paintRect.Bottom-paintRect.Top-2;
|
|
|
|
Case FButtonPosition of
|
|
akTop,
|
|
akBottom : begin
|
|
Canvas.Font.Orientation := 0;
|
|
|
|
txtTop :=middleY-(txtH div 2);
|
|
|
|
if (rGlyphLayout <> glNone) then
|
|
begin
|
|
if (rTextLayout = tlCenter)
|
|
then dec(AWidth, rGlyph.Glyph.Width*2+4)
|
|
else dec(AWidth, rGlyph.Glyph.Width+2)
|
|
end;
|
|
|
|
CalcCuttedCaption(AWidth);
|
|
|
|
Case rTextLayout of
|
|
tlLeft :begin
|
|
txtLeft :=paintRect.Left+4;
|
|
if (rGlyphLayout = glLeft)
|
|
then inc(txtLeft, rGlyph.Glyph.Width+2);
|
|
end;
|
|
tlRight:begin
|
|
txtLeft :=paintRect.Left+AWidth-txtWidth;
|
|
if (rGlyphLayout = glLeft)
|
|
then inc(txtLeft, rGlyph.Glyph.Width+2);
|
|
end;
|
|
tlCenter:begin
|
|
txtLeft :=middleX-(txtWidth div 2);
|
|
end;
|
|
end;
|
|
|
|
//Disabled Position
|
|
DTop :=txtTop+1;
|
|
DLeft :=txtLeft+1;
|
|
end;
|
|
akLeft : begin
|
|
//Vertically from Bottom to Top
|
|
Canvas.Font.Orientation := 900;
|
|
|
|
txtLeft:=middleX-(txtH div 2);
|
|
|
|
if (rGlyphLayout <> glNone) then
|
|
begin
|
|
if (rTextLayout = tlCenter)
|
|
then dec(AHeight, rGlyph.Glyph.Height*2+4)
|
|
else dec(AHeight, rGlyph.Glyph.Height+2)
|
|
end;
|
|
|
|
//Vertically the Max Width is Height
|
|
CalcCuttedCaption(AHeight);
|
|
|
|
Case rTextLayout of
|
|
tlLeft :begin //To Bottom of the ClientRect
|
|
txtTop :=paintRect.Top+AHeight-2;
|
|
|
|
if (rGlyphLayout = glRight)
|
|
then inc(txtTop, rGlyph.Glyph.Height+2);
|
|
end;
|
|
tlRight:begin //To Top of the ClientRect
|
|
txtTop :=paintRect.Top+txtWidth+2;
|
|
if (rGlyphLayout = glRight)
|
|
then inc(txtTop, rGlyph.Glyph.Height+2);
|
|
end;
|
|
tlCenter:begin
|
|
txtTop :=middleY+(txtWidth div 2);
|
|
end;
|
|
end;
|
|
|
|
//Disabled Position
|
|
DTop :=txtTop-1;
|
|
DLeft :=txtLeft+1;
|
|
end;
|
|
akRight : begin
|
|
//Vertically from Top to Bottom
|
|
Canvas.Font.Orientation := -900;
|
|
|
|
txtLeft:=middleX+(txtH div 2)+1; //+1 because is better centered
|
|
|
|
if (rGlyphLayout <> glNone) then
|
|
begin
|
|
if (rTextLayout = tlCenter)
|
|
then dec(AHeight, rGlyph.Glyph.Height*2+4)
|
|
else dec(AHeight, rGlyph.Glyph.Height+2)
|
|
end;
|
|
|
|
CalcCuttedCaption(AHeight);
|
|
|
|
Case rTextLayout of
|
|
tlLeft :begin //To Top of the ClientRect
|
|
txtTop :=paintRect.Top+4;
|
|
|
|
if (rGlyphLayout = glLeft)
|
|
then inc(txtTop, rGlyph.Glyph.Height+2);
|
|
end;
|
|
tlRight:begin //To Bottom of the ClientRect
|
|
txtTop :=paintRect.Top+AHeight-txtWidth;
|
|
if (rGlyphLayout = glLeft)
|
|
then inc(txtTop, rGlyph.Glyph.Height+2);
|
|
end;
|
|
tlCenter:begin
|
|
txtTop :=middleY-(txtWidth div 2);
|
|
end;
|
|
end;
|
|
|
|
//Disabled Position
|
|
DTop :=txtTop+1;
|
|
DLeft :=txtLeft-1;
|
|
end;
|
|
end;
|
|
|
|
//Re Test here because we may not have space to draw the text, so now can be empty
|
|
if (xCaption <> '') then
|
|
begin
|
|
if (FState = bsDisabled)
|
|
then begin
|
|
Canvas.Font.Color := clBtnHighlight;
|
|
Canvas.TextOut(DLeft, DTop, xCaption);
|
|
Canvas.Font.Color := clBtnShadow;
|
|
end
|
|
else Canvas.Font.Color := Font.Color;
|
|
|
|
Canvas.Brush.Style:=bsClear;
|
|
Canvas.TextOut(txtLeft, txtTop, xCaption);
|
|
end
|
|
else txtWidth:=0;
|
|
end;
|
|
|
|
procedure DrawLines;
|
|
var
|
|
d1, d2, d3, d4, dx :Integer;
|
|
isVertical :Boolean;
|
|
|
|
procedure calc_d(txtL, txtR, glyphL, glyphR :Integer);
|
|
begin
|
|
if (txtWidth > 0)
|
|
then Case rTextLayout of
|
|
tlLeft: begin
|
|
d1 :=txtR;
|
|
if (rGlyphLayout = glRight)
|
|
then d2 :=glyphL;
|
|
end;
|
|
tlCenter:begin
|
|
d2 :=txtL;
|
|
d3 :=txtR;
|
|
if (rGlyphLayout = glLeft)
|
|
then d1 :=glyphR
|
|
else if (rGlyphLayout = glRight)
|
|
then d4 :=glyphL;
|
|
end;
|
|
tlRight:begin
|
|
d2 :=txtL;
|
|
if (rGlyphLayout = glLeft)
|
|
then d1 :=glyphR;
|
|
end;
|
|
end
|
|
else if (rGlyphLayout = glLeft)
|
|
then d1 :=glyphR
|
|
else if (rGlyphLayout = glRight)
|
|
then d2 :=glyphL;
|
|
end;
|
|
|
|
procedure DrawALine(pCenterX, pCenterY :Integer);
|
|
begin
|
|
inc(d2); inc(d4); //LineTo don't paint the last Pixel
|
|
|
|
if isVertical
|
|
then begin
|
|
//Avoid go outside the Box
|
|
pCenterX :=EnsureRange(pCenterX, 0, paintRect.Right-2);
|
|
|
|
Canvas.Pen.Color := {$ifdef DEBUG_PAINT} clLime {$else} xHColor {$endif};
|
|
Canvas.MoveTo(pCenterX, d1);
|
|
Canvas.LineTo(pCenterX, d2);
|
|
if (d3 > -1) then
|
|
begin
|
|
Canvas.MoveTo(pCenterX, d3);
|
|
Canvas.LineTo(pCenterX, d4);
|
|
end;
|
|
Canvas.Pen.Color := {$ifdef DEBUG_PAINT} clGreen {$else} xSColor {$endif};
|
|
Canvas.MoveTo(pCenterX+1, d1+1);
|
|
Canvas.LineTo(pCenterX+1, d2);
|
|
if (d3 > -1) then
|
|
begin
|
|
Canvas.MoveTo(pCenterX+1, d3+1);
|
|
Canvas.LineTo(pCenterX+1, d4);
|
|
end;
|
|
end
|
|
else begin
|
|
pCenterY :=EnsureRange(pCenterY, 0, paintRect.Bottom-2);
|
|
|
|
Canvas.Pen.Color :={$ifdef DEBUG_PAINT} clLime {$else} xHColor {$endif};
|
|
Canvas.MoveTo(d1, pCenterY);
|
|
Canvas.LineTo(d2, pCenterY);
|
|
if (d3 > -1) then
|
|
begin
|
|
Canvas.MoveTo(d3, pCenterY);
|
|
Canvas.LineTo(d4, pCenterY);
|
|
end;
|
|
Canvas.Pen.Color :={$ifdef DEBUG_PAINT} clGreen {$else} xSColor {$endif};
|
|
Canvas.MoveTo(d1+1, pCenterY+1);
|
|
Canvas.LineTo(d2, pCenterY+1);
|
|
if (d3 > -1) then
|
|
begin
|
|
Canvas.MoveTo(d3+1, pCenterY+1);
|
|
Canvas.LineTo(d4, pCenterY+1);
|
|
end;
|
|
end;
|
|
|
|
dec(d2); dec(d4); //return to the real Pixels
|
|
end;
|
|
|
|
begin
|
|
d3 :=-1;
|
|
isVertical :=(FButtonPosition in [akLeft, akRight]);
|
|
|
|
//Assign to (d1-d2) Line All the space
|
|
if isVertical
|
|
then begin
|
|
d1 :=paintRect.Top;
|
|
d2 :=paintRect.Bottom-1;
|
|
end
|
|
else begin
|
|
d1 :=paintRect.Left;
|
|
d2 :=paintRect.Right-1;
|
|
end;
|
|
|
|
//Calculate the (d1-d2) (d3-d4) Lines between the Glyph and the Text elements
|
|
if (rStyle in [bbsLine, bbsLineDouble]) then
|
|
begin
|
|
d4 :=d2;
|
|
if isVertical
|
|
then begin
|
|
if (FButtonPosition = akRight)
|
|
then calc_d(txtTop-3, txtTop+txtWidth+2, glyphTop-3, glyphTop+rGlyph.Glyph.Height+2)
|
|
else begin
|
|
//Only in this case (akLeft) the point coordinate is from bottom to top
|
|
d1 :=paintRect.Bottom-1;
|
|
d2 :=paintRect.Top;
|
|
d4 :=d2;
|
|
|
|
calc_d(txtTop+2, txtTop-txtWidth-3, glyphTop+rGlyph.Glyph.Height+2, glyphTop-3);
|
|
|
|
//Exchange the values for Shadow coerence
|
|
dx :=d1; d1 :=d2; d2 :=dx;
|
|
if (d3 > -1) then begin dx :=d3; d3 :=d4; d4 :=dx; end;
|
|
end;
|
|
end
|
|
else calc_d(txtLeft-3, txtLeft+txtWidth+2, glyphLeft-3, glyphLeft+rGlyph.Glyph.Width+2);
|
|
end;
|
|
|
|
//Draw the Lines
|
|
Canvas.Pen.Style:=psSolid;
|
|
Canvas.Pen.Width:=1;
|
|
Case rStyle of
|
|
bbsLine: DrawALine(middleX, middleY);
|
|
bbsLineDouble: begin
|
|
DrawALine(middleX-2, middleY-2);
|
|
DrawALine(middleX+2, middleY+2);
|
|
end;
|
|
bbsLineTop: DrawALine(paintRect.Left, paintRect.Top);
|
|
bbsLineBottom: DrawALine(paintRect.Right-2, paintRect.Bottom-2);
|
|
bbsLineDoubleTop: begin
|
|
DrawALine(paintRect.Left, paintRect.Top);
|
|
DrawALine(paintRect.Left+3, paintRect.Top+3);
|
|
end;
|
|
bbsLineDoubleBottom: begin
|
|
DrawALine(paintRect.Right-5, paintRect.Bottom-5);
|
|
DrawALine(paintRect.Right-2, paintRect.Bottom-2);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
paintRect :=GetClientRect;
|
|
|
|
{$ifdef DEBUG_PAINT}
|
|
Canvas.Brush.Color:=clYellow;
|
|
Canvas.Brush.Style:=bsSolid;
|
|
Canvas.FillRect(paintRect);
|
|
{$endif}
|
|
|
|
middleY :=paintRect.Top+((paintRect.Bottom-paintRect.Top) div 2);
|
|
middleX :=paintRect.Left+((paintRect.Right-paintRect.Left) div 2);
|
|
|
|
FButtonPosition :=TBCExpandPanel(Owner).FButtonPosition;
|
|
FCollapsed :=TBCExpandPanel(Owner).FCollapsed;
|
|
Rounded :=not(FCollapsed) and TBCExpandPanel(Owner).rBevelRounded;
|
|
|
|
if FCollapsed
|
|
then xColor :=Self.Color
|
|
else xColor :=rColorExpanded;
|
|
|
|
xCaption :=Caption;
|
|
|
|
Case FState of
|
|
Buttons.bsHot:begin
|
|
if (rColorHighlight = clDefault)
|
|
then xHColor :=GetHighlightColor(xColor, 120)
|
|
else xHColor :=rColorHighlight;
|
|
|
|
if (rColorShadow = clDefault)
|
|
then xSColor :=GetShadowColor(xColor, 40)
|
|
else xSColor :=rColorShadow;
|
|
|
|
xColor :=GetHighlightColor(xColor, 20);
|
|
drawBtn(bvRaised);
|
|
end;
|
|
Buttons.bsDown:begin
|
|
if (rColorHighlight = clDefault)
|
|
then xHColor :=GetHighlightColor(xColor, 60)
|
|
else xHColor :=rColorHighlight;
|
|
|
|
if (rColorShadow = clDefault)
|
|
then xSColor :=GetShadowColor(xColor, 60)
|
|
else xSColor :=rColorShadow;
|
|
|
|
xColor :=GetHighlightColor(xColor, 20);
|
|
drawBtn(bvLowered);
|
|
end;
|
|
else begin
|
|
if (FState = bsDisabled)
|
|
then xColor :=GrayScale(xColor);
|
|
|
|
if Flat
|
|
then xHColor :=xColor
|
|
else if (rColorHighlight = clDefault)
|
|
then xHColor :=GetHighlightColor(xColor, 60)
|
|
else xHColor :=rColorHighlight;
|
|
|
|
if (rColorShadow = clDefault)
|
|
then xSColor :=GetShadowColor(xColor, 60)
|
|
else xSColor :=rColorShadow;
|
|
|
|
if Flat
|
|
then drawBtn(bvSpace)
|
|
else drawBtn(bvRaised);
|
|
end;
|
|
end;
|
|
|
|
if (rGlyphLayout <> glNone)
|
|
then drawGlyph(glyphTop, glyphLeft)
|
|
else begin
|
|
glyphTop :=0;
|
|
glyphLeft:=0;
|
|
end;
|
|
|
|
if (rTextLayout <> tlNone) and (xCaption <> '')
|
|
then drawText
|
|
else txtWidth:=0;
|
|
|
|
if (rStyle in [bbsLine..bbsLineDoubleBottom])
|
|
then DrawLines;
|
|
end;
|
|
|
|
procedure TBCBoundButton.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
|
|
if not(csDesigning in ComponentState) then
|
|
begin
|
|
//IF Used Outside TBCExpandPanel
|
|
if not(Owner is TBCExpandPanel)
|
|
then BuildGlyphs;
|
|
end;
|
|
end;
|
|
|
|
constructor TBCBoundButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
Color :=clSkyBlue;
|
|
rColorExpanded := RGBToColor(23, 136, 248);
|
|
rColorHighlight :=clDefault;
|
|
rColorShadow :=clDefault;
|
|
rGlyphLayout :=glNone;
|
|
rGlyphKind :=gkArrows;
|
|
rTextLayout :=tlLeft;
|
|
Flat :=False;
|
|
rStyle :=bbsButton;
|
|
rTabWidth :=-50;
|
|
|
|
//Why FGlyph is Private in ancestor?????
|
|
rGlyph := TButtonGlyph.Create;
|
|
rGlyph.IsDesigning := csDesigning in ComponentState;
|
|
rGlyph.ShowMode := gsmAlways;
|
|
|
|
rGlyphExpanded :=TBitmap.Create;
|
|
rGlyphExpanded.Transparent := True;
|
|
rGlyphCollapsed :=TBitmap.Create;
|
|
rGlyphCollapsed.Transparent := True;
|
|
rUserGlyphExpanded :=TBitmap.Create;
|
|
rUserGlyphExpanded.Transparent := True;
|
|
rUserGlyphCollapsed :=TBitmap.Create;
|
|
rUserGlyphCollapsed.Transparent := True;
|
|
|
|
SetSubComponent((Owner is TBCExpandPanel));
|
|
// ControlStyle := ControlStyle + [csNoFocus, csNoDesignSelectable];
|
|
end;
|
|
|
|
destructor TBCBoundButton.Destroy;
|
|
begin
|
|
FreeAndNil(rGlyphExpanded);
|
|
FreeAndNil(rGlyphCollapsed);
|
|
FreeAndNil(rUserGlyphExpanded);
|
|
FreeAndNil(rUserGlyphCollapsed);
|
|
FreeAndNil(rGlyph);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{TBCExpandPanels}
|
|
|
|
constructor TBCExpandPanels.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
PanelArray := TList.Create;
|
|
|
|
FCollapseKind := akTop;
|
|
FButtonPosition := akTop;
|
|
FButtonGlyphKind :=gkArrows;
|
|
FButtonGlyphLayout :=glNone;
|
|
FButtonStyle :=bbsButton;
|
|
FButtonTabWidth :=-50;
|
|
FButtonTextLayout :=tlLeft;
|
|
FArrangeKind := akTop;
|
|
FUseFixedSize := False;
|
|
FUseClientSize := False;
|
|
FFixedSize := 400;
|
|
FAutoCollapseIfTooHigh := False;
|
|
FAbove := 10;
|
|
FOrthogonalAbove := 10;
|
|
FOrthogonalSize := 200;
|
|
end;
|
|
|
|
destructor TBCExpandPanels.Destroy;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for I := PanelArray.Count - 1 downto 0 do
|
|
PanelArray.Delete(i);
|
|
|
|
PanelArray.Free;
|
|
PanelArray := nil;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.AddPanel(rollout: TBCExpandPanel);
|
|
begin
|
|
InsertPanel(PanelArray.Count, rollout);
|
|
end;
|
|
|
|
procedure TBCExpandPanels.InsertPanel(idx: integer; rollout: TBCExpandPanel);
|
|
begin
|
|
if Count <= 0 then
|
|
begin
|
|
FAbove := RelevantAbove(rollout);
|
|
FOrthogonalAbove := RelevantOrthogonalAbove(rollout);
|
|
FOrthogonalSize := RelevantOrthogonalSize(rollout);
|
|
end
|
|
else
|
|
begin
|
|
WriteRelevantAbove(rollout, FAbove);
|
|
WriteRelevantOrthogonalAbove(rollout, FOrthogonalAbove);
|
|
WriteRelevantOrthogonalSize(rollout, FOrthogonalSize);
|
|
end;
|
|
|
|
with rollout do
|
|
begin
|
|
Tag := Idx;
|
|
FButton.Tag := Idx;
|
|
|
|
FButton.OnMouseMove := @RollOut1MouseMove;
|
|
InternalOnAnimate := @RollOutOnAnimate;
|
|
end;
|
|
|
|
|
|
PanelArray.Insert(idx, rollout);
|
|
|
|
if FBehaviour <> EPMultipanel then
|
|
HotTrackSetActivePanel(0); //damit das erste ausgeklappt ist
|
|
|
|
ArrangePanels;
|
|
MakeCorrectButtonClickPointers;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TBCExpandPanels.DeltePanel(aname: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
if TBCExpandPanel(PanelArray[i]).Name = aname then
|
|
begin
|
|
PanelArray.Delete(i);
|
|
Result := True;
|
|
break;
|
|
end;
|
|
ArrangePanels;
|
|
end;
|
|
|
|
|
|
function TBCExpandPanels.DeltePanel(idx: integer): boolean;
|
|
begin
|
|
Result := False;
|
|
if (idx >= 0) and (idx <= PanelArray.Count - 1) then
|
|
begin
|
|
PanelArray.Delete(idx);
|
|
Result := True;
|
|
end;
|
|
ArrangePanels;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.DelteLastPanel;
|
|
begin
|
|
if (PanelArray.Count >= 1) then
|
|
PanelArray.Delete(PanelArray.Count - 1);
|
|
ArrangePanels;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.DelLastPanel;
|
|
begin
|
|
PanelArray.Delete(PanelArray.Count - 1);
|
|
end;
|
|
|
|
|
|
function TBCExpandPanels.RelevantAbove(comp: TControl): integer;
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: Result := comp.Left;
|
|
akTop: Result := comp.Top;
|
|
end;
|
|
end;
|
|
|
|
function TBCExpandPanels.RelevantOrthogonalAbove(comp: TControl): integer;
|
|
begin
|
|
case FArrangeKind of
|
|
akTop: Result := comp.Left;
|
|
akLeft: Result := comp.Top;
|
|
end;
|
|
end;
|
|
|
|
function TBCExpandPanels.RelevantSize(comp: TControl): integer;
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: Result := comp.Width;
|
|
akTop: Result := comp.Height;
|
|
end;
|
|
end;
|
|
|
|
function TBCExpandPanels.RelevantOrthogonalSize(comp: TControl): integer;
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: Result := comp.Height;
|
|
akTop: Result := comp.Width;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setButtonGlyphKind(AValue: TGlyphKind);
|
|
var
|
|
i: Integer;
|
|
|
|
begin
|
|
if (FButtonGlyphKind <> AValue) then
|
|
begin
|
|
FButtonGlyphKind:=AValue;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).Button.GlyphKind := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setButtonGlyphLayout(AValue: TGlyphLayout);
|
|
var
|
|
i: Integer;
|
|
|
|
begin
|
|
if (FButtonGlyphLayout <> AValue) then
|
|
begin
|
|
FButtonGlyphLayout:=AValue;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).Button.GlyphLayout := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setButtonStyle(AValue: TBCBoundButtonStyle);
|
|
var
|
|
i: Integer;
|
|
|
|
begin
|
|
if (FButtonStyle <> AValue) then
|
|
begin
|
|
FButtonStyle:=AValue;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).Button.Style := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.SetButtonTabWidth(AValue: Integer);
|
|
var
|
|
i: Integer;
|
|
|
|
begin
|
|
if (FButtonTabWidth <> AValue) then
|
|
begin
|
|
FButtonTabWidth:=AValue;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).Button.TabWidth := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setButtonTextLayout(AValue: TTextLayout);
|
|
var
|
|
i: Integer;
|
|
|
|
begin
|
|
if (FButtonTextLayout <> AValue) then
|
|
begin
|
|
FButtonTextLayout:=AValue;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).Button.TextLayout := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.WriteRelevantAbove(comp: TBCExpandPanel; above: integer);
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: comp.Left := above;
|
|
akTop: comp.Top := above;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.WriteRelevantSize(comp: TBCExpandPanel; size: integer);
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: comp.Width := size;
|
|
akTop: comp.Height := size;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.WriteRelevantOrthogonalSize(comp: TBCExpandPanel; size: integer);
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: comp.Height := size;
|
|
akTop: comp.Width := size;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.WriteRelevantOrthogonalAbove(comp: TBCExpandPanel; size: integer);
|
|
begin
|
|
case FArrangeKind of
|
|
akLeft: comp.Top := size;
|
|
akTop: comp.Left := size;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TBCExpandPanels.setArrangeKind(Value: TAnchorKind);
|
|
begin
|
|
case Value of //that is mean, but I haven't implemented the bottom and right yet....
|
|
akRight: Value := akLeft;
|
|
akBottom: Value := akTop;
|
|
end;
|
|
|
|
if FArrangeKind = Value then
|
|
exit;
|
|
FArrangeKind := Value;
|
|
|
|
ArrangePanels;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setButtonPosition(Value: TAnchorKind);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if FButtonPosition = Value then
|
|
exit;
|
|
FButtonPosition := Value;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).ButtonPosition := Value;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setCollapseKind(Value: TAnchorKind);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if FCollapseKind = Value then
|
|
exit;
|
|
FCollapseKind := Value;
|
|
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
Panel(i).CollapseKind := Value;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setUseClientSize(Value: boolean);
|
|
begin
|
|
FUseClientSize := Value;
|
|
|
|
ArrangePanels;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setUseFixedSize(Value: boolean);
|
|
begin
|
|
if FUseFixedSize = Value then
|
|
exit;
|
|
FUseFixedSize := Value;
|
|
|
|
ArrangePanels;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.setAutoCollapseIfTooHigh(Value: boolean);
|
|
begin
|
|
if FAutoCollapseIfTooHigh = Value then
|
|
exit;
|
|
FAutoCollapseIfTooHigh := Value;
|
|
|
|
if FAutoCollapseIfTooHigh then
|
|
CollapseIfTooHigh;
|
|
end;
|
|
|
|
|
|
procedure TBCExpandPanels.setFixedSize(Value: integer);
|
|
var
|
|
r: real;
|
|
begin
|
|
if FFixedSize = Value then
|
|
exit;
|
|
|
|
r := Value;
|
|
korrigiere(r, 20, 10000);
|
|
FFixedSize := round(r);
|
|
|
|
ArrangePanels;
|
|
end;
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.setOrthogonalAbove(Value: integer);
|
|
begin
|
|
if FOrthogonalAbove = Value then
|
|
exit;
|
|
FOrthogonalAbove := Value;
|
|
|
|
ArrangePanels;
|
|
end;
|
|
|
|
|
|
procedure TBCExpandPanels.setAbove(Value: integer);
|
|
begin
|
|
if FAbove = Value then
|
|
exit;
|
|
FAbove := Value;
|
|
|
|
ArrangePanels;
|
|
end;
|
|
|
|
|
|
procedure TBCExpandPanels.setOrthogonalSize(Value: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
FOrthogonalSize := Value;
|
|
|
|
for I := 0 to PanelArray.Count - 1 do
|
|
WriteRelevantOrthogonalSize(TBCExpandPanel(PanelArray[i]), FOrthogonalSize);
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.setBehaviour(Value: TBCExpandPanelsBehaviour);
|
|
var
|
|
i: integer;
|
|
isAlreadyOneExpand: boolean;
|
|
begin
|
|
isAlreadyOneExpand := False;
|
|
FBehaviour := Value;
|
|
|
|
MakeCorrectButtonClickPointers;
|
|
|
|
// look if more then one is open
|
|
for I := 0 to PanelArray.Count - 1 do
|
|
with TBCExpandPanel(PanelArray[i]) do
|
|
if (Behaviour <> EPMultipanel) and not Collapsed then //leave only the first open, if it is not MultiPanel
|
|
if not isAlreadyOneExpand then
|
|
isAlreadyOneExpand := True
|
|
else
|
|
Collapsed := True;
|
|
end;
|
|
|
|
procedure TBCExpandPanels.MakeCorrectButtonClickPointers;
|
|
var
|
|
i: integer;
|
|
begin
|
|
// set correct pointers
|
|
for I := 0 to PanelArray.Count - 1 do
|
|
with TBCExpandPanel(PanelArray[i]) do
|
|
if FBehaviour <> EPMultipanel then
|
|
EPManagesCollapsing := @RollOutClick
|
|
else
|
|
EPManagesCollapsing := nil;
|
|
end;
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.CollapseIfTooHigh;
|
|
var
|
|
i, h, max: integer;
|
|
tempanimated: boolean;
|
|
begin
|
|
if Count <= 1 then
|
|
exit;
|
|
|
|
|
|
h := RelevantAbove(Panel(0));
|
|
max := RelevantSize(Panel(0).Parent);
|
|
|
|
for i := 0 to Count - 1 do
|
|
if h + RelevantSize(Panel(i)) > max then
|
|
with Panel(i) do
|
|
begin
|
|
tempanimated := Animated;
|
|
Animated := False;
|
|
Collapsed := True;
|
|
Animated := tempanimated;
|
|
|
|
h := h + TBCExpandPanel(Panel(i)).ButtonSize;
|
|
end
|
|
else
|
|
h := h + RelevantSize(Panel(i));
|
|
end;
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.RollOutOnAnimate(Sender: TObject; deltaLeft, deltaTop, deltaWidth, deltaHeight: integer);
|
|
var
|
|
idx, i, size: integer;
|
|
begin
|
|
idx := PanelArray.IndexOf(Sender);
|
|
|
|
for i := idx + 1 to PanelArray.Count - 1 do
|
|
begin
|
|
size := RelevantAbove(TBCExpandPanel(PanelArray[i]));
|
|
case FArrangeKind of
|
|
akTop: size := size + deltaTop + deltaHeight;
|
|
akLeft: size := size + deltaLeft + deltaWidth;
|
|
end;
|
|
|
|
WriteRelevantAbove(TBCExpandPanel(PanelArray[i]), size);
|
|
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
//procedure TBCExpandPanels.SetCorrectSize;
|
|
//const plus=1; //extra Anstand
|
|
//var
|
|
// i, exSize,
|
|
// countexpanded,
|
|
// SumSize, closedSize:Integer;
|
|
//begin
|
|
// if PanelArray.Count<=0 then
|
|
// exit;
|
|
|
|
// SumSize:=FFixedSize;
|
|
// if FUseClientSize then
|
|
// SumSize:=TBCExpandPanel(PanelArray[0]).Parent.Height;
|
|
|
|
|
|
// countexpanded:=0;
|
|
// closedSize:=0;
|
|
// for I := 0 to PanelArray.count-1 do
|
|
// with TBCExpandPanel(PanelArray[i]) do
|
|
// begin
|
|
// if not Collapsed and not Animating //error producer!!! animating does not neccessairily mean that it is expanding
|
|
// or Collapsed and Animating then
|
|
// inc(countexpanded)
|
|
// else
|
|
// closedSize:=closedSize+Height;
|
|
// end;
|
|
|
|
// exSize:=SumSize- FTop- closedSize;
|
|
|
|
// case Behaviour of
|
|
// EPMultipanel:
|
|
// if countexpanded>0 then
|
|
// exSize:=trunc(exSize/countexpanded)
|
|
// else
|
|
// exSize:=400;
|
|
// end;
|
|
|
|
// for I := 0 to PanelArray.count-1 do
|
|
// with TBCExpandPanel(PanelArray[i]) do
|
|
// begin
|
|
// if not FUseFixedSize and not FUseClientSize then
|
|
// ExpandedSize:=200
|
|
// else
|
|
// ExpandedSize:=exSize;
|
|
// end;
|
|
//end;
|
|
|
|
|
|
|
|
{==============================================================================
|
|
Procedure: ArrangePanels
|
|
Belongs to: TBCExpandPanels
|
|
Result: None
|
|
Parameters:
|
|
|
|
Description:
|
|
==============================================================================}
|
|
procedure TBCExpandPanels.ArrangePanels;
|
|
const
|
|
plus = 1; //extra Anstand
|
|
var
|
|
i, t: integer;
|
|
begin
|
|
if Count <= 0 then
|
|
exit;
|
|
|
|
|
|
//left setzen!!!
|
|
// SetCorrectSize;
|
|
|
|
t := FAbove + plus;
|
|
|
|
for I := 0 to PanelArray.Count - 1 do
|
|
begin
|
|
if not TBCExpandPanel(PanelArray[i]).Visible then
|
|
continue;
|
|
|
|
WriteRelevantAbove(TBCExpandPanel(PanelArray[i]), t);
|
|
WriteRelevantOrthogonalAbove(TBCExpandPanel(PanelArray[i]), OrthogonalAbove);
|
|
t := t + plus + self.RelevantSize(TBCExpandPanel(PanelArray[i]));
|
|
end;
|
|
|
|
if FAutoCollapseIfTooHigh then
|
|
CollapseIfTooHigh;
|
|
|
|
if Assigned(FOnArrangePanels) then
|
|
FOnArrangePanels(Self);
|
|
end;
|
|
|
|
|
|
|
|
function TBCExpandPanels.Count: integer;
|
|
begin
|
|
Result := PanelArray.Count;
|
|
end;
|
|
|
|
function TBCExpandPanels.Panel(idx: integer): TBCExpandPanel;
|
|
begin
|
|
if idx < Count then
|
|
Result := TBCExpandPanel(PanelArray.Items[idx])
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{==============================================================================
|
|
Procedure: RollOutClick
|
|
Belongs to: TBCExpandPanels
|
|
Result: None
|
|
Parameters:
|
|
Sender : TObject =
|
|
|
|
Description:
|
|
==============================================================================}
|
|
procedure TBCExpandPanels.RollOutClick(Sender: TObject);
|
|
begin
|
|
if (Behaviour <> EPMultipanel) then
|
|
HotTrackSetActivePanel(TBCBoundButton(Sender).Tag);
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.HotTrackSetActivePanel(Value: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for I := PanelArray.Count - 1 downto 0 do
|
|
TBCExpandPanel(PanelArray[i]).Collapsed := Value <> i;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TBCExpandPanels.RollOut1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
if (Behaviour = EPHotMouse) and (TBCExpandPanel(PanelArray[TBCBoundButton(Sender).Tag]).Collapsed) then
|
|
HotTrackSetActivePanel(TBCBoundButton(Sender).Tag);
|
|
end;
|
|
|
|
|
|
function TBCExpandPanels.IdxOfPanel(aname: string): integer;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := -1; // is not here
|
|
for i := 0 to PanelArray.Count - 1 do
|
|
if TBCExpandPanel(PanelArray[i]).Name = aname then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{ TBCExpandPanel }
|
|
|
|
|
|
procedure TBCExpandPanel.setCollapsed(Value: boolean);
|
|
begin
|
|
{$ifopt D+}
|
|
debugln('TBCExpandPanel.setCollapsed '+BoolToStr(Collapsed, True));
|
|
{$endif}
|
|
|
|
if FCollapsed = Value then
|
|
exit;
|
|
|
|
FCollapsed := Value;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then if Value
|
|
then DoCollapse
|
|
else DoExpand;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetRelevantSize(comp: TControl; AKind: TAnchorKind; ASize: Integer);
|
|
begin
|
|
case AKind of
|
|
akTop, akBottom: comp.Height :=ASize;
|
|
akLeft, akRight: comp.Width :=ASize;
|
|
end;
|
|
end;
|
|
|
|
function TBCExpandPanel.RelevantSize(comp: TControl; akind: TAnchorKind): integer;
|
|
begin
|
|
case akind of
|
|
akTop, akBottom: Result := comp.Height;
|
|
akLeft, akRight: Result := comp.Width;
|
|
end;
|
|
end;
|
|
|
|
function TBCExpandPanel.RelevantOrthogonalSize(comp: TControl; akind: TAnchorKind): integer;
|
|
begin
|
|
case akind of
|
|
akTop, akBottom: Result := comp.Width;
|
|
akLeft, akRight: Result := comp.Height;
|
|
end;
|
|
end;
|
|
|
|
function TBCExpandPanel.DeltaCoordinates(deltaMove, deltaSize: integer): TRect;
|
|
begin
|
|
Result := Rect(0, 0, 0, 0);
|
|
|
|
case FCollapseKind of
|
|
akTop: Result := Rect(0, 0, 0, deltaSize);
|
|
akLeft: Result := Rect(0, 0, deltaSize, 0);
|
|
akBottom: Result := Rect(0, deltaMove, 0, deltaSize);
|
|
akRight: Result := Rect(deltaMove, 0, deltaSize, 0);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TBCExpandPanel.TimerAnimateSize(Sender: TObject);
|
|
var
|
|
step: real;
|
|
originalsize, size: integer;
|
|
deltaMove, deltaSize: integer;
|
|
delta: TRect;
|
|
vorzeichen: integer;
|
|
begin
|
|
deltaMove := 0;
|
|
deltaSize := 0;
|
|
StopCircleActions := False;
|
|
FAnimating := True;
|
|
step := FAnimationSpeed;
|
|
|
|
|
|
Size := RelevantSize(Self, FCollapseKind);
|
|
|
|
vorzeichen := Sign(TargetAnimationSize - RelevantSize(self, FCollapseKind)); // muss ich delta addieren oder muss ich delta abziehen
|
|
originalsize := ExpandedSize;
|
|
|
|
|
|
//One huge step if not animated
|
|
if not FAnimated or not (ComponentState * [csLoading, csDesigning] = []) then
|
|
step := abs(Size - TargetAnimationSize);
|
|
|
|
//small steps if animated
|
|
if FAnimated and (ComponentState * [csLoading, csDesigning] = []) then
|
|
begin
|
|
step := step * originalsize / 200;
|
|
if step < 3 then
|
|
step := 3;
|
|
end;
|
|
|
|
|
|
//now actually do something
|
|
|
|
if Abs(Size - TargetAnimationSize) > 0 then
|
|
begin
|
|
if Abs(Size - TargetAnimationSize) < abs(step) then // if there is just a little bit left to go, set delta so it can go directly to the end size
|
|
deltaSize := TargetAnimationSize - Size
|
|
else
|
|
deltaSize := vorzeichen * round(step);
|
|
|
|
if (CollapseKind = akBottom) or (CollapseKind = akRight) then
|
|
deltaMove := -deltaSize;
|
|
|
|
|
|
delta := DeltaCoordinates(deltaMove, deltaSize);
|
|
|
|
SetBounds(Left + delta.Left, Top + delta.Top, Width + delta.Right, Height + delta.Bottom);
|
|
|
|
if assigned(FInternalOnAnimate) then
|
|
FInternalOnAnimate(self, delta.Left, delta.Top, delta.Right, delta.Bottom);
|
|
if assigned(FOnAnimate) then
|
|
FOnAnimate(self, delta.Left, delta.Top, delta.Right, delta.Bottom);
|
|
end;
|
|
|
|
|
|
if Abs(Size - TargetAnimationSize) = 0 then //it's finished ( executes it NEXT time the timer activates!)
|
|
begin
|
|
Timer.Enabled := False;
|
|
|
|
FAnimating := False;
|
|
|
|
StopCircleActions := False;
|
|
|
|
if assigned(EndProcedureOfAnimation) then
|
|
EndProcedureOfAnimation;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TBCExpandPanel.EndTimerCollapse;
|
|
begin
|
|
if assigned(OnCollapse) then
|
|
OnCollapse(self);
|
|
|
|
UpdateAll;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.EndTimerExpand;
|
|
begin
|
|
if assigned(OnExpand) then
|
|
OnExpand(self);
|
|
|
|
UpdateAll;
|
|
end;
|
|
|
|
|
|
|
|
procedure TBCExpandPanel.UpdateAll;
|
|
begin
|
|
Update;
|
|
//FButton.Update;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TBCExpandPanel.setExpandedSize(Value: integer);
|
|
begin
|
|
{$ifopt D+}
|
|
debugln('TBCExpandPanel.setExpandedSize');
|
|
debugln(IntToStr(Value));
|
|
{$endif}
|
|
|
|
if (FExpandedSize = Value) then
|
|
exit;
|
|
|
|
FExpandedSize := Value;
|
|
|
|
if not(csLoading in ComponentState) and not(FCollapsed)
|
|
then Animate(FExpandedSize);
|
|
end;
|
|
|
|
function TBCExpandPanel.GetEnabled: Boolean;
|
|
begin
|
|
Result :=inherited Enabled;
|
|
if (FButton.Enabled <> Result) //Paranoic Think
|
|
then FButton.Enabled :=Result;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetBevelColorHighlight(AValue: TColor);
|
|
begin
|
|
if (rBevelColorHighlight <> AValue) then
|
|
begin
|
|
rBevelColorHighlight := AValue;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetBevelColorShadow(AValue: TColor);
|
|
begin
|
|
if (rBevelColorShadow <> AValue) then
|
|
begin
|
|
rBevelColorShadow := AValue;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetBevelRounded(AValue: Boolean);
|
|
begin
|
|
if (rBevelRounded <> AValue) then
|
|
begin
|
|
rBevelRounded := AValue;
|
|
|
|
if not(csLoading in ComponentState)
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetEnabled(AValue: Boolean);
|
|
begin
|
|
inherited Enabled :=AValue;
|
|
FButton.Enabled :=AValue;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.setButtonSize(Value: integer);
|
|
begin
|
|
if FButtonSize = Value then
|
|
exit;
|
|
|
|
FButtonSize := Value;
|
|
|
|
PositionButton;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
|
|
begin
|
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
|
|
|
if not Collapsed and not Animating and (ComponentState * [csLoading] = []) then
|
|
FExpandedSize := RelevantSize(self, FCollapseKind);
|
|
end;
|
|
|
|
|
|
procedure TBCExpandPanel.setButtonPosition(Value: TAnchorKind);
|
|
var
|
|
wasanimated, wascollpased: boolean;
|
|
begin
|
|
if FButtonPosition = Value then
|
|
exit;
|
|
|
|
wasanimated := Animated;
|
|
wascollpased := Collapsed;
|
|
Animated := False;
|
|
if Collapsed then
|
|
Collapsed := False;
|
|
|
|
FButtonPosition := Value;
|
|
PositionButton;
|
|
|
|
Collapsed := wascollpased;
|
|
Animated := wasanimated;
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
|
|
procedure TBCExpandPanel.setCollapseKind(Value: TAnchorKind);
|
|
var
|
|
wasanimated, wascollpased: boolean;
|
|
begin
|
|
if FCollapseKind = Value then
|
|
exit;
|
|
|
|
wasanimated := Animated;
|
|
wascollpased := Collapsed;
|
|
Animated := False;
|
|
|
|
if Collapsed then
|
|
Collapsed := False;
|
|
|
|
FCollapseKind := Value;
|
|
|
|
|
|
//switsch sizes
|
|
|
|
case FCollapseKind of
|
|
akLeft, akRight: FExpandedSize := Width;
|
|
akTop, akBottom: FExpandedSize := Height;
|
|
end;
|
|
|
|
if not(csLoading in ComponentState) then
|
|
begin
|
|
FButton.BuildGlyphs;
|
|
FButton.Invalidate;
|
|
end;
|
|
|
|
Collapsed := wascollpased;
|
|
|
|
Animated := wasanimated;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.setAnimationSpeed(Value: real);
|
|
begin
|
|
korrigiere(Value, 3, 1000);
|
|
FAnimationSpeed := Value;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.PositionButton;
|
|
|
|
function ButtonRect: TRect;
|
|
begin
|
|
case FButtonPosition of
|
|
akBottom, akTop: Result := Rect(0, 0, RelevantOrthogonalSize(self, FButtonPosition), FButtonSize);
|
|
akLeft, akRight: Result := Rect(0, 0, FButtonSize, RelevantOrthogonalSize(self, FButtonPosition));
|
|
end;
|
|
|
|
//this must come after the thing above!!!
|
|
// this moves the button to the bottom, or the right
|
|
case FButtonPosition of
|
|
akBottom: Result.Top := Result.Top + RelevantSize(self, FButtonPosition) - FButtonSize;
|
|
akRight: Result.Left := Result.Left + RelevantSize(self, FButtonPosition) - FButtonSize;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
new: TRect;
|
|
begin
|
|
if StopCircleActions or not(Assigned(FButton)) or (csLoading in ComponentState)
|
|
then exit;
|
|
StopCircleActions := True;
|
|
|
|
|
|
new := ButtonRect;
|
|
FButton.SetBounds(new.Left, new.Top, new.Right, new.Bottom);
|
|
|
|
|
|
//set anchors
|
|
case FButtonPosition of
|
|
akBottom: FButton.Anchors := [akTop, akLeft, akBottom, akRight] - [akTop];
|
|
akLeft: FButton.Anchors := [akTop, akLeft, akBottom, akRight] - [akRight];
|
|
akTop: FButton.Anchors := [akTop, akLeft, akBottom, akRight] - [akBottom];
|
|
akRight: FButton.Anchors := [akTop, akLeft, akBottom, akRight] - [akLeft];
|
|
end;
|
|
|
|
Invalidate;
|
|
|
|
StopCircleActions := False;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.ButtonClick(Sender: TObject);
|
|
begin
|
|
if Assigned(FEPManagesCollapsing) then
|
|
FEPManagesCollapsing(self)
|
|
else
|
|
Collapsed := not Collapsed;
|
|
|
|
if Assigned(OnButtonClick) then
|
|
OnButtonClick(self);
|
|
end;
|
|
|
|
procedure TBCExpandPanel.Animate(aTargetSize: integer);
|
|
var
|
|
storAnimated: boolean;
|
|
begin
|
|
if (FAnimating) then
|
|
begin
|
|
// FinishLastAnimationFast
|
|
storAnimated := FAnimated;
|
|
FAnimated := False;
|
|
TimerAnimateSize(self);
|
|
FAnimated := storAnimated;
|
|
end;
|
|
|
|
// Now do animation
|
|
TargetAnimationSize := aTargetSize;
|
|
|
|
if (ComponentState * [csLoading, csDesigning] = []) and FAnimated then
|
|
begin
|
|
Timer.Enabled := True;
|
|
Timer.OnTimer := @TimerAnimateSize;
|
|
//EndProcedureOfAnimation := nil; //On Collapse then EndTimerCollapse never Executed
|
|
end
|
|
else
|
|
begin
|
|
TimerAnimateSize(self);
|
|
TimerAnimateSize(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.SetTextAlignment(AValue: TAlignment);
|
|
begin
|
|
if FTextAlignment=AValue then Exit;
|
|
FTextAlignment:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.DoCollapse;
|
|
var
|
|
i :Integer;
|
|
curControl: TControl;
|
|
|
|
begin
|
|
(* may work but is irrilevant because TSpeedButton is always on Bottom ????why?
|
|
i :=0;
|
|
while (i < ControlCount) do
|
|
begin
|
|
curControl :=Controls[i];
|
|
|
|
if not(curControl is TBCBoundButton) then
|
|
begin
|
|
Self.SetChildZPosition(curControl, 0);
|
|
end;
|
|
|
|
inc(i)
|
|
end;*)
|
|
|
|
if assigned(OnPreCollapse) then
|
|
OnPreCollapse(self);
|
|
|
|
//FButton.Color := FCollapsedButtonColor;
|
|
|
|
EndProcedureOfAnimation := @EndTimerCollapse;
|
|
|
|
|
|
Animate(FButtonSize);
|
|
|
|
{$ifopt D+}
|
|
debugln('TBCExpandPanel.DoCollapse');
|
|
debugln('FButtonSize ' + IntToStr(FButtonSize));
|
|
{$endif}
|
|
|
|
end;
|
|
|
|
procedure TBCExpandPanel.DoExpand;
|
|
begin
|
|
if assigned(OnPreExpand) then
|
|
OnPreExpand(self);
|
|
|
|
// FButton.ControlStyle := FButton.ControlStyle + [csNoFocus, csNoDesignSelectable];
|
|
// FButton.Parent:=self;
|
|
|
|
//FButton.Color := FExpandedButtonColor;
|
|
|
|
EndProcedureOfAnimation := @EndTimerExpand;
|
|
|
|
Animate(FExpandedSize);
|
|
|
|
{$ifopt D+}
|
|
debugln('TBCExpandPanel.DoExpand');
|
|
debugln('FExpandedSize ' + IntToStr(FExpandedSize));
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TBCExpandPanel.AdjustClientRect(var ARect: TRect);
|
|
begin
|
|
inherited AdjustClientRect(ARect);
|
|
|
|
if Assigned(FButton) then
|
|
case ButtonPosition of
|
|
akTop:
|
|
ARect.Top := ARect.Top + fButton.Height;
|
|
akBottom:
|
|
ARect.Bottom := ARect.Bottom - fButton.Height;
|
|
akLeft:
|
|
ARect.Left := ARect.Left + fButton.Width;
|
|
akRight:
|
|
ARect.Right := ARect.Right - fButton.Width;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
|
|
FButton.BuildGlyphs; //Button Loaded is called Before Self.Loaded and cannot Build Glyphs
|
|
|
|
(* if (FCollapsed)
|
|
then SetRelevantSize(Self, FButtonPosition, FButtonSize)
|
|
else SetRelevantSize(Self, FButtonPosition, FExpandedSize); *)
|
|
|
|
PositionButton;
|
|
end;
|
|
|
|
procedure TBCExpandPanel.Paint;
|
|
var
|
|
ARect: TRect;
|
|
TS: TTextStyle;
|
|
|
|
begin
|
|
if not(FCollapsed) then
|
|
begin
|
|
ARect := GetClientRect;
|
|
Case FButtonPosition of
|
|
akTop: inc(ARect.Top, FButtonSize);
|
|
akBottom: dec(ARect.Bottom, FButtonSize);
|
|
akLeft: inc(ARect.Left, FButtonSize);
|
|
akRight: dec(ARect.Right, FButtonSize);
|
|
end;
|
|
|
|
{$ifdef DEBUG_PAINT}
|
|
Canvas.Brush.Color:=clRed;
|
|
Canvas.Brush.Style:=bsSolid;
|
|
Canvas.FillRect(ARect);
|
|
{$endif}
|
|
|
|
// if BevelOuter is set then draw a frame with BevelWidth
|
|
if (BevelOuter <> bvNone)
|
|
then if rBevelRounded
|
|
then Frame3d_Rounded(Self.Canvas, ARect, BevelWidth, 5, 5, BevelOuter,
|
|
rBevelColorShadow, rBevelColorHighlight, Color)
|
|
else Self.Canvas.Frame3d(ARect, BevelWidth, BevelOuter);
|
|
|
|
InflateRect(ARect, -BorderWidth, -BorderWidth);
|
|
|
|
// if BevelInner is set then skip the BorderWidth and draw a frame with BevelWidth
|
|
if (BevelInner <> bvNone)
|
|
then if rBevelRounded
|
|
then Frame3d_Rounded(Self.Canvas, ARect, BevelWidth, 5, 5, BevelInner,
|
|
rBevelColorShadow, rBevelColorHighlight, Color)
|
|
else Self.Canvas.Frame3d(ARect, BevelWidth, BevelInner);
|
|
|
|
if (Self.Caption <> '') then
|
|
begin
|
|
TS := Canvas.TextStyle;
|
|
TS.Alignment := BidiFlipAlignment(Self.TextAlignment, UseRightToLeftAlignment);
|
|
if (BiDiMode <> bdLeftToRight)
|
|
then TS.RightToLeft:= True;
|
|
TS.Layout:= Graphics.tlCenter;
|
|
TS.Opaque:= false;
|
|
TS.Clipping:= false;
|
|
TS.SystemFont:=Canvas.Font.IsDefault;
|
|
if not(Enabled) then
|
|
begin
|
|
Canvas.Font.Color := clBtnHighlight;
|
|
Types.OffsetRect(ARect, 1, 1);
|
|
Self.Canvas.TextRect(ARect, ARect.Left, ARect.Top, Self.Caption, TS);
|
|
Self.Canvas.Font.Color := clBtnShadow;
|
|
Types.OffsetRect(ARect, -1, -1);
|
|
end
|
|
else Self.Canvas.Font.Color := Font.Color;
|
|
|
|
Self.Canvas.TextRect(ARect,ARect.Left,ARect.Top, Self.Caption, TS);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TBCExpandPanel.Create(TheOwner: TComponent);
|
|
begin
|
|
StopCircleActions := True;
|
|
|
|
inherited;
|
|
|
|
FButtonSize := 27;
|
|
FAnimated := True;
|
|
FCollapseKind := akTop;
|
|
FVisibleTotal := True;
|
|
FCollapsed := False;
|
|
FButtonPosition := akTop;
|
|
FCollapsedButtonColor := clSkyBlue;
|
|
FExpandedButtonColor := RGBToColor(23, 136, 248);
|
|
rBevelColorHighlight:=clBtnHighlight;
|
|
rBevelColorShadow:=clBtnShadow;
|
|
rBevelRounded:=True;
|
|
FExpandedSize := 200;
|
|
Height := FExpandedSize;
|
|
Width := 200;
|
|
FAnimationSpeed := 20;
|
|
Caption := '';
|
|
|
|
Timer := TTimer.Create(self);
|
|
Timer.Enabled := False;
|
|
Timer.Name := 'Animationtimer';
|
|
Timer.Interval := 20;
|
|
|
|
FButton := TBCBoundButton.Create(self);
|
|
with FButton do
|
|
begin
|
|
Parent := self;
|
|
Name := 'Button';
|
|
Caption := 'Caption';
|
|
ControlStyle := ControlStyle + [csNoFocus, csNoDesignSelectable];
|
|
FButton.OnClick := @self.ButtonClick;
|
|
end;
|
|
|
|
StopCircleActions := False;
|
|
|
|
//may be only in CreateWnd but the button is greater by some pixels
|
|
PositionButton;
|
|
end;
|
|
|
|
|
|
|
|
destructor TBCExpandPanel.Destroy;
|
|
begin
|
|
timer.Enabled := False;
|
|
|
|
Timer.Free;
|
|
|
|
if (ComponentState * [csLoading, csDesigning] = []) then
|
|
FButton.Free; // bringt einen Fehler in der Designtime wenn ich das hier mache
|
|
|
|
// FButton.Free; // bringt einen Fehler in der Designtime wenn ich das hier mache
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Controls', [TBCExpandPanel, TBCExpandPanels]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
{$i BCExpandPanels.lrs}
|
|
|
|
end.
|