|
|
@@ -0,0 +1,2633 @@
|
|
|
+{
|
|
|
+********************************************************************************
|
|
|
+* BGRAExpandPanels Version 1.0 *
|
|
|
+* *
|
|
|
+* *
|
|
|
+* (c) Massimo Magnano, Alexander Roth *
|
|
|
+* *
|
|
|
+* *
|
|
|
+********************************************************************************
|
|
|
+
|
|
|
+2014-01-31 MaxM: First port from original code
|
|
|
+}
|
|
|
+
|
|
|
+unit BCExpandPanels;
|
|
|
+
|
|
|
+
|
|
|
+{$mode objfpc}{$H+}
|
|
|
+
|
|
|
+// for debugging purposes
|
|
|
+//{$DEFINE DebugInfo}
|
|
|
+//{$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
|
|
|
+{$IFDEF DebugInfo}
|
|
|
+ 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
|
|
|
+ {$IFDEF DebugInfo}
|
|
|
+ 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);
|
|
|
+
|
|
|
+{$IFDEF DebugInfo}
|
|
|
+ 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);
|
|
|
+
|
|
|
+{$IFDEF DebugInfo}
|
|
|
+ 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.
|
Massimo Magnano