{**************************************************** This file is part of the Eye Candy Controls (EC-C) Copyright (C) 2013 Vojtěch Čihák, Czech Republic This library is free software. See the file COPYING.LGPL.txt, included in this distribution, for details about the license. ****************************************************} unit ECSpinCtrls; {$mode objfpc}{$H+} //{$DEFINE DBGSPINS} {don't remove, just comment} interface uses Classes, SysUtils, Controls, StdCtrls, CustomTimer, Math, Graphics, ImgList, ECTypes, LCLIntf, LMessages, {$IFDEF DBGSPINS} LCLProc, {$ENDIF} LCLType, LResources, Themes; type {$PACKENUM 1} TBtnKind = (ebkMin, ebkBigDec, ebkDec, ebkMiddle, ebkDrag, ebkMenu, ebkInc, ebkBigInc, ebkMax); {$PACKENUM 2} TButtonStyle = (ebsSeparated, ebsSplittedBlock, ebsClearBlock); TDragOrientation = (edoVertical, edoHorizontal, edoBoth); TExtraMouseButtons = set of mbRight..high(TMouseButton); TGlyphStyle = (egsArrowsA, egsArrowsB, egsArrowsC, egsComparison, egsMath, egsPlayer); TModifierEnter = (emeNoAction, emeMenuClick, emeMiddleClick); { Alt, Ctrl/Meta or Shift + Enter } TSEOption = ({ Arrows, Home/End & PgUp/PgDn can exceed Max/Min and reach MaxInEdit/MinInEdit } esoArrowKeysExceed, { Editing immediately changes value, it does not wait for EditingDone } esoEditingChangesValue, { Modifiers + Home/End for Max/Min } esoHomeEndAlt, esoHomeEndCtrl, { smart spinning months and years } esoSmartDate, { Modifiers + Space clicks Middle, otherwise it opens Menu } esoSpaceClicksMiddle, { ArrowKeys for spinning } esoUpDownOnly, esoUpDownAlt, esoUpDownCtrl, esoUpDownShift); TSEOptions = set of TSEOption; TValueFormat = (evfRound, evfExponent, evfExponential, evfMantissa, evfHexadecimal, evfMarkHexadec, evfOctal, evfBinary, evfDate, evfTime, evfText, evfCombined); { Event } TOnDrawGlyph = procedure(Sender: TObject; AKind: TBtnKind; AState: TItemState) of object; const cDefActAltEnter = emeNoAction; cDefActCtrlEnter = emeMenuClick; cDefActShiftEnter = emeNoAction; cDefCTDelay = 650; {miliseconds} cDefCTRepeat = 75; {miliseconds} cDefSSBWidth = 15; {pixels} cDefSEOptions = [esoEditingChangesValue, esoHomeEndCtrl, esoSpaceClicksMiddle, esoSmartDate, esoUpDownOnly, esoUpDownAlt, esoUpDownCtrl, esoUpDownShift]; cMouseModifier = [ssCtrl, ssMeta]; type { TCustomECTimer } TCustomECTimer = class(TCustomTimer) private FControl: TComponent; FCounter: Integer; FDelay: Integer; FMaxCount: Integer; FRepeating: Integer; public constructor Create(AOwner: TComponent); override; procedure DoOnTimer; override; procedure SetEnabled(Value: Boolean); override; property Control: TComponent read FControl write FControl; property Counter: Integer read FCounter; property Delay: Integer read FDelay write FDelay default cDefCTDelay; property MaxCount: Integer read FMaxCount write FMaxCount default 0; property Repeating: Integer read FRepeating write FRepeating default cDefCTRepeat; end; { TECTimer } TECTimer = class(TCustomECTimer) published property Counter; property Delay; property Enabled default False; property MaxCount; property Repeating; property OnStartTimer; property OnStopTimer; property OnTimer; end; TCustomSpinBtns = class; TECSpinEdit = class; { TECSpinController } TECSpinController = class(TComponent) private FActionAltEnter: TModifierEnter; FActionCtrlEnter: TModifierEnter; FActionShiftEnter: TModifierEnter; FBtnBigDecWidth: Integer; FBtnBigIncWidth: Integer; FBtnDecWidth: Integer; FBtnDragWidth: Integer; FBtnIncWidth: Integer; FBtnMaxWidth: Integer; FBtnMenuWidth: Integer; FBtnMiddleWidth: Integer; FBtnMinWidth: Integer; FGlyphStyle: TGlyphStyle; FIndent: SmallInt; FOptions: TSEOptions; FReversed: Boolean; FSpacing: SmallInt; FStyle: TButtonStyle; FTimerDelay: Integer; FTimerRepeating: Integer; procedure SetActionAltEnter(AValue: TModifierEnter); procedure SetActionCtrlEnter(AValue: TModifierEnter); procedure SetActionShiftEnter(AValue: TModifierEnter); procedure SetBtnBigDecWidth(AValue: Integer); procedure SetBtnBigIncWidth(AValue: Integer); procedure SetBtnDecWidth(AValue: Integer); procedure SetBtnDragWidth(AValue: Integer); procedure SetBtnIncWidth(AValue: Integer); procedure SetBtnMaxWidth(AValue: Integer); procedure SetBtnMenuWidth(AValue: Integer); procedure SetBtnMiddleWidth(AValue: Integer); procedure SetBtnMinWidth(AValue: Integer); procedure SetGlyphStyle(AValue: TGlyphStyle); procedure SetIndent(AValue: SmallInt); procedure SetOptions(AValue: TSEOptions); procedure SetReversed(AValue: Boolean); procedure SetSpacing(AValue: SmallInt); procedure SetStyle(AValue: TButtonStyle); procedure SetTimerDelay(AValue: Integer); procedure SetTimerRepeating(AValue: Integer); protected ClientList: TFPList; function IsClientButtons(AClient: Pointer; out ABtns: TCustomSpinBtns): Boolean; procedure SetupButtons(AButtons: TCustomSpinBtns); procedure SetupSpinEdit(ASpinEdit: TECSpinEdit); procedure RegisterClient(AClient: TControl); procedure UnRegisterClient(AClient: TControl); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property ActionAltEnter: TModifierEnter read FActionAltEnter write SetActionAltEnter default cDefActAltEnter; property ActionCtrlEnter: TModifierEnter read FActionCtrlEnter write SetActionCtrlEnter default cDefActCtrlEnter; property ActionShiftEnter: TModifierEnter read FActionShiftEnter write SetActionShiftEnter default cDefActShiftEnter; property BtnBigDecWidth: Integer read FBtnBigDecWidth write SetBtnBigDecWidth default cDefSSBWidth; property BtnBigIncWidth: Integer read FBtnBigIncWidth write SetBtnBigIncWidth default cDefSSBWidth; property BtnDecWidth: Integer read FBtnDecWidth write SetBtnDecWidth default cDefSSBWidth; property BtnDragWidth: Integer read FBtnDragWidth write SetBtnDragWidth default cDefSSBWidth; property BtnIncWidth: Integer read FBtnIncWidth write SetBtnIncWidth default cDefSSBWidth; property BtnMaxWidth: Integer read FBtnMaxWidth write SetBtnMaxWidth default cDefSSBWidth; property BtnMenuWidth: Integer read FBtnMenuWidth write SetBtnMenuWidth default cDefSSBWidth; property BtnMiddleWidth: Integer read FBtnMiddleWidth write SetBtnMiddleWidth default cDefSSBWidth; property BtnMinWidth: Integer read FBtnMinWidth write SetBtnMinWidth default cDefSSBWidth; property GlyphStyle: TGlyphStyle read FGlyphStyle write SetGlyphStyle default egsArrowsA; property Indent: SmallInt read FIndent write SetIndent default 0; property Options: TSEOptions read FOptions write SetOptions default cDefSEOptions; property Reversed: Boolean read FReversed write SetReversed default False; property Spacing: SmallInt read FSpacing write SetSpacing default 0; property Style: TButtonStyle read FStyle write SetStyle default ebsSeparated; property TimerDelay: Integer read FTimerDelay write SetTimerDelay default cDefCTDelay; property TimerRepeating: Integer read FTimerRepeating write SetTimerRepeating default cDefCTRepeat; end; { TSingleSpinBtn } TSingleSpinBtn = class(TPersistent) private FBtnOrder: Word; FCaption: string; FGlyphColor: TColor; FImageIndex: SmallInt; FLeft: Integer; FVisible: Boolean; FWidth: SmallInt; procedure SetBtnOrder(AValue: Word); procedure SetCaption(AValue: string); procedure SetGlyphColor(AValue: TColor); procedure SetImageIndex(AValue: SmallInt); procedure SetVisible(AValue: Boolean); procedure SetWidth(AValue: SmallInt); protected Click: TObjectMethod; FEnabled: Boolean; FKind: TBtnKind; Parent: TCustomSpinBtns; procedure CreateBitmaps; procedure FreeBitmaps; procedure Resize; public BtnBitmaps: array[low(TItemState)..eisPushed] of TBitmap; constructor Create(AParent: TCustomSpinBtns); destructor Destroy; override; property Enabled: Boolean read FEnabled; property Kind: TBtnKind read FKind; published property BtnOrder: Word read FBtnOrder write SetBtnOrder; property Caption: string read FCaption write SetCaption; property GlyphColor: TColor read FGlyphColor write SetGlyphColor default clDefault; property ImageIndex: SmallInt read FImageIndex write SetImageIndex default -1; property Left: Integer read FLeft; property Visible: Boolean read FVisible write SetVisible default True; property Width: SmallInt read FWidth write SetWidth default cDefSSBWidth; end; { TCustomSpinBtns } TCustomSpinBtns = class(TCustomControl) private FBackgroundColor: TColor; FDiscreteChange: Double; FDragControl: TExtraMouseButtons; FDragOrientation: TDragOrientation; FGlyphStyle: TGlyphStyle; FImages: TCustomImageList; FIncrement: Double; FMax: Double; FMenuControl: TExtraMouseButtons; FMiddle: Double; FMin: Double; FMode: TIncrementalMode; FMouseFromMiddle: Boolean; FMouseIncrementX: Double; FMouseIncrementY: Double; FMouseStepPixelsX: Word; FMouseStepPixelsY: Word; FOnChange: TNotifyEvent; FOnDrawGlyph: TOnDrawGlyph; FOnMenuClick: TNotifyEvent; FPageSize: Double; FReversed: Boolean; FSpacing: SmallInt; FStyle: TButtonStyle; FTimerDelay: Integer; FTimerRepeating: Integer; FValue: Double; procedure SetBackgroundColor(AValue: TColor); procedure SetDiscreteChange(AValue: Double); procedure SetDragOrientation(AValue: TDragOrientation); procedure SetGlyphStyle(AValue: TGlyphStyle); procedure SetImages(AValue: TCustomImageList); procedure SetMax(AValue: Double); virtual; procedure SetMiddle(AValue: Double); procedure SetMin(AValue: Double); virtual; procedure SetMode(AValue: TIncrementalMode); procedure SetMouseStepPixelsX(AValue: Word); procedure SetMouseStepPixelsY(AValue: Word); procedure SetReversed(AValue: Boolean); procedure SetSpacing(AValue: SmallInt); procedure SetStyle(AValue: TButtonStyle); procedure SetTimerDelay(AValue: Integer); procedure SetTimerRepeating(AValue: Integer); protected class var ControlTimer: TCustomECTimer; class constructor CreateTimer; class destructor DestroyTimer; protected BtnPositions: array of Integer; CursorSwap: TCursor; FController: TECSpinController; InitValue: Double; { initial Value for BtnDrag click & drag } InitX: Integer; { initial X coord for BtnDrag click & drag } InitY: Integer; { initial Y coord for BtnDrag click & drag } NeedCalcHoveredBtnInPaint: Boolean; PrevCTRLDown: Boolean; { wheter CTRL was pressed in previous MouseMove } PrevHeight: Integer; PushedBtn: SmallInt; { ommits invisible } RedrawMode: TRedrawMode; FWidth: Integer; CustomChange: TObjectMethod; CustomMouseUp: TObjectMethod; TimerEvent: TObjectMethod; procedure AdjustWidth; function CalcDiscreteMode(AValue: Double): Double; inline; function CalcHoveredButton(X: Integer): Boolean; procedure CalcInternalGeometry; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMColorChanged(var {%H-}Message: TLMessage); message CM_COLORCHANGED; procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override; procedure DoBtnBigDecClick; virtual; procedure DoBtnBigIncClick; virtual; procedure DoBtnDecClick; virtual; procedure DoBtnIncClick; virtual; procedure DoTimerRepeatingMode(Sender: TObject); procedure DrawButtons; procedure EndMouseDrag; procedure FontChanged(Sender: TObject); override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseLeave; override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; procedure RecalcRedraw; virtual; procedure Resize; override; procedure SetBtnsSorted; procedure SetDecBtnsEnabled(AEnabled: Boolean); procedure SetIncBtnsEnabled(AEnabled: Boolean); procedure SetParent(NewParent: TWinControl); override; procedure SetValue(AValue: Double); procedure SortSpeedBtns(TheKind: TBtnKind; NewValue, OldValue: Word); procedure StopTimer; procedure VisibleChanged; override; property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor; public BtnsSorted: array [0..Byte(high(TBtnKind))] of TSingleSpinBtn; BtnsUnsorted: array [low(TBtnKind)..high(TBtnKind)] of TSingleSpinBtn; HoveredBtn: SmallInt; { ommits invisible } HoveredBtnReal: SmallInt; { includes invisible } UpdateCount: SmallInt; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure BtnBigDecClick; procedure BtnBigIncClick; procedure BtnDecClick; procedure BtnIncClick; procedure BtnMaxClick; procedure BtnMenuClick; procedure BtnMiddleClick; procedure BtnMinClick; procedure EndUpdate; procedure Redraw; property BtnBigDec: TSingleSpinBtn read BtnsUnsorted[ebkBigDec] write BtnsUnsorted[ebkBigDec]; property BtnBigInc: TSingleSpinBtn read BtnsUnsorted[ebkBigInc] write BtnsUnsorted[ebkBigInc]; property BtnDec: TSingleSpinBtn read BtnsUnsorted[ebkDec] write BtnsUnsorted[ebkDec]; property BtnDrag: TSingleSpinBtn read BtnsUnsorted[ebkDrag] write BtnsUnsorted[ebkDrag]; property BtnInc: TSingleSpinBtn read BtnsUnsorted[ebkInc] write BtnsUnsorted[ebkInc]; property BtnMax: TSingleSpinBtn read BtnsUnsorted[ebkMax] write BtnsUnsorted[ebkMax]; property BtnMenu: TSingleSpinBtn read BtnsUnsorted[ebkMenu] write BtnsUnsorted[ebkMenu]; property BtnMiddle: TSingleSpinBtn read BtnsUnsorted[ebkMiddle] write BtnsUnsorted[ebkMiddle]; property BtnMin: TSingleSpinBtn read BtnsUnsorted[ebkMin] write BtnsUnsorted[ebkMin]; property DiscreteChange: Double read FDiscreteChange write SetDiscreteChange; property DragControl: TExtraMouseButtons read FDragControl write FDragControl default []; property DragOrientation: TDragOrientation read FDragOrientation write SetDragOrientation default edoVertical; property GlyphStyle: TGlyphStyle read FGlyphStyle write SetGlyphStyle default egsArrowsA; property Images: TCustomImageList read FImages write SetImages; property Increment: Double read FIncrement write FIncrement; property Max: Double read FMax write SetMax; property MenuControl: TExtraMouseButtons read FMenuControl write FMenuControl default []; property Min: Double read FMin write SetMin; property Middle: Double read FMiddle write SetMiddle; {don't change order, it's intently after Max & Min} property Mode: TIncrementalMode read FMode write SetMode default eimContinuous; property MouseFromMiddle: Boolean read FMouseFromMiddle write FMouseFromMiddle default False; property MouseIncrementX: Double read FMouseIncrementX write FMouseIncrementX; property MouseIncrementY: Double read FMouseIncrementY write FMouseIncrementY; property MouseStepPixelsX: Word read FMouseStepPixelsX write SetMouseStepPixelsX default 1; property MouseStepPixelsY: Word read FMouseStepPixelsY write SetMouseStepPixelsY default 1; property PageSize: Double read FPageSize write FPageSize; property Reversed: Boolean read FReversed write SetReversed default False; property Spacing: SmallInt read FSpacing write SetSpacing default 0; property Style: TButtonStyle read FStyle write SetStyle default ebsSeparated; property TimerDelay: Integer read FTimerDelay write SetTimerDelay default cDefCTDelay; property TimerRepeating: Integer read FTimerRepeating write SetTimerRepeating default cDefCTRepeat; property Value: Double read FValue write SetValue; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnDrawGlyph: TOnDrawGlyph read FOnDrawGlyph write FOnDrawGlyph; property OnMenuClick: TNotifyEvent read FOnMenuClick write FOnMenuClick; end; { TECSpinBtns } TECSpinBtns = class(TCustomSpinBtns) private procedure SetController(AValue: TECSpinController); public destructor Destroy; override; published property Align; property Anchors; property BiDiMode; property BtnBigDec; property BtnBigInc; property BtnDec; property BtnDrag; property BtnInc; property BtnMax; property BtnMenu; property BtnMiddle; property BtnMin; {property Color;} {does nothing ATM} property Controller: TECSpinController read FController write SetController; property DiscreteChange; property DragControl; property DragOrientation; property Enabled; property Font; property GlyphStyle; property Images; property Increment; property Max; property MenuControl; property Min; property Middle; property Mode; property MouseFromMiddle; property MouseIncrementX; property MouseIncrementY; property MouseStepPixelsX; property MouseStepPixelsY; property PageSize; property ParentBiDiMode; {property ParentColor;} {does nothing ATM} property ParentFont; property ParentShowHint; property PopupMenu; property Reversed; property ShowHint; property Spacing; property Style; property TimerDelay; property TimerRepeating; property Value; property Visible; property Width stored False; property OnChange; property OnChangeBounds; property OnClick; property OnContextPopup; property OnDrawGlyph; property OnMenuClick; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnResize; end; { TECSpinBtnsPlus } TECSpinBtnsPlus = class(TCustomSpinBtns) private FMaxInEdit: Double; FMinInEdit: Double; procedure SetMaxInEdit(AValue: Double); procedure SetMax(AValue: Double); override; procedure SetMinInEdit(AValue: Double); procedure SetMin(AValue: Double); override; protected procedure DoBtnBigDecClick; override; procedure DoBtnBigIncClick; override; procedure DoBtnDecClick; override; procedure DoBtnIncClick; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure RecalcRedraw; override; procedure SetValue(AValue: Double; RaiseCustomChange, ExceedLimit: Boolean); public constructor Create(AOwner: TComponent); override; published property AnchorSideLeft stored False; property AnchorSideTop stored False; property AnchorSideRight stored False; property AnchorSideBottom stored False; property BtnBigDec; property BtnBigInc; property BtnDec; property BtnDrag; property BtnInc; property BtnMax; property BtnMenu; property BtnMiddle; property BtnMin; property DiscreteChange; property DragControl; property DragOrientation; property Font; property GlyphStyle; property Height stored False; property Images; property Increment; property Left stored False; property Max; property MenuControl; property Min; property MaxInEdit: Double read FMaxInEdit write SetMaxInEdit; property MinInEdit: Double read FMinInEdit write SetMinInEdit; property Middle; property Mode; property MouseFromMiddle; property MouseIncrementX; property MouseIncrementY; property MouseStepPixelsX; property MouseStepPixelsY; property PageSize; property ParentFont; property ParentShowHint; property PopupMenu; property Reversed; property ShowHint; property Spacing; property Style; property TimerDelay; property TimerRepeating; property Top stored False; property Width stored False; property OnChange; property OnClick; property OnContextPopup; property OnDrawGlyph; property OnMenuClick; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; end; { TECSpinEditSpacing } TECSpinEditSpacing = class(TControlBorderSpacing) public function GetSpace(Kind: TAnchorKind): Integer; //override; procedure GetSpaceAround(var SpaceAround: TRect); //override; end; { TECSpinEdit } TECSpinEdit = class(TCustomEdit) private FActionAltEnter: TModifierEnter; FActionCtrlEnter: TModifierEnter; FActionShiftEnter: TModifierEnter; FDateTimeFormat: string; FDigits: Word; FIndent: SmallInt; FItems: TStrings; FMantissaExp: Double; FOptions: TSEOptions; FSpinBtns: TECSpinBtnsPlus; FValueFormat: TValueFormat; function GetController: TECSpinController; function GetValue: Double; function GetWidthInclBtns: Integer; procedure SetController(AValue: TECSpinController); procedure SetDateTimeFormat(AValue: string); procedure SetDigits(AValue: Word); procedure SetIndent(AValue: SmallInt); procedure SetItems(AValue: TStrings); procedure SetMantissaExp(AValue: Double); procedure SetValue(AValue: Double); procedure SetValueFormat(AValue: TValueFormat); procedure SetWidthInclBtns(AValue: Integer); protected TextEdited: Boolean; procedure Change; override; function ChildClassAllowed(ChildClass: TClass): boolean; override; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; function CreateControlBorderSpacing: TControlBorderSpacing; override; procedure DoOnChangeBounds; override; function GetBigDecreasedValue: Double; function GetBigIncreasedValue: Double; function GetDecreasedValue: Double; function GetIncreasedValue: Double; procedure InitializeWnd; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; procedure RewriteText; procedure SetEnabled(Value: Boolean); override; procedure SetParent(NewParent: TWinControl); override; procedure SetSpinBtnsPosition; procedure VisibleChanged; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure EditingDone; override; procedure EndUpdate; function GetText(AValue: Double; ARound: Integer): string; function GetText: string; procedure GetValueFromString(AString: string); procedure SetRealBoundRect(ARect: TRect); procedure SetRealBounds(ALeft, ATop, AWidth, AHeight: Integer); procedure SwitchOption(AOption: TSEOption; AOn: Boolean); function TryGetValueFromString(AString: string; out AValue: Double): Boolean; published property ActionAltEnter: TModifierEnter read FActionAltEnter write FActionAltEnter default cDefActAltEnter; property ActionCtrlEnter: TModifierEnter read FActionCtrlEnter write FActionCtrlEnter default cDefActCtrlEnter; property ActionShiftEnter: TModifierEnter read FActionShiftEnter write FActionShiftEnter default cDefActShiftEnter; property Align; property Alignment; property Anchors; property AutoSelect; property AutoSize; property BiDiMode; property BorderSpacing; property BorderStyle; property Buttons: TECSpinBtnsPlus read FSpinBtns write FSpinBtns; property Color; property Constraints; property Controller: TECSpinController read GetController write SetController; property DateTimeFormat: string read FDateTimeFormat write SetDateTimeFormat; property Digits: Word read FDigits write SetDigits default 0; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property HideSelection; property Indent: SmallInt read FIndent write SetIndent default 0; property Items: TStrings read FItems write SetItems; property MantissaExp: Double read FMantissaExp write SetMantissaExp; property Options: TSEOptions read FOptions write FOptions default cDefSEOptions; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Value: Double read GetValue write SetValue; property ValueFormat: TValueFormat read FValueFormat write SetValueFormat default evfRound; property Visible; property WidthInclBtns: Integer read GetWidthInclBtns write SetWidthInclBtns stored False; property OnChange; property OnChangeBounds; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEditingDone; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDrag; property OnUTF8KeyPress; end; procedure Register; implementation { TCustomECTimer } constructor TCustomECTimer.Create(AOwner: TComponent); begin inherited Create(AOwner); Enabled := False; FDelay := cDefCTDelay; Interval := cDefCTDelay; FMaxCount := 0; FRepeating := cDefCTRepeat; end; procedure TCustomECTimer.DoOnTimer; var aCounter: Integer; aStartTimer, aStopTimer: TNotifyEvent; begin {$IFDEF DBGSPINS} DebugLn('TControlTimer.DoOnTimer'); {$ENDIF} aCounter := Counter; if aCounter = 0 then begin aStartTimer:=OnStartTimer; aStopTimer:=OnStopTimer; OnStartTimer:=nil; OnStopTimer:=nil; Interval := FRepeating; OnStartTimer:=aStartTimer; OnStopTimer:=aStopTimer; end; inherited DoOnTimer; inc(aCounter); if (MaxCount > 0) and (aCounter >= MaxCount) then Enabled := False else FCounter := aCounter; end; procedure TCustomECTimer.SetEnabled(Value: Boolean); begin {$IFDEF DBGSPINS} DebugLn('TControlTimer.SetEnabled ' + BoolToStr(Value)); {$ENDIF} if Value then begin FCounter := 0; Interval := FDelay; end; inherited SetEnabled(Value); end; { TECSpinController } constructor TECSpinController.Create(AOwner: TComponent); begin inherited Create(AOwner); FActionAltEnter := cDefActAltEnter; FActionCtrlEnter := cDefActCtrlEnter; FActionShiftEnter := cDefActShiftEnter; ClientList := TFPList.Create; FBtnBigDecWidth := cDefSSBWidth; FBtnBigIncWidth := cDefSSBWidth; FBtnDecWidth := cDefSSBWidth; FBtnDragWidth := cDefSSBWidth; FBtnIncWidth := cDefSSBWidth; FBtnMaxWidth := cDefSSBWidth; FBtnMenuWidth := cDefSSBWidth; FBtnMiddleWidth := cDefSSBWidth; FBtnMinWidth := cDefSSBWidth; FGlyphStyle := egsArrowsA; FOptions := cDefSEOptions; FTimerDelay := cDefCTDelay; FTimerRepeating := cDefCTRepeat; end; destructor TECSpinController.Destroy; var i: Integer; begin {$IFDEF DBGSPINS} DebugLn('TECSpinController.Destroy'); {$ENDIF} for i := 0 to ClientList.Count - 1 do if TControl(ClientList[i]) is TCustomSpinBtns then (TControl(ClientList[i]) as TCustomSpinBtns).FController := nil else if TControl(ClientList[i]) is TECSpinBtns then (TControl(ClientList[i]) as TECSpinBtns).FController := nil; FreeAndNil(ClientList); inherited Destroy; end; function TECSpinController.IsClientButtons(AClient: Pointer; out ABtns: TCustomSpinBtns): Boolean; begin if TControl(AClient) is TCustomSpinBtns then ABtns := TControl(AClient) as TCustomSpinBtns; if TControl(AClient) is TECSpinEdit then ABtns := (TControl(AClient) as TECSpinEdit).Buttons; Result := (ABtns is TCustomSpinBtns); end; procedure TECSpinController.RegisterClient(AClient: TControl); begin if (AClient is TECSpinEdit) or (AClient is TCustomSpinBtns) then begin ClientList.Add(AClient); if AClient is TECSpinEdit then begin SetupButtons((AClient as TECSpinEdit).Buttons); SetupSpinEdit(AClient as TECSpinEdit); end else if AClient is TCustomSpinBtns then SetupButtons(AClient as TCustomSpinBtns); end; end; procedure TECSpinController.SetupButtons(AButtons: TCustomSpinBtns); begin with AButtons do begin BtnBigDec.Width := BtnBigDecWidth; BtnBigInc.Width := BtnBigIncWidth; BtnDec.Width := BtnDecWidth; BtnDrag.Width := BtnDragWidth; BtnInc.Width := BtnIncWidth; BtnMax.Width := BtnMaxWidth; BtnMenu.Width := BtnMenuWidth; BtnMiddle.Width := BtnMiddleWidth; BtnMin.Width := BtnMinWidth; GlyphStyle := self.GlyphStyle; Reversed := self.Reversed; Spacing := self.Spacing; Style := self.Style; TimerDelay := self.TimerDelay; TimerRepeating := self.TimerRepeating; end; end; procedure TECSpinController.SetupSpinEdit(ASpinEdit: TECSpinEdit); begin with ASpinEdit do begin ActionAltEnter := self.ActionAltEnter; ActionCtrlEnter := self.ActionCtrlEnter; ActionShiftEnter := self.ActionShiftEnter; Indent := self.Indent; Options := self.Options; end; end; procedure TECSpinController.UnRegisterClient(AClient: TControl); var i: Integer; begin for i := 0 to ClientList.Count - 1 do if TCustomSpinBtns(ClientList[i]) = AClient then begin ClientList.Delete(i); break; end; end; {TECSpinController.Setters} procedure TECSpinController.SetActionAltEnter(AValue: TModifierEnter); var i: Integer; begin if FActionAltEnter = AValue then exit; FActionAltEnter := AValue; for i := 0 to ClientList.Count -1 do if assigned(ClientList[i]) and (TControl(ClientList[i]) is TECSpinEdit) then (TControl(ClientList[i]) as TECSpinEdit).ActionAltEnter := AValue; end; procedure TECSpinController.SetActionCtrlEnter(AValue: TModifierEnter); var i: Integer; begin if FActionCtrlEnter = AValue then exit; FActionCtrlEnter := AValue; for i := 0 to ClientList.Count -1 do if assigned(ClientList[i]) and (TControl(ClientList[i]) is TECSpinEdit) then (TControl(ClientList[i]) as TECSpinEdit).ActionCtrlEnter := AValue; end; procedure TECSpinController.SetActionShiftEnter(AValue: TModifierEnter); var i: Integer; begin if FActionShiftEnter = AValue then exit; FActionShiftEnter := AValue; for i := 0 to ClientList.Count -1 do if assigned(ClientList[i]) and (TControl(ClientList[i]) is TECSpinEdit) then (TControl(ClientList[i]) as TECSpinEdit).ActionShiftEnter := AValue; end; procedure TECSpinController.SetBtnBigDecWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnBigDecWidth = AValue then exit; FBtnBigDecWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnBigDec.Width := AValue; end; procedure TECSpinController.SetBtnBigIncWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnBigIncWidth = AValue then exit; FBtnBigIncWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnBigInc.Width := AValue; end; procedure TECSpinController.SetBtnDecWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnDecWidth = AValue then exit; FBtnDecWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnDec.Width := AValue; end; procedure TECSpinController.SetBtnDragWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnDragWidth = AValue then exit; FBtnDragWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnDrag.Width := AValue; end; procedure TECSpinController.SetBtnIncWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnIncWidth = AValue then exit; FBtnIncWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnInc.Width := AValue; end; procedure TECSpinController.SetBtnMaxWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnMaxWidth = AValue then exit; FBtnMaxWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnMax.Width := AValue; end; procedure TECSpinController.SetBtnMenuWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnMenuWidth = AValue then exit; FBtnMenuWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnMenu.Width := AValue; end; procedure TECSpinController.SetBtnMiddleWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnMiddleWidth = AValue then exit; FBtnMiddleWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnMiddle.Width := AValue; end; procedure TECSpinController.SetBtnMinWidth(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FBtnMinWidth = AValue then exit; FBtnMinWidth := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.BtnMin.Width := AValue; end; procedure TECSpinController.SetGlyphStyle(AValue: TGlyphStyle); var i: Integer; aBtns: TCustomSpinBtns; begin if FGlyphStyle = AValue then exit; FGlyphStyle := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.GlyphStyle := AValue; end; procedure TECSpinController.SetIndent(AValue: SmallInt); var i: Integer; begin if FIndent = AValue then exit; FIndent := AValue; for i := 0 to ClientList.Count -1 do if assigned(ClientList[i]) and (TControl(ClientList[i]) is TECSpinEdit) then (TControl(ClientList[i]) as TECSpinEdit).Indent := AValue; end; procedure TECSpinController.SetOptions(AValue: TSEOptions); var i: Integer; begin if FOptions = AValue then exit; FOptions := AValue; for i := 0 to ClientList.Count - 1 do if assigned(ClientList[i]) and (TControl(ClientList[i]) is TECSpinEdit) then (TControl(ClientList[i]) as TECSpinEdit).Options := AValue; end; procedure TECSpinController.SetReversed(AValue: Boolean); var i: Integer; aBtns: TCustomSpinBtns; begin if FReversed = AValue then exit; FReversed := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.Reversed := AValue; end; procedure TECSpinController.SetSpacing(AValue: SmallInt); var i: Integer; aBtns: TCustomSpinBtns; begin if FSpacing = AValue then exit; FSpacing := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.Spacing := AValue; end; procedure TECSpinController.SetStyle(AValue: TButtonStyle); var i: Integer; aBtns: TCustomSpinBtns; begin if FStyle = AValue then exit; FStyle := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.Style := AValue; end; procedure TECSpinController.SetTimerDelay(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FTimerDelay = AValue then exit; FTimerDelay := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.TimerDelay := AValue; end; procedure TECSpinController.SetTimerRepeating(AValue: Integer); var i: Integer; aBtns: TCustomSpinBtns; begin if FTimerRepeating = AValue then exit; FTimerRepeating := AValue; for i := 0 to ClientList.Count - 1 do if IsClientButtons(ClientList[i], aBtns) then aBtns.TimerRepeating := AValue; end; { TSingleSpinBtn } constructor TSingleSpinBtn.Create(AParent: TCustomSpinBtns); begin inherited Create; Parent := AParent; {don't change order} FEnabled := True; FGlyphColor := clDefault; FImageIndex := -1; FWidth := cDefSSBWidth; FVisible := True; CreateBitmaps; { FVisible + CreateBitmaps to avoid Parent.CalcInternalGeometry } end; destructor TSingleSpinBtn.Destroy; begin if FVisible then FreeBitmaps; inherited Destroy; end; procedure TSingleSpinBtn.CreateBitmaps; var aState: TItemState; begin for aState := low(TItemState) to eisPushed do begin BtnBitmaps[aState] := TBitmap.Create; BtnBitmaps[aState].SetProperties(self.Width, Parent.Height); end; end; procedure TSingleSpinBtn.FreeBitmaps; var aState: TItemState; begin for aState := low(TItemState) to eisPushed do FreeAndNil(BtnBitmaps[aState]); end; procedure TSingleSpinBtn.Resize; var aState: TItemState; h, w: Integer; begin if FVisible then begin w := Width; h := Parent.Height; for aState:=low(TItemState) to eisPushed do BtnBitmaps[aState].SetSize(w, h); end; end; { TSingleSpinBtn.Setters } procedure TSingleSpinBtn.SetBtnOrder(AValue: Word); var oldBtnOrder: Word; begin oldBtnOrder := BtnOrder; if (oldBtnOrder = AValue) or (AValue > Byte(high(TBtnKind))) then exit; FBtnOrder := AValue; Parent.SortSpeedBtns(Kind, AValue, oldBtnOrder); if Parent.UpdateCount = 0 then begin Parent.CalcInternalGeometry; with Parent do if Style > ebsSeparated then DrawButtons; Parent.Invalidate; end else Parent.RedrawMode := ermRecalcRedraw; end; procedure TSingleSpinBtn.SetCaption(AValue: string); begin if FCaption = AValue then exit; FCaption := AValue; Parent.Redraw; end; procedure TSingleSpinBtn.SetGlyphColor(AValue: TColor); begin if FGlyphColor = AValue then exit; FGlyphColor := AValue; Parent.Redraw; end; procedure TSingleSpinBtn.SetImageIndex(AValue: SmallInt); begin if FImageIndex = AValue then exit; FImageIndex := AValue; if assigned(Parent.FImages) then Parent.Redraw; end; procedure TSingleSpinBtn.SetVisible(AValue: Boolean); begin if FVisible = AValue then exit; FVisible := AValue; if AValue then CreateBitmaps else FreeBitmaps; Parent.RecalcRedraw; end; procedure TSingleSpinBtn.SetWidth(AValue: SmallInt); begin if FWidth = AValue then exit; FWidth := AValue; Resize; Parent.RecalcRedraw; end; { TCustomSpinBtns } constructor TCustomSpinBtns.Create(AOwner: TComponent); var aKind: TBtnKind; function CreateAndSetBtn(AMouseClickMethod: TObjectMethod; AKind: TBtnKind): TSingleSpinBtn; begin Result := TSingleSpinBtn.Create(self); with Result do begin Parent := self; Click := AMouseClickMethod; FKind := AKind; end; end; begin inherited Create(AOwner); AutoSize := True; ControlStyle:=ControlStyle + [csCaptureMouse, csNoFocus, csParentBackground, csReplicatable] - csMultiClicks - [csOpaque, csSetCaption]; BtnMin := CreateAndSetBtn(@BtnMinClick, ebkMin); BtnBigDec := CreateAndSetBtn(@BtnBigDecClick, ebkBigDec); BtnDec := CreateAndSetBtn(@BtnDecClick, ebkDec); BtnMiddle := CreateAndSetBtn(@BtnMiddleClick, ebkMiddle); BtnDrag := CreateAndSetBtn(nil, ebkDrag); BtnMenu := CreateAndSetBtn(@BtnMenuClick, ebkMenu); BtnInc := CreateAndSetBtn(@BtnIncClick, ebkInc); BtnBigInc := CreateAndSetBtn(@BtnBigIncClick, ebkBigInc); BtnMax := CreateAndSetBtn(@BtnMaxClick, ebkMax); for aKind := low(TBtnKind) to high(TBtnKind) do BtnsUnsorted[aKind].FBtnOrder := Byte(aKind); SetBtnsSorted; FDiscreteChange := 1; FDragOrientation := edoVertical; FGlyphStyle := egsArrowsA; FIncrement := 1; FMax := 100; FMin := -100; FMode:=eimContinuous; FMouseIncrementX := 0.1; FMouseIncrementY := 1; FMouseStepPixelsX := 1; FMouseStepPixelsY := 1; FPageSize := 10; FTimerDelay := cDefCTDelay; FTimerRepeating := cDefCTRepeat; FValue := 0; Height := 23; HoveredBtn := -1; InitX := high(Integer); InitY := high(Integer); PushedBtn := -1; CalcInternalGeometry; RedrawMode := ermRedrawBkgnd; end; destructor TCustomSpinBtns.Destroy; var aBtnKind: TBtnKind; begin for aBtnKind := low(TBtnKind) to high(TBtnKind) do FreeAndNil(BtnsUnsorted[aBtnKind]); inherited Destroy; end; class constructor TCustomSpinBtns.CreateTimer; begin ControlTimer := TCustomECTimer.Create(nil); end; class destructor TCustomSpinBtns.DestroyTimer; begin FreeAndNil(ControlTimer); end; procedure TCustomSpinBtns.AdjustWidth; begin if AutoSize then begin InvalidatePreferredSize; AdjustSize; end; end; procedure TCustomSpinBtns.BeginUpdate; begin inc(UpdateCount); end; procedure TCustomSpinBtns.BtnBigDecClick; begin if cMouseModifier*GetKeyShiftState = [] then DoBtnBigDecClick else DoBtnDecClick; end; procedure TCustomSpinBtns.BtnBigIncClick; begin if cMouseModifier*GetKeyShiftState = [] then DoBtnBigIncClick else DoBtnIncClick; end; procedure TCustomSpinBtns.BtnDecClick; begin if cMouseModifier*GetKeyShiftState = [] then DoBtnDecClick else DoBtnBigDecClick; end; procedure TCustomSpinBtns.BtnIncClick; begin if cMouseModifier*GetKeyShiftState = [] then DoBtnIncClick else DoBtnBigIncClick; end; procedure TCustomSpinBtns.BtnMaxClick; begin Value := FMax; end; procedure TCustomSpinBtns.BtnMenuClick; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.BtnMenuClick'); {$ENDIF} if assigned(FOnMenuClick) then FOnMenuClick(self); end; procedure TCustomSpinBtns.BtnMiddleClick; begin Value := FMiddle; end; procedure TCustomSpinBtns.BtnMinClick; begin Value := FMin; end; function TCustomSpinBtns.CalcDiscreteMode(AValue: Double): Double; begin Result := DiscreteChange*round(AValue/DiscreteChange); end; function TCustomSpinBtns.CalcHoveredButton(X: Integer): Boolean; var aBtnPosLength, aHoveredBtnReal, aPrevHoveredBtn, aPrevHoveredBtnReal, i: Integer; begin { Returns True if needs Invalidate (repaint) } Result := False; aBtnPosLength := length(BtnPositions); aPrevHoveredBtn := HoveredBtn; i := 0; while (i < aBtnPosLength) and (BtnPositions[i] < X) do inc(i); HoveredBtn := i; if (aPrevHoveredBtn <> i) and (PushedBtn = -1) then begin aHoveredBtnReal := i; i := 0; while i <= aHoveredBtnReal do begin if not BtnsSorted[i].Visible then inc(aHoveredBtnReal); inc(i); end; aPrevHoveredBtnReal := HoveredBtnReal; HoveredBtnReal := aHoveredBtnReal; if BtnsSorted[aHoveredBtnReal].Enabled or BtnsSorted[aPrevHoveredBtnReal].Enabled then Result := True; end; end; procedure TCustomSpinBtns.CalcInternalGeometry; var aCount, aIndex, aPos, i: Integer; begin aCount := 0; for i := 0 to Byte(high(TBtnKind)) do if BtnsSorted[i].Visible then inc(aCount); aIndex := 0; aPos := 0; SetLength(BtnPositions, aCount); for i := 0 to Byte(high(TBtnKind)) do if BtnsSorted[i].Visible then begin BtnsSorted[i].FLeft := aPos + aIndex*FSpacing; inc(aPos, BtnsSorted[i].Width); if aIndex < aCount then BtnPositions[aIndex] := aPos + ((2*aIndex + 1)*FSpacing) div 2 else break; inc(aIndex); end; dec(aCount); FWidth := aPos + aCount*FSpacing; end; procedure TCustomSpinBtns.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.CalculatePreferredSize'); {$ENDIF} PreferredHeight := 0; PreferredWidth := FWidth; end; procedure TCustomSpinBtns.CMBiDiModeChanged(var Message: TLMessage); var aKind: TBtnKind; aWidth: Integer; begin inherited CMBidiModeChanged(Message); SetBtnsSorted; aWidth := Width; for aKind := ebkMin to ebkMax do BtnsUnsorted[aKind].FLeft := aWidth - BtnsUnsorted[aKind].FLeft - BtnsUnsorted[aKind].Width; end; procedure TCustomSpinBtns.CMColorChanged(var Message: TLMessage); begin BackgroundColor := GetColorResolvingDefault(Color, Parent.Brush.Color); end; procedure TCustomSpinBtns.CMParentColorChanged(var Message: TLMessage); begin inherited CMParentColorChanged(Message); if not ParentColor then BackgroundColor := GetColorResolvingDefault(Color, Parent.Brush.Color); end; procedure TCustomSpinBtns.DoBtnBigDecClick; begin SetValue(FValue - PageSize); end; procedure TCustomSpinBtns.DoBtnBigIncClick; begin SetValue(FValue + PageSize) end; procedure TCustomSpinBtns.DoBtnDecClick; begin SetValue(FValue - Increment); end; procedure TCustomSpinBtns.DoBtnIncClick; begin SetValue(FValue + Increment); end; procedure TCustomSpinBtns.DoContextPopup(MousePos: TPoint; var Handled: Boolean); begin Handled := (InitX <> high(Integer)); { Do NOT allow PopupMenu when dragging } inherited DoContextPopup(MousePos, Handled); end; procedure TCustomSpinBtns.DoTimerRepeatingMode(Sender: TObject); begin TimerEvent; ControlTimer.OnTimer := TNotifyEvent(TimerEvent); end; procedure TCustomSpinBtns.DrawButtons; var aBlockBMP: TBitmap; aBtnKind: TBtnKind; aFlags: Cardinal; aTransColor: TColor; aGlyphDesign: TGlyphDesign; aGlyphStyle: TGlyphStyle; aPoint: TPoint; aRect, aSrcRect: TRect; aState: TItemState; bReversed, bSplittedBlock: Boolean; i, k: Integer; procedure DrawBlockButton(AItemState: TItemState); var i: SmallInt; begin aRect.Right := Width; aBlockBMP.TransparentClear; aBlockBMP.Canvas.DrawButtonBackGround(aRect, AItemState); aSrcRect := Rect(0, 0, 0, Height); bSplittedBlock := (Style=ebsSplittedBlock); for i := 0 to Byte(high(TBtnKind)) do if BtnsSorted[i].FVisible then begin k := BtnsSorted[i].Width; aRect.Right := k; aSrcRect.Right := aSrcRect.Right+k; BtnsSorted[i].BtnBitmaps[AItemState].TransparentColor := aTransColor; BtnsSorted[i].BtnBitmaps[AItemState].TransparentClear; BtnsSorted[i].BtnBitmaps[AItemState].Canvas.CopyRect(aRect, aBlockBMP.Canvas, aSrcRect); if bSplittedBlock then begin if aSrcRect.Right < Width then begin BtnsSorted[i].BtnBitmaps[AItemState].Canvas.Pen.Color := cl3DShadow; BtnsSorted[i].BtnBitmaps[AItemState].Canvas.Line (BtnsSorted[i].BtnBitmaps[AItemState].Width - 1, 4, BtnsSorted[i].BtnBitmaps[AItemState].Width - 1, Height - 4); end; if aSrcRect.Left > 0 then begin BtnsSorted[i].BtnBitmaps[AItemState].Canvas.Pen.Color := cl3DHiLight; BtnsSorted[i].BtnBitmaps[AItemState].Canvas.Line(0, 4, 0, Height - 4); end; end; aSrcRect.Left := aSrcRect.Left + k; end; end; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.DrawButtons'); {$ENDIF} aTransColor := ColorToRGB(BackgroundColor) and $FDFBF9 + $010203; aRect.TopLeft := Point(0, 0); aRect.Bottom := Height; aGlyphStyle := GlyphStyle; bReversed := Reversed; if Style > ebsSeparated then begin aBlockBMP := TBitmap.Create; with aBlockBMP do begin SetSize(self.Width, self.Height); Transparent := True; TransparentMode := tmFixed; TransparentColor := aTransColor; end; aRect.Right := Width; for aState := low(TItemState) to eisPushed do DrawBlockButton(aState); FreeAndNil(aBlockBMP); end else for i := 0 to Byte(high(TBtnKind)) do if BtnsSorted[i].Visible then begin aRect.Right := BtnsSorted[i].Width; for aState := low(TItemState) to eisPushed do begin BtnsSorted[i].BtnBitmaps[aState].TransparentColor := aTransColor; BtnsSorted[i].BtnBitmaps[aState].TransparentClear; BtnsSorted[i].BtnBitmaps[aState].Canvas.DrawButtonBackground(aRect, aState); end; end; if assigned(OnDrawGlyph) then begin for aBtnKind := low(TBtnKind) to high(TBtnKind) do if BtnsUnsorted[aBtnKind].Visible then for aState := low(TItemState) to eisPushed do OnDrawGlyph(self, aBtnKind, aState); end else for i := 0 to Byte(high(TBtnKind)) do { Draw Glyphs } with BtnsSorted[i] do if Visible then begin if Caption <> '' then begin { Draw Caption } aRect := Rect(0, 0, FWidth, Height); aFlags := DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER or DT_CENTER; for aState := low(TItemState) to eisPushed do begin BtnBitmaps[aState].Canvas.Font.Assign(Parent.Font); BtnBitmaps[aState].Canvas.Font.Color := GetColorResolvingDefault(GlyphColor, clBtnText); with ThemeServices do DrawText(BtnBitmaps[aState].Canvas, GetElementDetails(caThemedContent[aState]), Caption, aRect, aFlags, 0); end; end else begin { Draw Image from ImageList } k := FImageIndex; if (k > -1) and assigned(Parent.FImages) and (k < Parent.FImages.Count) then begin aPoint.X := (FWidth-Parent.FImages.Width) div 2; aPoint.Y := (Parent.Height-Parent.FImages.Height) div 2; for aState := low(TItemState) to eisPushed do begin with ThemeServices do DrawIcon(BtnBitmaps[aState].Canvas, GetElementDetails(caThemedContent[aState]), aPoint, Parent.FImages, k); end; end else begin { Draw built-in Glyphs } aBtnKind := Kind; if bReversed and (aGlyphStyle <= egsArrowsC) then case aBtnKind of ebkMin: aBtnKind := ebkMax; ebkBigDec: aBtnKind := ebkBigInc; ebkDec: aBtnKind := ebkInc; ebkInc: aBtnKind := ebkDec; ebkBigInc: aBtnKind := ebkBigDec; ebkMax: aBtnKind := ebkMin; end; case aGlyphStyle of egsArrowsA: case aBtnKind of ebkMin: aGlyphDesign := egdArrowsMin; ebkBigDec: aGlyphDesign := egdArrowsDD; ebkDec: aGlyphDesign := egdArrowDec; ebkMiddle: aGlyphDesign := egdArrowsMiddle; ebkDrag: case DragOrientation of edoVertical: aGlyphDesign := egdArrowsUD; edoHorizontal: aGlyphDesign := egdArrowsLR; edoBoth: aGlyphDesign := egdArrowsURDL_S; end; ebkMenu: aGlyphDesign := egdWindowRect; ebkInc: aGlyphDesign := egdArrowInc; ebkBigInc: aGlyphDesign := egdArrowsUU; ebkMax: aGlyphDesign := egdArrowsMax; end; egsArrowsB: case aBtnKind of ebkMin: aGlyphDesign := egdArrsB_Min; ebkBigDec: aGlyphDesign := egdArrsB_DD; ebkDec: aGlyphDesign := egdArrB_Down; ebkMiddle: aGlyphDesign := egdArrsB_Middle; ebkDrag: if DragOrientation <> edoHorizontal then aGlyphDesign := egdArrsB_UD else aGlyphDesign := egdArrsB_LR; ebkMenu: aGlyphDesign := egdWindowRound; ebkInc: aGlyphDesign := egdArrB_Up; ebkBigInc: aGlyphDesign := egdArrsB_UU; ebkMax: aGlyphDesign := egdArrsB_Max; end; egsArrowsC: case aBtnKind of ebkMin: aGlyphDesign := egdArrC_Min; ebkBigDec: aGlyphDesign := egdArrC_DD; ebkDec: aGlyphDesign := egdArrC_Down; ebkMiddle: aGlyphDesign := egdArrC_Middle; ebkDrag: if DragOrientation <> edoHorizontal then aGlyphDesign := egdArrC_UD else aGlyphDesign := egdArrC_LR; ebkMenu: aGlyphDesign := egdWindowRect; ebkInc: aGlyphDesign := egdArrC_Up; ebkBigInc: aGlyphDesign := egdArrC_UU; ebkMax: aGlyphDesign := egdArrC_Max; end; egsComparison: case aBtnKind of ebkMin: aGlyphDesign := egdArrsB_HMin; ebkBigDec: aGlyphDesign := egdArrsB_LL; ebkDec: aGlyphDesign := egdArrB_Left; ebkMiddle: aGlyphDesign := egdArrsB_HMiddle; ebkDrag: if DragOrientation <> edoHorizontal then aGlyphDesign := egdArrsB_UD else aGlyphDesign := egdArrsB_LR; ebkMenu: aGlyphDesign := egdWindowRound; ebkInc: aGlyphDesign := egdArrB_Right; ebkBigInc: aGlyphDesign := egdArrsB_RR; ebkMax: aGlyphDesign := egdArrsB_HMax; end; egsMath: case aBtnKind of ebkMin: aGlyphDesign := egdArrB_HMin; ebkBigDec: aGlyphDesign := egdMathBigMinus; ebkDec: aGlyphDesign := egdMathMinus; ebkMiddle: aGlyphDesign := egdMathEqual; ebkDrag: begin if DragOrientation <> edoHorizontal then aGlyphDesign := egdMathPlusMinus else aGlyphDesign := egdArrsB_LR; end; ebkMenu: aGlyphDesign := egdWindowRound; ebkInc: aGlyphDesign := egdMathPlus; ebkBigInc: aGlyphDesign := egdMathBigPlus; ebkMax: aGlyphDesign := egdArrB_HMax; end; egsPlayer: case aBtnKind of ebkMin: aGlyphDesign := egdArrowHMin; ebkBigDec: aGlyphDesign := egdArrowsLL; ebkDec: aGlyphDesign := egdArrowLeft; ebkMiddle: aGlyphDesign := egdPlayPause; ebkDrag: if DragOrientation <> edoHorizontal then aGlyphDesign := egdPlayUpDown else aGlyphDesign := egdArrowsLR; ebkMenu: aGlyphDesign := egdPlayStop; ebkInc: aGlyphDesign := egdArrowRight; ebkBigInc: aGlyphDesign := egdArrowsRR; ebkMax: aGlyphDesign := egdArrowHMax; end; end; {case} aRect := Rect(0, 0, Width, Height); if aGlyphDesign >= egdGrid then InflateRect(aRect, -3, -4); for aState := low(TItemState) to eisPushed do begin BtnBitmaps[aState].Canvas.SetRealGlyphColor(GlyphColor, aState); BtnBitmaps[aState].Canvas.DrawGlyph(aRect, aGlyphDesign) end; end; end; end; end; procedure TCustomSpinBtns.EndMouseDrag; begin if InitX <> high(Integer) then begin Cursor := CursorSwap; InitX := high(Integer); InitY := high(Integer); end; end; procedure TCustomSpinBtns.EndUpdate; begin dec(UpdateCount); if UpdateCount = 0 then begin DrawButtons; Invalidate; end; end; procedure TCustomSpinBtns.FontChanged(Sender: TObject); begin inherited FontChanged(Sender); DrawButtons; end; procedure TCustomSpinBtns.Loaded; begin inherited Loaded; Width := FWidth; { for the case when buttons are invisible and used as cell editor of grid } end; procedure TCustomSpinBtns.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var aHoveredBtnReal: Integer; procedure StartDragging; begin InitValue := Value; InitX := X; InitY := Y; PrevCTRLDown := (ssCtrl in Shift); CursorSwap := Cursor; case DragOrientation of edoVertical: Cursor := crSizeNS; edoHorizontal: Cursor := crSizeWE; edoBoth: Cursor := crSizeAll; end; end; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.MouseDown Hovered,Pushed '+inttostr(HoveredBtn)+', '+inttostr(PushedBtn)); {$ENDIF} inherited MouseDown(Button, Shift, X, Y); if (PushedBtn = -1) and (HoveredBtn >= 0) and (InitX = high(Integer)) then begin aHoveredBtnReal := HoveredBtnReal; if Button = mbLeft then begin if BtnsSorted[aHoveredBtnReal].Enabled then begin PushedBtn := HoveredBtn; case BtnsSorted[aHoveredBtnReal].Kind of ebkBigDec, ebkDec, ebkInc, ebkBigInc: begin BtnsSorted[aHoveredBtnReal].Click; TimerEvent := BtnsSorted[aHoveredBtnReal].Click; ControlTimer.Delay := TimerDelay; ControlTimer.Repeating := TimerRepeating; ControlTimer.OnTimer := @DoTimerRepeatingMode; ControlTimer.Control := self; ControlTimer.Enabled := True; end; ebkDrag: StartDragging; otherwise BtnsSorted[aHoveredBtnReal].Click; end; Invalidate; end; end else if ([Button]*DragControl <> []) and ((Button <> mbRight) or not assigned(PopupMenu)) then begin MouseCapture := True; StartDragging; Invalidate; end; end; end; procedure TCustomSpinBtns.MouseLeave; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.MouseLeave'); {$ENDIF} inherited MouseLeave; if (HoveredBtn >= 0) and (PushedBtn = -1) and BtnsSorted[HoveredBtnReal].Enabled then begin HoveredBtn := -1; Invalidate; end; end; procedure TCustomSpinBtns.MouseMove(Shift: TShiftState; X, Y: Integer); var i, j: Integer; aMouseIncrement, aValue: Double; bCTRLDown: Boolean; begin inherited MouseMove(Shift, X, Y); if InitX <> high(Integer) then begin { Drag state } bCTRLDown := (ssCtrl in Shift); if bCTRLDown <> PrevCTRLDown then begin InitValue := Value; InitX := X; InitY := Y; end; j := Y - InitY; i := X - InitX; if not Reversed then j := -j; if IsRightToLeft then i := -i; if not MouseFromMiddle then aValue := InitValue else aValue := Middle; if DragOrientation <> edoHorizontal then begin if not bCTRLDown then aMouseIncrement := MouseIncrementY else aMouseIncrement := MouseIncrementX; aValue := aValue + aMouseIncrement*(j div MouseStepPixelsY); end; if DragOrientation <> edoVertical then begin if not bCTRLDown then aMouseIncrement := MouseIncrementX else aMouseIncrement := MouseIncrementY; aValue := aValue + aMouseIncrement*(i div MouseStepPixelsX); end; Value := EnsureRange(aValue, FMin, FMax); PrevCTRLDown := bCTRLDown; end else begin { Normal state } if CalcHoveredButton(X) then if not MouseCapture then Invalidate; end; end; procedure TCustomSpinBtns.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var aPrevPushedBtn: SmallInt; bMouseEntered: Boolean; begin { GTK2 bug report no. 21982 } {$IFDEF DBGSPINS} Debugln('TCustomSpinBtns.MouseUp; Hovered, PushedBtn '+inttostr(HoveredBtn)+' '+inttostr(PushedBtn)); {$ENDIF} inherited MouseUp(Button, Shift, X, Y); if InitX <> high(Integer) then { any Button stops dragging } begin EndMouseDrag; aPrevPushedBtn := PushedBtn; if Button = mbLeft then PushedBtn := -1 else MouseCapture := False; if PtInRect(ClientRect, Point(X, Y)) then begin CalcHoveredButton(X); Invalidate; end else if (aPrevPushedBtn >= 0) then begin HoveredBtn := -1; Invalidate; end; end else begin if Button = mbLeft then begin bMouseEntered := PtInRect(ClientRect, Point(X, Y)); { MouseEntered is always True here } if not bMouseEntered then HoveredBtn := -1; if PushedBtn >= 0 then begin StopTimer; PushedBtn := -1; Invalidate; if assigned(CustomMouseUp) then CustomMouseUp; end else if bMouseEntered then Invalidate; end else begin if not (Button in DragControl) then if [Button]*MenuControl <> [] then BtnMenuClick else if Button = mbMiddle then BtnMiddleClick; end; end; end; procedure TCustomSpinBtns.Paint; var aState: TItemState; aIndex, aLeft, i: Integer; aMousePoint: TPoint; bEnabled: Boolean; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.Paint, HoveredBtn '+inttostr(HoveredBtn)); {$ENDIF} inherited Paint; if RedrawMode = ermRecalcRedraw then CalcInternalGeometry; if RedrawMode >= ermRedrawBkgnd then DrawButtons; if RedrawMode >= ermFreeRedraw then begin if NeedCalcHoveredBtnInPaint then { When Buttons are a CellEditor } begin aMousePoint := ScreenToClient(Mouse.CursorPos); if (aMousePoint.Y >= 0 ) and (aMousePoint.Y < Height) then CalcHoveredButton(aMousePoint.X) else HoveredBtn := -1; NeedCalcHoveredBtnInPaint := False; end else if not MouseCapture then { solves when virtual desktop is switched during drag } begin if not MouseEntered then HoveredBtn := -1; PushedBtn := -1; if ControlTimer.Control = self then StopTimer; EndMouseDrag; end; bEnabled := IsEnabled; aLeft := 0; aIndex := 0; for i := 0 to Byte(high(TBtnKind)) do if BtnsSorted[i].Visible then begin aState := eisEnabled; if not (bEnabled and BtnsSorted[i].Enabled) then aState := eisDisabled else if PushedBtn = -1 then begin if (aIndex = HoveredBtn) and not MouseCapture then aState := eisHighlighted end else if aIndex = PushedBtn then aState := eisPushed; Canvas.Draw(aLeft, 0, BtnsSorted[i].BtnBitmaps[aState]); aLeft := aLeft + BtnsSorted[i].Width + Spacing; inc(aIndex); end; end; RedrawMode := ermFreeRedraw; end; procedure TCustomSpinBtns.RecalcRedraw; begin if UpdateCount = 0 then begin CalcInternalGeometry; AdjustWidth; RedrawMode := ermRedrawBkgnd; Invalidate; end; end; procedure TCustomSpinBtns.Redraw; begin if RedrawMode < ermRedrawBkgnd then RedrawMode := ermRedrawBkgnd; if UpdateCount = 0 then Invalidate; end; procedure TCustomSpinBtns.Resize; var i: Integer; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.Resize W&H '+inttostr(Width)+' '+inttostr(Height)); {$ENDIF} inherited Resize; if Height <> PrevHeight then begin for i := 0 to Byte(high(TBtnKind)) do BtnsSorted[i].Resize; PrevHeight := Height; RedrawMode := ermRedrawBkgnd; end; end; procedure TCustomSpinBtns.SetBtnsSorted; var aKind: TBtnKind; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.SetBtnsSorted'); {$ENDIF} if not IsRightToLeft then for aKind := low(TBtnKind) to high(TBtnKind) do BtnsSorted[BtnsUnsorted[aKind].BtnOrder] := BtnsUnsorted[aKind] else for aKind := low(TBtnKind) to high(TBtnKind) do BtnsSorted[8-BtnsUnsorted[aKind].BtnOrder] := BtnsUnsorted[aKind]; end; procedure TCustomSpinBtns.SetDecBtnsEnabled(AEnabled: Boolean); begin BtnMin.FEnabled := aEnabled; BtnBigDec.FEnabled := aEnabled; BtnDec.FEnabled := aEnabled; end; procedure TCustomSpinBtns.SetIncBtnsEnabled(aEnabled: Boolean); begin BtnInc.FEnabled := aEnabled; BtnBigInc.FEnabled := aEnabled; BtnMax.FEnabled := aEnabled; end; procedure TCustomSpinBtns.SetParent(NewParent: TWinControl); begin inherited SetParent(NewParent); if assigned(NewParent) then BackgroundColor := GetColorResolvingDefault(Color, NewParent.Brush.Color); end; procedure TCustomSpinBtns.SortSpeedBtns(TheKind: TBtnKind; NewValue, OldValue: Word); var aKind: TBtnKind; begin {$IFDEF DBGSPINS} DebugLn('TCustomSpinBtns.SortSpeenButtons'); {$ENDIF} if NewValue < OldValue then begin if TheKind > low(TBtnKind) then {because pred(ebkMin) = 255 (or 65535 etc.)} for aKind := low(TBtnKind) to pred(TheKind) do if (BtnsUnsorted[aKind].BtnOrder >= NewValue) and (BtnsUnsorted[aKind].BtnOrder < OldValue) then BtnsUnsorted[aKind].FBtnOrder := BtnsUnsorted[aKind].BtnOrder + 1; for aKind := succ(TheKind) to high(TBtnKind) do if (BtnsUnsorted[aKind].BtnOrder >= NewValue) and (BtnsUnsorted[aKind].BtnOrder < OldValue) then BtnsUnsorted[aKind].FBtnOrder := BtnsUnsorted[aKind].BtnOrder + 1; end else begin if TheKind > low(TBtnKind) then for aKind := low(TBtnKind) to pred(TheKind) do if (BtnsUnsorted[aKind].BtnOrder <= NewValue) and (BtnsUnsorted[aKind].BtnOrder > OldValue) then BtnsUnsorted[aKind].FBtnOrder := BtnsUnsorted[aKind].BtnOrder - 1; for aKind := succ(TheKind) to high(TBtnKind) do if (BtnsUnsorted[aKind].BtnOrder <= NewValue) and (BtnsUnsorted[aKind].BtnOrder > OldValue) then BtnsUnsorted[aKind].FBtnOrder := BtnsUnsorted[aKind].BtnOrder - 1; end; SetBtnsSorted; end; procedure TCustomSpinBtns.StopTimer; begin ControlTimer.Enabled := False; ControlTimer.Control := nil; end; procedure TCustomSpinBtns.VisibleChanged; begin inherited VisibleChanged; if Visible then NeedCalcHoveredBtnInPaint := True; end; { TCustomSpinBtns.Getters + Setters } procedure TCustomSpinBtns.SetBackgroundColor(AValue: TColor); begin if FBackgroundColor = AValue then exit; FBackgroundColor := AValue; RedrawMode := ermRedrawBkgnd; end; procedure TCustomSpinBtns.SetDiscreteChange(AValue: Double); begin if FDiscreteChange = AValue then exit; FDiscreteChange := AValue; if Mode = eimDiscrete then SetValue(FValue); end; procedure TCustomSpinBtns.SetDragOrientation(AValue: TDragOrientation); begin if FDragOrientation = AValue then exit; FDragOrientation := AValue; Redraw; end; procedure TCustomSpinBtns.SetGlyphStyle(AValue: TGlyphStyle); begin if FGlyphStyle = AValue then exit; FGlyphStyle := AValue; Redraw; end; procedure TCustomSpinBtns.SetImages(AValue: TCustomImageList); begin if FImages = AValue then exit; FImages := AValue; Redraw; end; procedure TCustomSpinBtns.SetMax(AValue: Double); var b: Boolean; begin if (csLoading in ComponentState) or (FMin < AValue) then begin FMax := AValue; b := BtnInc.Enabled; if FValue >= AValue then begin SetIncBtnsEnabled(False); if b then if UpdateCount = 0 then Invalidate; end else begin SetIncBtnsEnabled(True); if not b then if UpdateCount = 0 then Invalidate; end; end; end; procedure TCustomSpinBtns.SetMiddle(AValue: Double); begin if (csLoading in ComponentState) or ((FMin < AValue) and (AValue < FMax)) then FMiddle := AValue; end; procedure TCustomSpinBtns.SetMin(AValue: Double); var b: Boolean; begin if (csLoading in ComponentState) or (AValue < FMax) then begin FMin := AValue; b := BtnDec.Enabled; if FValue <= AValue then begin SetDecBtnsEnabled(False); if b then if UpdateCount = 0 then Invalidate; end else begin SetDecBtnsEnabled(True); if not b then if UpdateCount = 0 then Invalidate; end; end; end; procedure TCustomSpinBtns.SetMode(AValue: TIncrementalMode); begin if FMode = AValue then exit; FMode := AValue; if AValue = eimDiscrete then SetValue(FValue); end; procedure TCustomSpinBtns.SetMouseStepPixelsX(AValue: Word); begin if AValue > 0 then FMouseStepPixelsX := AValue else FMouseStepPixelsX := 1; end; procedure TCustomSpinBtns.SetMouseStepPixelsY(AValue: Word); begin if AValue > 0 then FMouseStepPixelsY := AValue else FMouseStepPixelsY := 1; end; procedure TCustomSpinBtns.SetReversed(AValue: Boolean); begin if FReversed = AValue then exit; FReversed := AValue; Redraw; end; procedure TCustomSpinBtns.SetSpacing(AValue: SmallInt); begin if FSpacing = AValue then exit; FSpacing := AValue; CalcInternalGeometry; AdjustWidth; if UpdateCount = 0 then Invalidate; end; procedure TCustomSpinBtns.SetStyle(AValue: TButtonStyle); begin if FStyle = AValue then exit; FStyle := AValue; Redraw; end; procedure TCustomSpinBtns.SetTimerDelay(AValue: Integer); begin if FTimerDelay = AValue then exit; FTimerDelay := AValue; end; procedure TCustomSpinBtns.SetTimerRepeating(AValue: Integer); begin if FTimerRepeating = AValue then exit; FTimerRepeating := AValue; end; procedure TCustomSpinBtns.SetValue(AValue: Double); var b: Boolean; begin if FMode = eimDiscrete then AValue := CalcDiscreteMode(AValue); if FValue = AValue then exit; b := BtnDec.Enabled; AValue := Math.Max(AValue, FMin); if AValue <= FMin then begin SetDecBtnsEnabled(False); StopTimer; if b then if UpdateCount = 0 then Invalidate; end else begin SetDecBtnsEnabled(True); if not b then if UpdateCount = 0 then Invalidate; end; b := BtnInc.Enabled; AValue := Math.Min(AValue, FMax); if AValue >= FMax then begin SetIncBtnsEnabled(False); StopTimer; if b then if UpdateCount = 0 then Invalidate; end else begin SetIncBtnsEnabled(True); if not b then if UpdateCount = 0 then Invalidate; end; FValue := AValue; if assigned(CustomChange) then CustomChange; if assigned(FOnChange) then FOnChange(self); end; { TECSpinBtns } procedure TECSpinBtns.SetController(AValue: TECSpinController); begin {$IFDEF DBGSPINS} DebugLn('TECSpinBtns.SetController'); {$ENDIF} if FController = AValue then exit; if assigned(FController) then FController.UnRegisterClient(self); FController := AValue; if assigned(AValue) then AValue.RegisterClient(self); end; destructor TECSpinBtns.Destroy; begin {$IFDEF DBGSPINS} DebugLn('TECSpinBtns.Destroy'); {$ENDIF} if assigned(FController) then FController.UnRegisterClient(self); inherited Destroy; end; { TECSpinBtnsPlus } constructor TECSpinBtnsPlus.Create(AOwner: TComponent); begin inherited Create(AOwner); {$IFDEF DBGSPINS} if not (Owner is TECSpinEdit) then DebugLn(DbgSName(self), ' Warning! Owner is not TECSpinEdit!'); {$ENDIF} ControlStyle := ControlStyle + [csNoDesignSelectable]; MaxInEdit := FMax; MinInEdit := FMin; SetSubComponent(True); end; procedure TECSpinBtnsPlus.DoBtnBigDecClick; begin Value := (Owner as TECSpinEdit).GetBigDecreasedValue; end; procedure TECSpinBtnsPlus.DoBtnBigIncClick; begin Value := (Owner as TECSpinEdit).GetBigIncreasedValue; end; procedure TECSpinBtnsPlus.DoBtnDecClick; begin Value := (Owner as TECSpinEdit).GetDecreasedValue; end; procedure TECSpinBtnsPlus.DoBtnIncClick; begin Value := (Owner as TECSpinEdit).GetIncreasedValue; end; procedure TECSpinBtnsPlus.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); with Owner as TWinControl do SetFocus; end; procedure TECSpinBtnsPlus.RecalcRedraw; begin if UpdateCount = 0 then begin CalcInternalGeometry; AdjustWidth; (Owner as TECSpinEdit).SetSpinBtnsPosition; RedrawMode := ermRedrawBkgnd; Invalidate; end; end; procedure TECSpinBtnsPlus.SetMaxInEdit(AValue: Double); begin if (csLoading in ComponentState) or (FMinInEdit < AValue) then begin FMaxInEdit := AValue; if AValue < FMax then Max := AValue; if FValue > AValue then SetValue(AValue, True, True); end; end; procedure TECSpinBtnsPlus.SetMax(AValue: Double); begin if csLoading in ComponentState then FMaxInEdit := AValue else if FMaxInEdit < AValue then MaxInEdit := AValue; inherited SetMax(AValue); end; procedure TECSpinBtnsPlus.SetMinInEdit(AValue: Double); begin if (csLoading in ComponentState) or (AValue < FMaxInEdit) then begin FMinInEdit := AValue; if FMin < AValue then Min := AValue; if FValue < AValue then SetValue(AValue, True, True); end; end; procedure TECSpinBtnsPlus.SetMin(AValue: Double); begin if csLoading in ComponentState then FMinInEdit := AValue else if FMinInEdit > AValue then MinInEdit := AValue; inherited SetMin(AValue); end; procedure TECSpinBtnsPlus.SetValue(AValue: Double; RaiseCustomChange, ExceedLimit: Boolean); var b: Boolean; begin if Mode = eimDiscrete then AValue := CalcDiscreteMode(AValue); if FValue = AValue then exit; b := BtnDec.Enabled; if ExceedLimit then AValue := Math.Max(AValue, FMinInEdit) else AValue := Math.Max(AValue, FMin); if AValue <= FMin then begin SetDecBtnsEnabled(False); StopTimer; if b then Invalidate; end else begin SetDecBtnsEnabled(True); if not b then Invalidate; end; b := BtnInc.Enabled; if ExceedLimit then AValue := Math.Min(AValue, FMaxInEdit) else AValue := Math.Min(AValue, FMax); if AValue >= FMax then begin SetIncBtnsEnabled(False); StopTimer; if b then Invalidate; end else begin SetIncBtnsEnabled(True); if not b then Invalidate; end; FValue := AValue; if RaiseCustomChange and assigned(CustomChange) then CustomChange; if assigned(FOnChange) then FOnChange(self); end; { TECSpinEditSpacing } function TECSpinEditSpacing.GetSpace(Kind: TAnchorKind): Integer; begin {$IFDEF DBGSPINS} DebugLn('Spacing.GetSpace'); {$ENDIF} Result:=inherited GetSpace(Kind); case Kind of akLeft: if Control.IsRightToLeft then inc(Result, TECSpinEdit(Control).Buttons.Width); akRight: if not Control.IsRightToLeft then inc(Result, TECSpinEdit(Control).Buttons.Width); end; end; procedure TECSpinEditSpacing.GetSpaceAround(var SpaceAround: TRect); begin {$IFDEF DBGSPINS} DebugLn('Spacing.GetSpaceAround'); {$ENDIF} inherited GetSpaceAround(SpaceAround); if not Control.IsRightToLeft then inc(SpaceAround.Right, TECSpinEdit(Control).Buttons.Width) else inc(SpaceAround.Left, TECSpinEdit(Control).Buttons.Width); end; { TECSpinEdit } constructor TECSpinEdit.Create(AOwner: TComponent); begin FSpinBtns := TECSpinBtnsPlus.Create(self); inherited Create(AOwner); ControlStyle := ControlStyle - [csSetCaption]; with FSpinBtns do begin CustomChange := @RewriteText; Name := 'ECSpinEditButtons'; AnchorParallel(akTop, 0, self); AnchorParallel(akBottom, 0, self); SetSpinBtnsPosition; end; FActionAltEnter := cDefActAltEnter; FActionCtrlEnter := cDefActCtrlEnter; FActionShiftEnter := cDefActShiftEnter; FDateTimeFormat := 'hh:nn:ss'; FMantissaExp := 2; FValueFormat := evfRound; FItems := TStringList.Create; RewriteText; Options := cDefSEOptions; end; destructor TECSpinEdit.Destroy; begin FreeAndNil(FItems); inherited Destroy; end; procedure TECSpinEdit.BeginUpdate; begin Buttons.BeginUpdate; end; procedure TECSpinEdit.Change; var aValue: Double; begin if esoEditingChangesValue in Options then if TryGetValueFromString(Text, aValue) then FSpinBtns.SetValue(aValue, False, True); inherited Change; {$IFDEF DBGSPINS} DebugLn('TECSpinEdit.Change '+BoolToStr(esoEditingChangesValue in Options, 'EditChangeVal ', 'EditingNOTChange ') +floattostr(Value)); {$ENDIF} end; function TECSpinEdit.ChildClassAllowed(ChildClass: TClass): boolean; begin Result := (ChildClass = TECSpinBtnsPlus); end; procedure TECSpinEdit.CMBiDiModeChanged(var Message: TLMessage); begin inherited CMBiDiModeChanged(Message); FSpinBtns.BiDiMode := BiDiMode; SetSpinBtnsPosition; end; function TECSpinEdit.CreateControlBorderSpacing: TControlBorderSpacing; begin {$IFDEF DBGSPINS} DebugLn('CreateControlBorderSpacing'); {$ENDIF} Result := TECSpinEditSpacing.Create(self); end; procedure TECSpinEdit.DoOnChangeBounds; begin {$IFDEF DBGSPINS} DebugLn('DoOnChangeBounds'); {$ENDIF} inherited DoOnChangeBounds; if assigned(Buttons) then SetSpinBtnsPosition; end; procedure TECSpinEdit.EditingDone; var aValue: Double; begin {$IFDEF DBGSPINS} DebugLn('TECSpinEdit.EditingDone'); {$ENDIF} if not ReadOnly then begin if TryGetValueFromString(Text, aValue) then SetValue(aValue); RewriteText; end; inherited EditingDone; end; procedure TECSpinEdit.EndUpdate; begin Buttons.EndUpdate; end; function TECSpinEdit.GetBigDecreasedValue: Double; var i: Integer; begin if (ValueFormat = evfDate) and (esoSmartDate in Options) then begin i := trunc(FSpinBtns.PageSize); if (i mod 31) = 0 then begin i := i div 31 ; Result := IncMonth(Value, -i); Exit; { Exit! } end; if (i mod 365) = 0 then begin i := i div 365; Result := IncMonth(Value, -12*i); Exit; { Exit! } end; end; Result := Value - FSpinBtns.PageSize; end; function TECSpinEdit.GetBigIncreasedValue: Double; var i: Integer; begin if (ValueFormat = evfDate) and (esoSmartDate in Options) then begin i := trunc(FSpinBtns.PageSize); if (i mod 31) = 0 then begin i := i div 31 ; Result := IncMonth(Value, i); Exit; { Exit! } end; if (i mod 365) = 0 then begin i := i div 365; Result := IncMonth(Value, 12*i); Exit; { Exit! } end; end; Result := Value + FSpinBtns.PageSize; end; function TECSpinEdit.GetDecreasedValue: Double; var i: Integer; begin if (ValueFormat = evfDate) and (esoSmartDate in Options) then begin i := trunc(FSpinBtns.Increment); if (i mod 31) = 0 then begin i := i div 31 ; Result := IncMonth(Value, -i); Exit; { Exit! } end; if (i mod 365) = 0 then begin i := i div 365; Result := IncMonth(Value, -12*i); Exit; { Exit! } end; end; Result := Value - FSpinBtns.Increment; end; function TECSpinEdit.GetIncreasedValue: Double; var i: Integer; begin if (ValueFormat = evfDate) and (esoSmartDate in Options) then begin i := trunc(FSpinBtns.Increment); if (i mod 31) = 0 then begin i := i div 31 ; Result := IncMonth(Value, i); Exit; { Exit! } end; if (i mod 365) = 0 then begin i := i div 365; Result := IncMonth(Value, 12*i); Exit; { Exit! } end; end; Result := Value + FSpinBtns.Increment; end; function TECSpinEdit.GetText: string; begin Result := GetText(FSpinBtns.Value, FDigits); end; function TECSpinEdit.GetText(AValue: Double; ARound: Integer): string; var aFS: TFormatSettings; i: Integer; begin case FValueFormat of evfRound: Result := floattostrF(AValue, ffFixed, 1, ARound); evfExponent: Result := floattostrF(power(FMantissaExp, AValue), ffFixed, 1, ARound); evfExponential: Result := floattostrF(AValue, ffExponent, ARound, ARound); evfMantissa: Result := floattostrF(power(AValue, FMantissaExp), ffFixed, 1, ARound); evfHexadecimal: Result := HexStr(round(AValue), ARound); evfMarkHexadec: Result := '$' + HexStr(round(AValue), ARound); evfOctal: Result := octStr(round(AValue), ARound); evfBinary: Result := binStr(round(AValue), ARound); evfDate: begin aFS := DefaultFormatSettings; aFS.LongDateFormat := FDateTimeFormat; Result := datetostr(AValue, aFS); end; evfTime: begin aFS := DefaultFormatSettings; aFS.LongTimeFormat := FDateTimeFormat; Result := timetostr(AValue, aFS); end; evfText: begin i := round(AValue); if assigned(FItems) and (i >= 0) and (i < FItems.Count) then Result := FItems[i] else Result := ''; end; evfCombined: begin i := round(AValue/FSpinBtns.Increment); if assigned(FItems) and (i >= 0) and (FItems.Count > 0) then begin if i = 0 then Result := FItems[0] else begin Result := floattostrF(AValue, ffFixed, 1, ARound) + ' '; if i < FItems.Count then Result := Result + FItems[i] else Result := Result + FItems[FItems.Count - 1]; end; end else Result := floattostrF(AValue, ffFixed, 1, ARound); end; end; {case} end; procedure TECSpinEdit.GetValueFromString(AString: string); var aValue: Double; begin if TryGetValueFromString(AString, aValue) then Value := aValue else Value := FSpinBtns.Middle; end; procedure TECSpinEdit.KeyDown(var Key: Word; Shift: TShiftState); var aKey: Word; bKeyUsed: Boolean; procedure ResetActualValue; var aValue: Double; begin {$IFDEF DBGSPINS} DebugLn('TextEdited='+BoolToStr(TextEdited, 'True', 'False')); {$ENDIF} if TextEdited and not (esoEditingChangesValue in FOptions) then if TryGetValueFromString(Text, aValue) then FSpinBtns.SetValue(aValue, False, True); end; begin {$IFDEF DBGSPINS} DebugLn('TECSpinEdit.KeyDown'); {$ENDIF} if FSpinBtns.Enabled then begin case Key of VK_RETURN: {Enter + Ctrl opens Menu} if ((ActionAltEnter = emeMenuClick) and (ssAlt in Shift)) or ((ActionCtrlEnter = emeMenuClick) and (ssModifier in Shift)) or ((ActionShiftEnter = emeMenuClick) and (ssShift in Shift)) then begin FSpinBtns.BtnMenuClick; bKeyUsed := True; end else if ((ActionAltEnter = emeMiddleClick) and (ssAlt in Shift)) or ((ActionCtrlEnter = emeMiddleClick) and (ssModifier in Shift)) or ((ActionShiftEnter = emeMiddleClick) and (ssShift in Shift)) then begin FSpinBtns.BtnMiddleClick; bKeyUsed := True; end; VK_SPACE: {(CTRL +) Space clicks Menu or Middle} if (ssModifier in Shift) or ReadOnly then begin if esoSpaceClicksMiddle in Options then FSpinBtns.BtnMiddleClick else FSpinBtns.BtnMenuClick; bKeyUsed := True; end; otherwise bKeyUsed := False; end; if not bKeyUsed then begin aKey := Key; if FSpinBtns.Reversed then case aKey of {mirror keys in Y-axis} VK_PRIOR: aKey := VK_NEXT; VK_NEXT: aKey := VK_PRIOR; VK_END: aKey := VK_HOME; VK_HOME: aKey := VK_END; VK_UP: aKey := VK_DOWN; VK_DOWN: aKey := VK_UP; end; {case} if not (ssShift in Shift) and (((ssModifier in Shift) and (esoHomeEndCtrl in Options)) or ((ssAlt in Shift) and (esoHomeEndAlt in Options)) or ReadOnly) then case aKey of VK_END: begin if esoArrowKeysExceed in Options then Value := FSpinBtns.MinInEdit else Value := FSpinBtns.Min; bKeyUsed := True; end; VK_HOME: begin if esoArrowKeysExceed in Options then Value := FSpinBtns.MaxInEdit else Value := FSpinBtns.Max; bKeyUsed := True; end; end; {case} if not bKeyUsed then if ((esoUpDownOnly in Options) and (([ssShift, ssAlt, ssModifier]*Shift) = [])) or ((ssModifier in Shift) and (esoUpDownCtrl in Options)) or ((ssAlt in Shift) and (esoUpDownAlt in Options)) or ((ssShift in Shift) and (esoUpDownShift in Options)) then case aKey of VK_PRIOR: begin ResetActualValue; with FSpinBtns do SetValue(GetBigIncreasedValue, True, esoArrowKeysExceed in FOptions); bKeyUsed := True; end; VK_NEXT: begin ResetActualValue; with FSpinBtns do SetValue(GetBigDecreasedValue, True, esoArrowKeysExceed in Options); bKeyUsed := True; end; VK_UP: begin ResetActualValue; with FSpinBtns do SetValue(GetIncreasedValue, True, esoArrowKeysExceed in Options); bKeyUsed := True; end; VK_DOWN: begin ResetActualValue; with FSpinBtns do SetValue(GetDecreasedValue, True, esoArrowKeysExceed in Options); bKeyUsed := True; end; end; {case} end; if not bKeyUsed then TextEdited := True; end; inherited KeyDown(Key, Shift); end; procedure TECSpinEdit.KeyPress(var Key: Char); begin inherited KeyPress(Key); if ssModifier in GetKeyShiftState then exit; if (Key <> Char(VK_BACK)) and (ord(Key) <> 127) then {127 is Delete} case FValueFormat of evfRound, evfExponent, evfMantissa: if not ((Key in ['0'..'9', '-']) or ((FDigits > 0) and (Key = DefaultFormatSettings.DecimalSeparator))) then Key := #0; evfExponential: if not (Key in ['0'..'9', '-', 'e', 'E', DefaultFormatSettings.DecimalSeparator]) then Key := #0; evfHexadecimal, evfMarkHexadec: if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F']) then Key := #0; evfOctal: if (Key < '0') and (Key > '7') then Key := #0; evfBinary: if (Key <> '0') and (Key <> '1') then Key := #0; evfDate: if not (Key in ['0'..'9', DefaultFormatSettings.DateSeparator]) then Key := #0; evfTime: if not (Key in ['0'..'9', DefaultFormatSettings.TimeSeparator, '.']) then Key := #0; end; end; procedure TECSpinEdit.RewriteText; begin {$IFDEF DBGSPINS} DebugLn('TECSpinEdit.RewriteText'); {$ENDIF} Text := GetText(FSpinBtns.FValue, FDigits); TextEdited := False; end; procedure TECSpinEdit.SetEnabled(Value: Boolean); begin inherited SetEnabled(Value); FSpinBtns.Enabled := Value; end; procedure TECSpinEdit.SetParent(NewParent: TWinControl); begin inherited SetParent(NewParent); FSpinBtns.Parent := Parent; end; procedure TECSpinEdit.SetRealBoundRect(ARect: TRect); begin if BiDiMode = bdLeftToRight then dec(ARect.Right, Indent + FSpinBtns.Width) else inc(ARect.Left, Indent + FSpinBtns.Width); BoundsRect := ARect; end; procedure TECSpinEdit.SetRealBounds(ALeft, ATop, AWidth, AHeight: Integer); begin if BiDiMode <> bdLeftToRight then ALeft := ALeft + Indent + FSpinBtns.Width; SetBounds(ALeft, ATop, AWidth - Indent - FSpinBtns.Width, AHeight); end; procedure TECSpinEdit.SetSpinBtnsPosition; begin if not IsRightToLeft then FSpinBtns.Left := Left + Width + Indent else FSpinBtns.Left := Left - Indent - FSpinBtns.FWidth; end; procedure TECSpinEdit.SwitchOption(AOption: TSEOption; AOn: Boolean); var aOptions: TSEOptions; begin aOptions := FOptions; if AOn then Include(aOptions, AOption) else Exclude(aOptions, AOption); Options := aOptions; end; function TECSpinEdit.TryGetValueFromString(AString: string; out AValue: Double): Boolean; var aFS: TFormatSettings; d: Double; i: Int64; j: Integer; begin case FValueFormat of evfRound, evfExponential: begin Result := TryStrToFloat(AString, d); if Result then AValue := d; end; evfExponent: begin Result := TryStrToFloat(AString, d); if Result then AValue := logn(FMantissaExp, d); end; evfMantissa: begin Result := TryStrToFloat(AString, d); if Result then AValue := power(d, 1/FMantissaExp); end; evfHexadecimal, evfMarkHexadec: begin if (AString <> '') and (AString[1] <> '$') then AString := '$' + AString; Result := TryStrToInt64(AString, i); if Result then AValue := i; end; evfOctal: begin if (AString <> '') and (AString[1] <> '&') then AString := '&' + AString; Result := TryStrToInt64(AString, i); if Result then AValue := i; end; evfBinary: begin if (AString<>'') and (AString[1] <> '%') then AString := '%' + AString; Result := TryStrToInt64(AString, i); if Result then AValue := i; end; evfDate: begin aFS := DefaultFormatSettings; aFS.LongDateFormat := FDateTimeFormat; Result := TryStrToDate(AString, d, aFS); if Result then AValue := d; end; evfTime: begin aFS := DefaultFormatSettings; aFS.LongTimeFormat := FDateTimeFormat; Result := TryStrToDateTime(AString, d, aFS); if Result then AValue := d; end; evfText: begin AValue := -1; if assigned(FItems) then AValue := FItems.IndexOf(trim(AString)); Result := (AValue > -1); end; evfCombined: begin AString := trim(AString); for j := 1 to length(AString) do if not (AString[j] in ['0'..'9', DefaultFormatSettings.DecimalSeparator, '-', 'e', 'E']) then begin AString := LeftStr(AString, j-1); break; end; Result := TryStrToFloat(AString, d); if Result then AValue := d; end; end; {case} end; procedure TECSpinEdit.VisibleChanged; begin inherited VisibleChanged; FSpinBtns.Visible := Visible; end; { TECSpinEdit.Getters + Setters } function TECSpinEdit.GetController: TECSpinController; begin Result := Buttons.FController; end; function TECSpinEdit.GetValue: Double; begin Result := FSpinBtns.Value; end; function TECSpinEdit.GetWidthInclBtns: Integer; begin Result := Width + Indent + FSpinBtns.Width; end; procedure TECSpinEdit.InitializeWnd; begin inherited InitializeWnd; SetSpinBtnsPosition; end; procedure TECSpinEdit.SetController(AValue: TECSpinController); begin {$IFDEF DBGSPINS} DebugLn('TECSpinEdit.SetController'); {$ENDIF} if Buttons.FController = AValue then exit; if assigned(Buttons.FController) then Buttons.FController.UnRegisterClient(self); Buttons.FController := AValue; if assigned(AValue) then AValue.RegisterClient(self); end; procedure TECSpinEdit.SetDateTimeFormat(AValue: string); begin if FDateTimeFormat = AValue then exit; FDateTimeFormat := AValue; if FValueFormat in [evfDate, evfTime] then RewriteText; end; procedure TECSpinEdit.SetDigits(AValue: Word); begin if FDigits = AValue then exit; FDigits := AValue; RewriteText; end; procedure TECSpinEdit.SetIndent(AValue: SmallInt); begin if FIndent = AValue then exit; FIndent := AValue; SetSpinBtnsPosition; end; procedure TECSpinEdit.SetItems(AValue: TStrings); begin if AValue <> FItems then FItems.Assign(AValue); end; procedure TECSpinEdit.SetMantissaExp(AValue: Double); begin if FMantissaExp = AValue then exit; FMantissaExp := AValue; if FValueFormat in [evfExponent, evfMantissa] then RewriteText; end; procedure TECSpinEdit.SetValue(AValue: Double); begin FSpinBtns.SetValue(AValue, True, True); end; procedure TECSpinEdit.SetValueFormat(AValue: TValueFormat); begin if FValueFormat = AValue then exit; FValueFormat := AValue; RewriteText; end; procedure TECSpinEdit.SetWidthInclBtns(AValue: Integer); begin Width := AValue - Indent - FSpinBtns.Width; end; procedure Register; begin {$I ecspinctrls.lrs} RegisterComponents('EC-C', [TECSpinBtns, TECSpinEdit, TECSpinController, TECTimer]); end; end.