{**************************************************** 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 ECEditBtns; {$mode objfpc}{$H+} //{$DEFINE DBGCTRLS} //don't remove, just comment interface uses Classes, SysUtils, Controls, Graphics, Math, Themes, Types, StdCtrls, ActnList, CustomTimer, Dialogs, Forms, ImgList, Menus, LCLProc, LCLType, LMessages, LResources, ECTypes, LCLIntf; type {$PACKENUM 2} TEBOption = (eboClickAltEnter, eboClickCtrlEnter, eboClickShiftEnter); TEBOptions = set of TEBOption; TItemOrder = (eioFixed, eioHistory, eioSorted); { Event } TOnDrawGlyph = procedure(Sender: TObject; AState: TItemState) of object; const cDefEBOptions = [eboClickAltEnter, eboClickCtrlEnter, eboClickShiftEnter]; type TCustomECSpeedBtn = class; { TECSpeedBtnActionLink } TECSpeedBtnActionLink = class(TWinControlActionLink) protected FClientSpeedBtn: TCustomECSpeedBtn; procedure AssignClient(AClient: TObject); override; procedure SetChecked(Value: Boolean); override; public function IsCheckedLinked: Boolean; override; end; TECSpeedBtnActionLinkClass = class of TECSpeedBtnActionLink; { TCustomECSpeedBtn } TCustomECSpeedBtn = class(TCustomControl) private FAllowAllUp: Boolean; FChecked: Boolean; FCheckFromAction: Boolean; FDelay: Integer; FGlyphColor: TColor; FGlyphDesignChecked: TGlyphDesign; FGlyphDesign: TGlyphDesign; FGroupIndex: Integer; FImageIndex: SmallInt; FImageIndexChecked: SmallInt; FImages: TCustomImageList; FLayout: TObjectPos; FMargin: SmallInt; FSpacing: SmallInt; FOnChange: TNotifyEvent; FOnDrawGlyph: TOnDrawGlyph; FOnRelease: TNotifyEvent; procedure SetAllowAllUp(AValue: Boolean); procedure SetChecked(AValue: Boolean); procedure SetDelay(AValue: Integer); procedure SetGlyphColor(AValue: TColor); procedure SetGlyphDesign(AValue: TGlyphDesign); procedure SetGlyphDesignChecked(AValue: TGlyphDesign); procedure SetGroupIndex(AValue: Integer); procedure SetImageIndex(AValue: SmallInt); procedure SetImageIndexChecked(AValue: SmallInt); procedure SetImages(AValue: TCustomImageList); procedure SetLayout(AValue: TObjectPos); procedure SetMargin(AValue: SmallInt); procedure SetSpacing(AValue: SmallInt); protected const cDefHeight = 23; cDefSpacing = 6; cDefWidth = 21; cMargin: SmallInt = 6; protected BtnBitmapPushedDisabled: TBitmap; BtnDrawnPushed: Boolean; BtnPushed: Boolean; NeedRedraw: Boolean; RealLayout: TObjectPos; Timer: TCustomTimer; ValidStates: TItemStates; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; {%H-}WithThemeSpace: Boolean); override; procedure Click; override; procedure CMBiDiModeChanged(var {%H-}Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMButtonPressed(var Message: TLMessage); message CM_BUTTONPRESSED; procedure CMColorChanged(var {%H-}Message: TLMessage); message CM_COLORCHANGED; procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; procedure CreateValidBitmaps(AEnabled: Boolean); function DialogChar(var Message: TLMKey): boolean; override; procedure DrawButtonBMPs; procedure FontChanged(Sender: TObject); override; function GetActionLinkClass: TControlActionLinkClass; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseEnter; override; procedure MouseLeave; override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; procedure Redraw; procedure ResizeInvalidate; procedure SetAction(Value: TBasicAction); override; procedure SetAutoSize(Value: Boolean); override; procedure SetParent(NewParent: TWinControl); override; procedure TextChanged; override; procedure TimerOnTimer(Sender: TObject); procedure UpdateGroup; procedure WMSize(var Message: TLMSize); message LM_SIZE; property CheckFromAction: Boolean read FCheckFromAction write FCheckFromAction; public BtnBitmaps: array [low(TItemState)..high(TItemState)] of TBitmap; UpdateCount: SmallInt; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure EndUpdate; property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False; property Checked: Boolean read FChecked write SetChecked default False; property Delay: Integer read FDelay write SetDelay default 0; { Delay = 0 - Button; Delay > 0 - Delayed Button; Delay < 0 - Toggle Button } property GlyphColor: TColor read FGlyphColor write SetGlyphColor default clDefault; property GlyphDesign: TGlyphDesign read FGlyphDesign write SetGlyphDesign; { set default in descendants } property GlyphDesignChecked: TGlyphDesign read FGlyphDesignChecked write SetGlyphDesignChecked default egdNone; property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0; property ImageIndex: SmallInt read FImageIndex write SetImageIndex default -1; property ImageIndexChecked: SmallInt read FImageIndexChecked write SetImageIndexChecked default -1; property Images: TCustomImageList read FImages write SetImages; property Layout: TObjectPos read FLayout write SetLayout default eopLeft; property Margin: SmallInt read FMargin write SetMargin default -1; property Spacing: SmallInt read FSpacing write SetSpacing default cDefSpacing; property OnDrawGlyph: TOnDrawGlyph read FOnDrawGlyph write FOnDrawGlyph; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnRelease: TNotifyEvent read FOnRelease write FOnRelease; end; { TECSpeedBtn } TECSpeedBtn = class(TCustomECSpeedBtn) published property Action; property Align; property AllowAllUp; property Anchors; property AutoSize; property BiDiMode; property BorderSpacing; property Caption; property Checked; {property Color;} {does nothing ATM} property Constraints; property Delay; property Enabled; property Font; property GlyphColor; property GlyphDesign default egdNone; property GlyphDesignChecked; property GroupIndex; property ImageIndex; property ImageIndexChecked; property Images; property Layout; property Margin; property PopupMenu; property ParentBiDiMode; {property ParentColor;} {does nothing ATM} property ParentFont; property ParentShowHint; property ShowHint; property Spacing; property Visible; property OnChangeBounds; property OnChange; property OnClick; property OnContextPopup; property OnDrawGlyph; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnRelease; property OnResize; end; { TCustomECSpeedBtnPlus } TCustomECSpeedBtnPlus = class(TCustomECSpeedBtn) protected CustomClick: TObjectMethod; CustomMouseDown: TMouseMethod; CustomMouseUp: TMouseMethod; CustomResize: TObjectMethod; procedure Click; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Resize; override; public constructor Create(AOwner: TComponent); override; published property AnchorSideLeft stored False; property AnchorSideTop stored False; property AnchorSideRight stored False; property AnchorSideBottom stored False; property Height stored False; property Left stored False; property Top stored False; end; { TECSpeedBtnPlus } TECSpeedBtnPlus = class(TCustomECSpeedBtnPlus) published property Caption; property GlyphColor; property GlyphDesign; property ImageIndex; property Images; property Layout; property Margin; property PopupMenu; property ParentShowHint; property ShowHint; property Spacing; property OnChangeBounds; property OnClick; property OnContextPopup; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnResize; end; { TECEditBtnSpacing } TECEditBtnSpacing = class(TControlBorderSpacing) public function GetSpace(Kind: TAnchorKind): Integer; //override; procedure GetSpaceAround(var SpaceAround: TRect); //override; end; { TBaseECEditBtn } TBaseECEditBtn = class(TCustomEdit) private FIndent: SmallInt; FOptions: TEBOptions; function GetWidthInclBtn: Integer; procedure SetIndent(AValue: SmallInt); procedure SetWidthInclBtn(AValue: Integer); protected FAnyButton: TCustomECSpeedBtnPlus; function ChildClassAllowed(ChildClass: TClass): boolean; override; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; function CreateControlBorderSpacing: TControlBorderSpacing; override; procedure DoOnChangeBounds; override; procedure InitializeWnd; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure SetButtonPosition; procedure SetEnabled(Value: Boolean); override; procedure SetParent(NewParent: TWinControl); override; procedure SetVisible(Value: Boolean); override; public constructor Create(AOwner: TComponent); override; procedure SetRealBoundRect(ARect: TRect); procedure SetRealBounds(ALeft, ATop, AWidth, AHeight: Integer); procedure SwitchOption(AOption: TEBOption; AOn: Boolean); property Indent: SmallInt read FIndent write SetIndent default 0; property Options: TEBOptions read FOptions write FOptions default cDefEBOptions; property WidthInclBtn: Integer read GetWidthInclBtn write SetWidthInclBtn stored False; end; { TECEditBtn } TECEditBtn = class(TBaseECEditBtn) private FButton: TECSpeedBtnPlus; public constructor Create(AOwner: TComponent); override; published property Button: TECSpeedBtnPlus read FButton write FButton; property Indent; property Options; property WidthInclBtn; published property Align; property Alignment; property Anchors; property AutoSelect; property AutoSize; property BiDiMode; property BorderSpacing; property BorderStyle; property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property EchoMode; property Enabled; property Font; property HideSelection; property MaxLength; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Text; property Visible; 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; const cDefColorLayout = eclRGBColor; cDefCustomColor = clBlack; type { TECSpeedBtnColor } TECSpeedBtnColor = class(TCustomECSpeedBtnPlus) protected const cDefGlyphDesign = egdWinRectClr; public constructor Create(AOwner: TComponent); override; published property Caption; property GlyphDesign default cDefGlyphDesign; property ImageIndex; property Images; property Layout; property Margin; property PopupMenu; property ParentShowHint; property ShowHint; property Spacing; property OnChangeBounds; property OnClick; property OnContextPopup; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnResize; end; { TECColorBtn } TECColorBtn = class(TBaseECEditBtn) private FButton: TECSpeedBtnColor; FColorLayout: TColorLayout; FCustomColor: TColor; FOnCustomColorChanged: TNotifyEvent; FPrefix: string; procedure SetColorLayout(AValue: TColorLayout); procedure SetCustomColor(AValue: TColor); procedure SetPrefix(AValue: string); protected procedure DoButtonClick; procedure Redraw; public constructor Create(AOwner: TComponent); override; procedure EditingDone; override; published property Button: TECSpeedBtnColor read FButton write FButton; property ColorLayout: TColorLayout read FColorLayout write SetColorLayout default cDefColorLayout; property CustomColor: TColor read FCustomColor write SetCustomColor default cDefCustomColor; property Indent; property Options; property Prefix: string read FPrefix write SetPrefix; property WidthInclBtn; property OnCustomColorChanged: TNotifyEvent read FOnCustomColorChanged write FOnCustomColorChanged; published property Align; property Alignment; property Anchors; property AutoSelect; property AutoSize; property BiDiMode; property BorderSpacing; property BorderStyle; property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property HideSelection; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly default True; property ShowHint; property TabOrder; property TabStop; property Visible; 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; { TECComboBtnSpacing } TECComboBtnSpacing = class(TControlBorderSpacing) public function GetSpace(Kind: TAnchorKind): Integer; //override; procedure GetSpaceAround(var SpaceAround: TRect); //override; end; { TBaseECComboBtn } TBaseECComboBtn = class(TCustomComboBox) private FIndent: SmallInt; FItemOrder: TItemOrder; FMaxCount: Integer; FOptions: TEBOptions; function GetWidthInclBtn: Integer; procedure SetIndent(AValue: SmallInt); procedure SetItemOrder(AValue: TItemOrder); procedure SetMaxCount(AValue: Integer); procedure SetOptions(AValue: TEBOptions); procedure SetWidthInclBtn(AValue: Integer); protected FAnyButton: TCustomECSpeedBtnPlus; function ChildClassAllowed(ChildClass: TClass): boolean; override; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; function CreateControlBorderSpacing: TControlBorderSpacing; override; procedure DoOnChangeBounds; override; procedure InitializeWnd; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure SetButtonPosition; procedure SetEnabled(Value: Boolean); override; procedure SetParent(NewParent: TWinControl); override; procedure SetSorted(Val: boolean); override; procedure SetVisible(Value: Boolean); override; public constructor Create(TheOwner: TComponent); override; procedure Add(AItem: string); procedure AddItemHistory(AItem: string; ACaseSensitive: Boolean); procedure AddItemLimit(AItem: string; ACaseSensitive: Boolean); procedure SetRealBoundRect(ARect: TRect); procedure SetRealBounds(ALeft, ATop, AWidth, AHeight: Integer); property Indent: SmallInt read FIndent write SetIndent default 0; property ItemOrder: TItemOrder read FItemOrder write SetItemOrder; property MaxCount: Integer read FMaxCount write SetMaxCount default 0; property Options: TEBOptions read FOptions write SetOptions default cDefEBOptions; property WidthInclBtn: Integer read GetWidthInclBtn write SetWidthInclBtn stored False; end; { TECComboBtn } TECComboBtn = class(TBaseECComboBtn) private FButton: TECSpeedBtnPlus; protected const cDefItemOrder = eioFixed; public constructor Create(TheOwner: TComponent); override; published property Button: TECSpeedBtnPlus read FButton write FButton; property Indent; property ItemOrder default eioFixed; property Options; property WidthInclBtn; published property Align; property Anchors; property ArrowKeysTraverseList; property AutoComplete; property AutoCompleteText; property AutoDropDown; property AutoSelect; property AutoSize; property BidiMode; property BorderSpacing; property BorderStyle; property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property DropDownCount; property Enabled; property Font; property ItemHeight; property ItemIndex; property Items; property ItemWidth; property MaxCount; property MaxLength; property ParentBidiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property Style; property TabOrder; property TabStop; property Text; property Visible; property OnChange; property OnChangeBounds; property OnClick; property OnCloseUp; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawItem; property OnEndDrag; property OnDropDown; property OnEditingDone; property OnEnter; property OnExit; property OnGetItems; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMeasureItem; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnStartDrag; property OnSelect; property OnUTF8KeyPress; end; { TECColorCombo } TECColorCombo = class(TBaseECComboBtn) private FButton: TECSpeedBtnColor; FColorLayout: TColorLayout; FCustomColor: TColor; FPrefix: string; FOnCustomColorChanged: TNotifyEvent; procedure SetColorLayout(AValue: TColorLayout); procedure SetCustomColor(AValue: TColor); procedure SetPrefix(AValue: string); protected const cDefColorOrder = eioHistory; protected FNeedMeasure: Boolean; FTextTop: SmallInt; FTextWidth: SmallInt; procedure DoButtonClick; procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override; procedure Select; override; { only when ItemIndex changes by mouse } procedure SetItemIndex(const Val: Integer); override; { only when ItemIndex changes by code } procedure SetItemHeight(const AValue: Integer); override; public constructor Create(AOwner: TComponent); override; procedure AddColor(AColor: string); overload; procedure AddColor(AColor: TColor); overload; procedure Validate; published property Button: TECSpeedBtnColor read FButton write FButton; property ColorLayout: TColorLayout read FColorLayout write SetColorLayout default cDefColorLayout; property CustomColor: TColor read FCustomColor write SetCustomColor default cDefCustomColor; property Indent; property ItemOrder default cDefColorOrder; property MaxCount; property Options; property Prefix: string read FPrefix write SetPrefix; property WidthInclBtn; property OnCustomColorChanged: TNotifyEvent read FOnCustomColorChanged write FOnCustomColorChanged; published property Align; property Anchors; property ArrowKeysTraverseList; property AutoDropDown; property AutoSize; property BidiMode; property BorderSpacing; property CharCase; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property DropDownCount; property Enabled; property Font; property ItemHeight; property ItemIndex; property Items; property ParentBidiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property OnChange; property OnChangeBounds; property OnClick; property OnCloseUp; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnDropDown; property OnEditingDone; property OnEnter; property OnExit; property OnGetItems; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnStartDrag; property OnSelect; property OnUTF8KeyPress; end; procedure Register; implementation { TECSpeedBtnActionLink } procedure TECSpeedBtnActionLink.AssignClient(AClient: TObject); begin inherited AssignClient(AClient); FClientSpeedBtn := AClient as TCustomECSpeedBtn; end; function TECSpeedBtnActionLink.IsCheckedLinked: Boolean; begin Result := inherited IsCheckedLinked and (FClientSpeedBtn.Checked = (Action as TCustomAction).Checked); end; procedure TECSpeedBtnActionLink.SetChecked(Value: Boolean); begin if IsCheckedLinked then begin FClientSpeedBtn.CheckFromAction := True; try FClientSpeedBtn.Checked := Value; finally FClientSpeedBtn.CheckFromAction := False; end; end; end; { TCustomECSpeedBtn } constructor TCustomECSpeedBtn.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csNoFocus, csParentBackground, csReplicatable] - csMultiClicks - [csCaptureMouse, csOpaque, csSetCaption]; FGlyphColor := clDefault; FImageIndex := -1; FImageIndexChecked:=-1; FLayout := eopLeft; RealLayout:=eopLeft; FMargin := -1; FSpacing := cDefSpacing; SetInitialBounds(0, 0, cDefWidth, cDefHeight); end; destructor TCustomECSpeedBtn.Destroy; var aState: TItemState; begin for aState := low(TItemState) to high(TItemState) do FreeAndNil(BtnBitmaps[aState]); inherited Destroy; end; procedure TCustomECSpeedBtn.BeginUpdate; begin inc(UpdateCount); end; procedure TCustomECSpeedBtn.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; WithThemeSpace: Boolean); var aCaption: string; aCaptionSize, aGlyphSize: TSize; aMargin: SmallInt; begin aCaption := Caption; if aCaption <> '' then begin DeleteAmpersands(aCaption); aCaptionSize := Canvas.TextExtent(aCaption); end else aCaptionSize := Size(0, 0); if (ImageIndex >= 0) and assigned(Images) and (ImageIndex < Images.Count) then aGlyphSize := Size(Images.Width, Images.Height) else aGlyphSize := Canvas.GlyphExtent(GlyphDesign); if RealLayout in [eopRight, eopLeft] then begin if aGlyphSize.cx*aCaptionSize.cx > 0 then inc(aGlyphSize.cx, Spacing); inc(aGlyphSize.cx, aCaptionSize.cx); if aCaptionSize.cx > 0 then inc(aGlyphSize.cx, 2*Spacing); aGlyphSize.cy := Math.max(aGlyphSize.cy, aCaptionSize.cy); end else begin aGlyphSize.cx := Math.max(aGlyphSize.cx, aCaptionSize.cx); if aGlyphSize.cy*aCaptionSize.cy > 0 then inc(aGlyphSize.cy, Spacing); inc(aGlyphSize.cy, aCaptionSize.cy); end; aMargin := Margin; if aMargin < 0 then aMargin := cMargin; inc(aGlyphSize.cx, 2*aMargin); inc(aGlyphSize.cy, 2*aMargin); aGlyphSize.cx := aGlyphSize.cx or 1; { Odd size glyphs look better } aGlyphSize.cy := aGlyphSize.cy or 1; PreferredWidth := aGlyphSize.cx; PreferredHeight := aGlyphSize.cy; end; procedure TCustomECSpeedBtn.Click; begin case Delay of low(Integer)..-1: if not assigned(Action) then Checked := not Checked; 1..high(Integer): if not Checked then Checked := True else begin Timer.Enabled := False; Timer.Enabled := True; end; end; inherited Click; end; procedure TCustomECSpeedBtn.CMBiDiModeChanged(var Message: TLMessage); var aRealLayout: TObjectPos; begin aRealLayout := Layout; if IsRightToLeft then case aRealLayout of eopRight: aRealLayout := eopLeft; eopLeft: aRealLayout := eopRight; end; RealLayout := aRealLayout; Redraw; end; procedure TCustomECSpeedBtn.CMButtonPressed(var Message: TLMessage); var aSender: TCustomECSpeedBtn; begin if csDestroying in ComponentState then exit; if Message.WParam = WParam(FGroupIndex) then begin aSender := TCustomECSpeedBtn(Message.LParam); if aSender <> self then begin if aSender.Checked and FChecked then begin FChecked := False; Invalidate; end; FAllowAllUp := aSender.AllowAllUp; end; end; end; procedure TCustomECSpeedBtn.CMColorChanged(var Message: TLMessage); begin NeedRedraw := True; end; procedure TCustomECSpeedBtn.CMParentColorChanged(var Message: TLMessage); begin inherited CMParentColorChanged(Message); if not ParentColor then NeedRedraw := True; end; procedure TCustomECSpeedBtn.CreateValidBitmaps(AEnabled: Boolean); var aIState: TItemState; aWidth, aHeight: Integer; begin for aIState in ValidStates do FreeAndNil(BtnBitmaps[aIState]); if AEnabled then ValidStates := caEnabledStates else ValidStates := caDisabledStates; aWidth := Width; aHeight := Height; for aIState in ValidStates do begin BtnBitmaps[aIState] := TBitmap.Create; BtnBitmaps[aIState].SetProperties(aWidth, aHeight); end; end; function TCustomECSpeedBtn.DialogChar(var Message: TLMKey): Boolean; begin Result := False; if Message.Msg = LM_SYSCHAR then begin if IsEnabled and IsVisible then begin if IsAccel(Message.CharCode, Caption) then begin Click; Result := True; end else Result := inherited DialogChar(Message); end; end; end; procedure TCustomECSpeedBtn.DrawButtonBMPs; var aImageIndex, aImgIdxChckd, aLength: Integer; aCaption: string; aFlags: Cardinal; aGlyphDesign, aGlyphDsgnChckd: TGlyphDesign; aGlyphSize, aTextSize: TSize; aPoint: TPoint; aRect: TRect; aState: TItemState; procedure AdjustRect(var ARect: TRect; AWidthLimit, AHeightLimit: SmallInt); var i, j, aLimit: SmallInt; begin i := -4; aLimit := ARect.Right - ARect.Left; if aLimit <= 21 then inc(i); aLimit := aLimit - AWidthLimit; if aLimit > 0 then dec(i, aLimit div 5); j := -4; aLimit := ARect.Bottom - ARect.Top - AHeightLimit; if aLimit > 0 then dec(j, aLimit div 5); InflateRect(ARect, i, j); end; begin {$IFDEF DBGCTRLS} DebugLn('TCustomECSpeedBtn.DrawButton'); {$ENDIF} if assigned(Parent) then begin aRect := ClientRect; for aState in ValidStates do begin BtnBitmaps[aState].TransparentColor := GetColorResolvingDefault(Color, Parent.Brush.Color); BtnBitmaps[aState].TransparentClear; BtnBitmaps[aState].Canvas.DrawButtonBackground(aRect, aState); end; if assigned(OnDrawGlyph) then for aState in ValidStates do OnDrawGlyph(self, aState) else begin aCaption := Caption; DeleteAmpersands(aCaption); aTextSize := Canvas.TextExtent(aCaption); aImageIndex := ImageIndex; aImgIdxChckd := ImageIndexChecked; if assigned(Images) then begin aGlyphSize := Size(Images.Width, Images.Height); if (aImageIndex >= 0) and (aImageIndex < Images.Count) then begin if (aImgIdxChckd < 0) or (aImgIdxChckd >= Images.Count) then aImgIdxChckd := aImageIndex; end else if (aImgIdxChckd >= 0) and (aImgIdxChckd < Images.Count) then aImageIndex := aImgIdxChckd else aImageIndex := -1; end else aImageIndex := -1; if aImageIndex = -1 then begin aGlyphDesign := GlyphDesign; aGlyphDsgnChckd := GlyphDesignChecked; if aGlyphDsgnChckd = egdNone then aGlyphDsgnChckd := aGlyphDesign; if aGlyphDesign = egdNone then aGlyphDesign := GlyphDesignChecked; aGlyphSize := Canvas.GlyphExtent(aGlyphDesign); if aGlyphDesign > egdNone then begin aGlyphSize.cx := aGlyphSize.cx or 1; aGlyphSize.cy := aGlyphSize.cy or 1; end; end; aFlags := DT_SingleLine; if aGlyphSize.cx*aTextSize.cx <> 0 then begin if RealLayout in [eopTop, eopBottom] then begin aFlags := aFlags or DT_CENTER; aLength := aGlyphSize.cy + aTextSize.cy; aPoint.X := (Width - aGlyphSize.cx) div 2; end else begin aFlags := aFlags or DT_VCENTER; aLength := aGlyphSize.cx + aTextSize.cx; aPoint.Y := (Height - aGlyphSize.cy) div 2; end; inc(aLength, Spacing); case RealLayout of eopTop: begin aPoint.Y := (Height - aLength) div 2; aRect.Top := aPoint.Y + aGlyphSize.cy + Spacing; end; eopRight: begin aRect.Left := (Width - aLength) div 2; aPoint.X := aRect.Left + aTextSize.cx + Spacing; end; eopBottom: begin aRect.Top := (Height - aLength) div 2; aPoint.Y := aRect.Top + aTextSize.cy + Spacing; end; eopLeft: begin aPoint.X := (Width - aLength) div 2; aRect.Left := aPoint.X + aGlyphSize.cx + Spacing; end; end; end else begin aFlags := aFlags or DT_VCENTER or DT_CENTER; aPoint := Point((Width - aGlyphSize.cx) div 2, (Height - aGlyphSize.cy) div 2); end; if aTextSize.cx > 0 then begin if UseRightToLeftReading then aFlags := aFlags or DT_RTLREADING; for aState in ValidStates do begin BtnBitmaps[aState].Canvas.Font.Assign(Font); if BtnBitmaps[aState].Canvas.Font.Color = clDefault then BtnBitmaps[aState].Canvas.Font.Color := clBtnText; with ThemeServices do DrawText(BtnBitmaps[aState].Canvas, GetElementDetails(caThemedContent[aState]), Caption, aRect, aFlags, 0); end; end; if aImageIndex >= 0 then begin if Delay = 0 then begin for aState in ValidStates do ThemeServices.DrawIcon(BtnBitmaps[aState].Canvas, ThemeServices.GetElementDetails(caThemedContent[aState]), aPoint, FImages, aImageIndex); end else begin for aState in ValidStates*[eisDisabled, eisHighlighted, eisEnabled] do ThemeServices.DrawIcon(BtnBitmaps[aState].Canvas, ThemeServices.GetElementDetails(caThemedContent[aState]), aPoint, FImages, aImageIndex); for aState in ValidStates*[eisPushed, eisPushedHihlighted, eisPushedDisabled] do ThemeServices.DrawIcon(BtnBitmaps[aState].Canvas, ThemeServices.GetElementDetails(caThemedContent[aState]), aPoint, FImages, aImgIdxChckd); end; end else begin if aTextSize.cx = 0 then begin case aGlyphDesign of egdGrid..egdSizeArrLeft: AdjustRect(aRect, 30, 30); egdRectBeveled..high(TGlyphDesign): AdjustRect(aRect, 85, 30); end; end else aRect := Rect(aPoint.X, aPoint.Y, aPoint.X + aGlyphSize.cx, aPoint.Y + aGlyphSize.cy); if Delay = 0 then begin if aGlyphDesign > egdNone then for aState in ValidStates do begin BtnBitmaps[aState].Canvas.SetRealGlyphColor(GlyphColor, aState); BtnBitmaps[aState].Canvas.DrawGlyph(aRect, aGlyphDesign); end; end else begin if aGlyphDesign > egdNone then for aState in ValidStates*[eisDisabled, eisHighlighted, eisEnabled] do begin BtnBitmaps[aState].Canvas.SetRealGlyphColor(GlyphColor, aState); BtnBitmaps[aState].Canvas.DrawGlyph(aRect, aGlyphDesign) end; if aGlyphDsgnChckd > egdNone then for aState in ValidStates*[eisPushed, eisPushedHihlighted, eisPushedDisabled] do begin BtnBitmaps[aState].Canvas.SetRealGlyphColor(GlyphColor, aState); BtnBitmaps[aState].Canvas.DrawGlyph(aRect, aGlyphDsgnChckd) end; end; end; end; end; NeedRedraw := False; end; procedure TCustomECSpeedBtn.EndUpdate; begin dec(UpdateCount); if UpdateCount = 0 then begin NeedRedraw := True; if AutoSize then begin InvalidatePreferredSize; AdjustSize; end; Invalidate; end; end; procedure TCustomECSpeedBtn.FontChanged(Sender: TObject); begin inherited FontChanged(Sender); NeedRedraw := True; { Invalidate not necessary here } end; function TCustomECSpeedBtn.GetActionLinkClass: TControlActionLinkClass; begin Result := TECSpeedBtnActionLink; end; procedure TCustomECSpeedBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if Button = mbLeft then BtnPushed := True; if not Checked then Invalidate; end; procedure TCustomECSpeedBtn.MouseLeave; begin {$IFDEF DBGCTRLS} DebugLn('TBaseECSpeedBtn.MouseLeave'); {$ENDIF} inherited MouseLeave; if BtnPushed then MouseUp(mbLeft, [ssLeft], 0, 0); Invalidate; end; procedure TCustomECSpeedBtn.MouseEnter; begin inherited MouseEnter; Invalidate; end; procedure TCustomECSpeedBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); BtnPushed := False; if Delay = 0 then Invalidate; { when Delay <> 0 SetChecked cares of Invalidate; } end; procedure TCustomECSpeedBtn.Paint; var aState: TItemState; bEnabled: Boolean; begin {$IFDEF DBGCTRLS} DebugLn('TCustomECSpeedBtn.Paint'); {$ENDIF} inherited Paint; bEnabled := IsEnabled; if (bEnabled xor (eisEnabled in ValidStates)) or (ValidStates=[]) then begin NeedRedraw := True; CreateValidBitmaps(bEnabled); end; if NeedRedraw then DrawButtonBMPs; aState := eisEnabled; if bEnabled then begin if BtnPushed or Checked or (assigned(Timer) and Timer.Enabled) then begin if not MouseEntered then aState := eisPushed else aState := eisPushedHihlighted; end else if MouseEntered then aState := eisHighlighted; end else begin if Checked then aState := eisPushedDisabled else aState := eisDisabled; end; Canvas.Draw(0, 0, BtnBitmaps[aState]); BtnDrawnPushed := (aState in [eisPushed, eisPushedHihlighted]); end; procedure TCustomECSpeedBtn.Redraw; begin NeedRedraw := True; if UpdateCount = 0 then Invalidate; end; procedure TCustomECSpeedBtn.ResizeInvalidate; begin if UpdateCount = 0 then begin; if AutoSize then begin InvalidatePreferredSize; AdjustSize; end; Invalidate; end; end; procedure TCustomECSpeedBtn.SetAction(Value: TBasicAction); begin inherited SetAction(Value); if assigned(Value) and (Value is TCustomAction) and (Value as TCustomAction).AutoCheck then Delay := -1; end; procedure TCustomECSpeedBtn.SetAutoSize(Value: Boolean); begin inherited SetAutoSize(Value); if Value then begin InvalidatePreferredSize; AdjustSize; NeedRedraw := True; Invalidate; end; end; procedure TCustomECSpeedBtn.SetParent(NewParent: TWinControl); begin inherited SetParent(NewParent); NeedRedraw := True; end; procedure TCustomECSpeedBtn.TextChanged; begin inherited TextChanged; NeedRedraw := True; ResizeInvalidate; end; procedure TCustomECSpeedBtn.TimerOnTimer(Sender: TObject); begin Timer.Enabled := False; Checked := False; Invalidate; end; procedure TCustomECSpeedBtn.UpdateGroup; var aMsg : TLMessage; begin if (FGroupIndex <> 0) and (Parent <> nil) and (not (csLoading in ComponentState)) then begin aMsg.Msg := CM_ButtonPressed; aMsg.WParam := FGroupIndex; aMsg.LParam := PtrInt(self); aMsg.Result := 0; Parent.Broadcast(aMsg); end; end; procedure TCustomECSpeedBtn.WMSize(var Message: TLMSize); var aState: TItemState; begin inherited WMSize(Message); for aState in ValidStates do BtnBitmaps[aState].SetSize(Message.Width, Message.Height); Redraw; end; { TCustomECSpeedBtn.Setters } procedure TCustomECSpeedBtn.SetAllowAllUp(AValue: Boolean); begin if FAllowAllUp = AValue then exit; FAllowAllUp := AValue; UpdateGroup; end; procedure TCustomECSpeedBtn.SetChecked(AValue: Boolean); begin if (FChecked = AValue) or (not AValue and (GroupIndex <> 0) and (not AllowAllUp)) then exit; FChecked := AValue; if [csLoading, csDestroying, csDesigning]*ComponentState = [] then begin if GroupIndex <> 0 then UpdateGroup; if AValue then begin if Delay = 0 then Delay := -1; if Delay > 0 then Timer.Enabled := True; end; if assigned(OnChange) then OnChange(self); if not AValue and assigned(OnRelease) then OnRelease(self); end; if not AValue or not BtnDrawnPushed then Invalidate; end; procedure TCustomECSpeedBtn.SetDelay(AValue: Integer); begin if FDelay = AValue then exit; if ((AValue = 0) or (FDelay = 0)) and ((ImageIndex <> ImageIndexChecked) or (GlyphDesign <> GlyphDesignChecked)) then NeedRedraw := True; FDelay := AValue; if AValue >= 0 then begin FGroupIndex := 0; Checked := False; end; if AValue > 0 then begin if not assigned(Timer) then begin Timer := TCustomTimer.Create(self); with Timer do begin Enabled := False; OnTimer := @TimerOnTimer; end; end; Timer.Interval := AValue; end else if assigned(Timer) then FreeAndNil(Timer); end; procedure TCustomECSpeedBtn.SetGlyphColor(AValue: TColor); begin if FGlyphColor = AValue then exit; FGlyphColor := AValue; Redraw; end; procedure TCustomECSpeedBtn.SetGlyphDesign(AValue: TGlyphDesign); begin if FGlyphDesign=AValue then exit; FGlyphDesign:=AValue; NeedRedraw := True; ResizeInvalidate; end; procedure TCustomECSpeedBtn.SetGlyphDesignChecked(AValue: TGlyphDesign); begin if FGlyphDesignChecked = AValue then exit; FGlyphDesignChecked := AValue; Redraw; end; procedure TCustomECSpeedBtn.SetGroupIndex(AValue: Integer); begin if FGroupIndex = AValue then exit; FGroupIndex := AValue; if AValue <> 0 then begin FDelay := -1; { only checkable button makes sense in group } UpdateGroup; end; end; procedure TCustomECSpeedBtn.SetImageIndex(AValue: SmallInt); begin if FImageIndex = AValue then exit; FImageIndex := AValue; NeedRedraw := True; ResizeInvalidate; end; procedure TCustomECSpeedBtn.SetImageIndexChecked(AValue: SmallInt); begin if FImageIndexChecked = AValue then exit; FImageIndexChecked := AValue; Redraw; end; procedure TCustomECSpeedBtn.SetImages(AValue: TCustomImageList); begin if FImages = AValue then exit; FImages := AValue; NeedRedraw := True; ResizeInvalidate; end; procedure TCustomECSpeedBtn.SetLayout(AValue: TObjectPos); begin if FLayout = AValue then exit; FLayout := AValue; if IsRightToLeft then case AValue of eopRight: AValue := eopLeft; eopLeft: AValue := eopRight; end; RealLayout := AValue; NeedRedraw := True; ResizeInvalidate; end; procedure TCustomECSpeedBtn.SetMargin(AValue: SmallInt); begin if FMargin = AValue then exit; FMargin := AValue; NeedRedraw := True; ResizeInvalidate; end; procedure TCustomECSpeedBtn.SetSpacing(AValue: SmallInt); begin if FSpacing = AValue then exit; FSpacing := AValue; NeedRedraw := True; ResizeInvalidate; end; { TCustomECSpeedBtnPlus } constructor TCustomECSpeedBtnPlus.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csNoDesignSelectable]; SetSubComponent(True); end; procedure TCustomECSpeedBtnPlus.Click; begin inherited Click; if assigned(CustomClick) then CustomClick; end; procedure TCustomECSpeedBtnPlus.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if assigned(CustomMouseDown) then CustomMouseDown(Button, Shift); if assigned(Owner) and (Owner is TWinControl) and (Owner as TWinControl).CanFocus then (Owner as TWinControl).SetFocus; end; procedure TCustomECSpeedBtnPlus.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); if assigned(CustomMouseUp) then CustomMouseUp(Button, Shift); end; procedure TCustomECSpeedBtnPlus.Resize; begin inherited Resize; if assigned(CustomResize) then CustomResize; end; { TECEditBtnSpacing } function TECEditBtnSpacing.GetSpace(Kind: TAnchorKind): Integer; begin Result:=inherited GetSpace(Kind); case Kind of akLeft: if Control.IsRightToLeft then inc(Result, TBaseECEditBtn(Control).FAnyButton.Width); akRight: if not Control.IsRightToLeft then inc(Result, TBaseECEditBtn(Control).FAnyButton.Width); end; end; procedure TECEditBtnSpacing.GetSpaceAround(var SpaceAround: TRect); begin inherited GetSpaceAround(SpaceAround); if not Control.IsRightToLeft then inc(SpaceAround.Right, TBaseECEditBtn(Control).FAnyButton.Width) else inc(SpaceAround.Left, TBaseECEditBtn(Control).FAnyButton.Width); end; { TBaseECEditBtn } constructor TBaseECEditBtn.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle - [csSetCaption]; with FAnyButton do begin AnchorParallel(akTop, 0, self); AnchorParallel(akBottom, 0, self); SetButtonPosition; CustomResize := @SetButtonPosition; end; FOptions := cDefEBOptions; end; function TBaseECEditBtn.ChildClassAllowed(ChildClass: TClass): boolean; begin Result := (ChildClass = TCustomECSpeedBtnPlus); end; procedure TBaseECEditBtn.CMBiDiModeChanged(var Message: TLMessage); begin inherited CMBiDiModeChanged(Message); SetButtonPosition; end; function TBaseECEditBtn.CreateControlBorderSpacing: TControlBorderSpacing; begin Result := TECEditBtnSpacing.Create(self); end; procedure TBaseECEditBtn.DoOnChangeBounds; begin inherited DoOnChangeBounds; SetButtonPosition; end; procedure TBaseECEditBtn.InitializeWnd; begin inherited InitializeWnd; SetButtonPosition; end; procedure TBaseECEditBtn.KeyDown(var Key: Word; Shift: TShiftState); begin case Key of VK_RETURN: if ((ssModifier in Shift) and (eboClickCtrlEnter in FOptions)) or ((ssAlt in Shift) and (eboClickAltEnter in FOptions)) or ((ssShift in Shift) and (eboClickShiftEnter in FOptions)) then FAnyButton.Click; VK_SPACE: if (ssModifier in Shift) or ReadOnly then FAnyButton.Click; end; inherited KeyDown(Key, Shift); end; procedure TBaseECEditBtn.SetButtonPosition; begin if not IsRightToLeft then FAnyButton.Left:=Left+Width+Indent else FAnyButton.Left:=Left-Indent-FAnyButton.Width; end; procedure TBaseECEditBtn.SetEnabled(Value: Boolean); begin inherited SetEnabled(Value); FAnyButton.Enabled := Value; end; procedure TBaseECEditBtn.SetParent(NewParent: TWinControl); begin inherited SetParent(NewParent); FAnyButton.Parent := Parent; end; procedure TBaseECEditBtn.SetRealBoundRect(ARect: TRect); begin if BiDiMode = bdLeftToRight then dec(ARect.Right, Indent + FAnyButton.Width) else inc(ARect.Left, Indent + FAnyButton.Width); BoundsRect := ARect; end; procedure TBaseECEditBtn.SetRealBounds(ALeft, ATop, AWidth, AHeight: Integer); begin if BiDiMode <> bdLeftToRight then ALeft := ALeft + Indent + FAnyButton.Width; SetBounds(ALeft, ATop, AWidth - Indent - FAnyButton.Width, AHeight); end; procedure TBaseECEditBtn.SetVisible(Value: Boolean); begin inherited SetVisible(Value); FAnyButton.Visible := Value; end; procedure TBaseECEditBtn.SwitchOption(AOption: TEBOption; AOn: Boolean); var aOptions: TEBOptions; begin aOptions := FOptions; if AOn then Include(aOptions, AOption) else Exclude(aOptions, AOption); Options := aOptions; end; { Setters } function TBaseECEditBtn.GetWidthInclBtn: Integer; begin Result := Width + Indent + FAnyButton.Width; end; procedure TBaseECEditBtn.SetIndent(AValue: SmallInt); begin if FIndent = AValue then exit; FIndent := AValue; SetButtonPosition; end; procedure TBaseECEditBtn.SetWidthInclBtn(AValue: Integer); begin Width := AValue - Indent - FAnyButton.Width; end; { TECEditBtn } constructor TECEditBtn.Create(AOwner: TComponent); begin FButton := TECSpeedBtnPlus.Create(self); FAnyButton := FButton; FButton.Name := 'ECEditBtnButton'; inherited Create(AOwner); end; { TECSpeedBtnColor } constructor TECSpeedBtnColor.Create(AOwner: TComponent); begin inherited Create(AOwner); FGlyphDesign := cDefGlyphDesign; end; { TECColorBtn } constructor TECColorBtn.Create(AOwner: TComponent); begin FButton := TECSpeedBtnColor.Create(self); FAnyButton := FButton; with FButton do begin CustomClick := @DoButtonClick; Name := 'ECCBSpeedBtn'; Width := 27; end; inherited Create(AOwner); ReadOnly := True; FCustomColor := cDefCustomColor; FPrefix := '$'; Redraw; end; procedure TECColorBtn.DoButtonClick; var aAlpha: Integer; aColorDialog: TColorDialog; begin aAlpha := CustomColor and $FF000000; aColorDialog := TColorDialog.Create(self); aColorDialog.Color := CustomColor and $FFFFFF; if aColorDialog.Execute then CustomColor := aAlpha + aColorDialog.Color; aColorDialog.Free; SetFocus; end; procedure TECColorBtn.EditingDone; var aColor: TColor; begin inherited EditingDone; if TryStrToColorLayouted(Text, ColorLayout, aColor) then CustomColor := aColor; end; procedure TECColorBtn.Redraw; var aPrefix: string; begin if ColorLayout <> eclSystemBGR then aPrefix := Prefix else aPrefix := ''; Text := aPrefix + ColorToStrLayouted(CustomColor, ColorLayout); end; { Setters } procedure TECColorBtn.SetCustomColor(AValue: TColor); begin if FCustomColor = AValue then exit; FCustomColor := AValue; FButton.GlyphColor := AValue and $FFFFFF; Redraw; if assigned(OnCustomColorChanged) then OnCustomColorChanged(self); end; procedure TECColorBtn.SetColorLayout(AValue: TColorLayout); begin if FColorLayout = AValue then exit; FColorLayout := AValue; Redraw; end; procedure TECColorBtn.SetPrefix(AValue: string); begin if FPrefix = AValue then exit; FPrefix := AValue; Redraw; end; { TECComboBtnSpacing } function TECComboBtnSpacing.GetSpace(Kind: TAnchorKind): Integer; begin Result:=inherited GetSpace(Kind); case Kind of akLeft: if Control.IsRightToLeft then inc(Result, TBaseECComboBtn(Control).FAnyButton.Width); akRight: if not Control.IsRightToLeft then inc(Result, TBaseECComboBtn(Control).FAnyButton.Width); end; end; procedure TECComboBtnSpacing.GetSpaceAround(var SpaceAround: TRect); begin inherited GetSpaceAround(SpaceAround); if not Control.IsRightToLeft then inc(SpaceAround.Right, TBaseECComboBtn(Control).FAnyButton.Width) else inc(SpaceAround.Left, TBaseECComboBtn(Control).FAnyButton.Width); end; { TBaseECComboBtn } constructor TBaseECComboBtn.Create(TheOwner: TComponent); begin inherited Create(TheOwner); ControlStyle := ControlStyle - [csSetCaption]; with FAnyButton do begin AnchorParallel(akTop, 0, self); AnchorParallel(akBottom, 0, self); SetButtonPosition; CustomResize := @SetButtonPosition; end; FOptions := cDefEBOptions; end; procedure TBaseECComboBtn.Add(AItem: string); begin case ItemOrder of eioFixed: AddItemLimit(AItem, False); eioHistory: AddItemHistory(AItem, False); eioSorted: AddItemLimit(AItem, False); end; end; procedure TBaseECComboBtn.AddItemHistory(AItem: string; ACaseSensitive: Boolean); var aMaxCount: Integer; begin aMaxCount := MaxCount; if aMaxCount <= 0 then aMaxCount := high(Integer); AddHistoryItem(aItem, aMaxCount, True, ACaseSensitive); end; procedure TBaseECComboBtn.AddItemLimit(AItem: string; ACaseSensitive: Boolean); var i, aCount: Integer; aDuplicates: TDuplicates; begin aDuplicates := TStringList(Items).Duplicates; Items.BeginUpdate; if (aDuplicates <> dupAccept) and not TStringList(Items).Sorted then begin if not ACaseSensitive then begin for i := Items.Count -1 downto 0 do if AnsiCompareText(Items[i], AItem) = 0 then case aDuplicates of dupIgnore: Items.Delete(i); dupError: begin Items.EndUpdate; Exit; { Exit! } end; end; end else begin for i := Items.Count -1 downto 0 do if Items[i] = AItem then case aDuplicates of dupIgnore: Items.Delete(i); dupError: begin Items.EndUpdate; Exit; { Exit! } end; end; end; end; if not TStringList(Items).Sorted then Items.Insert(Items.Count, AItem) { add new item to the end } else Items.Add(AItem); { or somewhere ...} { remove overflow item from the beginning; it works on sorted list too, so beware } aCount := MaxCount; if aCount <= 0 then aCount := high(Integer); for i := 1 to Items.Count - aCount do Items.Delete(0); Items.EndUpdate; end; function TBaseECComboBtn.ChildClassAllowed(ChildClass: TClass): boolean; begin Result := (ChildClass = TCustomECSpeedBtnPlus); end; procedure TBaseECComboBtn.CMBiDiModeChanged(var Message: TLMessage); begin inherited CMBiDiModeChanged(Message); SetButtonPosition; end; function TBaseECComboBtn.CreateControlBorderSpacing: TControlBorderSpacing; begin Result := TECComboBtnSpacing.Create(self); end; procedure TBaseECComboBtn.DoOnChangeBounds; begin inherited DoOnChangeBounds; SetButtonPosition; end; procedure TBaseECComboBtn.InitializeWnd; begin inherited InitializeWnd; SetButtonPosition; end; procedure TBaseECComboBtn.KeyDown(var Key: Word; Shift: TShiftState); begin case Key of VK_RETURN: begin if ((ssModifier in Shift) and (eboClickCtrlEnter in Options)) or ((ssAlt in Shift) and (eboClickAltEnter in Options)) or ((ssShift in Shift) and (eboClickShiftEnter in Options)) then FAnyButton.Click; end; VK_SPACE: if (ssModifier in Shift) or ReadOnly then FAnyButton.Click; end; inherited KeyDown(Key, Shift); end; procedure TBaseECComboBtn.SetButtonPosition; begin if not IsRightToLeft then FAnyButton.Left:=Left+Width+Indent else FAnyButton.Left:=Left-Indent-FAnyButton.Width; end; procedure TBaseECComboBtn.SetEnabled(Value: Boolean); begin inherited SetEnabled(Value); FAnyButton.Enabled := Value; end; procedure TBaseECComboBtn.SetParent(NewParent: TWinControl); begin inherited SetParent(NewParent); FAnyButton.Parent := NewParent; if assigned(NewParent) then SetButtonPosition; end; procedure TBaseECComboBtn.SetRealBoundRect(ARect: TRect); begin if BiDiMode = bdLeftToRight then dec(ARect.Right, Indent + FAnyButton.Width) else inc(ARect.Left, Indent + FAnyButton.Width); BoundsRect := ARect; end; procedure TBaseECComboBtn.SetRealBounds(ALeft, ATop, AWidth, AHeight: Integer); begin if BiDiMode <> bdLeftToRight then ALeft := ALeft + Indent + FAnyButton.Width; SetBounds(ALeft, ATop, AWidth - Indent - FAnyButton.Width, AHeight); end; procedure TBaseECComboBtn.SetSorted(Val: boolean); begin if Val then FItemOrder := eioSorted; inherited SetSorted(Val); end; procedure TBaseECComboBtn.SetVisible(Value: Boolean); begin inherited SetVisible(Value); FAnyButton.Visible := Value; end; { TBaseECComboBtn.Setters } function TBaseECComboBtn.GetWidthInclBtn: Integer; begin Result := Width + Indent + FAnyButton.Width; end; procedure TBaseECComboBtn.SetIndent(AValue: SmallInt); begin if FIndent = AValue then exit; FIndent := AValue; SetButtonPosition; end; procedure TBaseECComboBtn.SetItemOrder(AValue: TItemOrder); begin if FItemOrder = AValue then exit; FItemOrder := AValue; Sorted := (AValue = eioSorted); end; procedure TBaseECComboBtn.SetMaxCount(AValue: Integer); var i: Integer; begin if FMaxCount=AValue then exit; FMaxCount:=AValue; if (AValue > 0) and (AValue < Items.Count) then begin Items.BeginUpdate; for i := Items.Count - 1 downto AValue do Items.Delete(i); Items.EndUpdate; end; end; procedure TBaseECComboBtn.SetOptions(AValue: TEBOptions); begin if FOptions = AValue then exit; FOptions := AValue; end; procedure TBaseECComboBtn.SetWidthInclBtn(AValue: Integer); begin Width := AValue - Indent - FAnyButton.Width; end; { TECComboBtn } constructor TECComboBtn.Create(TheOwner: TComponent); begin FButton := TECSpeedBtnPlus.Create(self); FAnyButton := FButton; FButton.Name := 'ECCSpeedBtn'; FItemOrder := cDefItemOrder; inherited Create(TheOwner); end; { TECColorCombo } constructor TECColorCombo.Create(AOwner: TComponent); begin FButton := TECSpeedBtnColor.Create(self); FAnyButton := FButton; with FButton do begin CustomClick := @DoButtonClick; Name := 'ECCCSpeedBtn'; Width := 27; end; inherited Create(AOwner); TStringList(Items).Duplicates := dupIgnore; ReadOnly := True; FItemOrder := cDefColorOrder; FCustomColor := cDefCustomColor; FPrefix := '$'; Style := csOwnerDrawFixed; FNeedMeasure := True; end; procedure TECColorCombo.AddColor(AColor: string); var anyColor: TColor; begin if TryStrToColorLayouted(AColor, ColorLayout, anyColor) then AddColor(anyColor); end; procedure TECColorCombo.AddColor(AColor: TColor); var aPrefix: string; begin if ColorLayout <> eclSystemBGR then aPrefix := Prefix else aPrefix := ''; case ItemOrder of eioFixed: AddItemLimit(aPrefix + ColorToStrLayouted(AColor, ColorLayout), False); eioHistory: begin AddItemHistory(aPrefix + ColorToStrLayouted(AColor, ColorLayout), False); ItemIndex := 0; end; eioSorted: Items.Add(aPrefix + ColorToStrLayouted(AColor, ColorLayout)); end; end; procedure TECColorCombo.DoButtonClick; var aAlpha: Integer; aColorDialog: TColorDialog; begin aAlpha := CustomColor and $FF000000; aColorDialog := TColorDialog.Create(self); aColorDialog.Color := CustomColor and $FFFFFF; if aColorDialog.Execute then CustomColor := aAlpha + aColorDialog.Color; aColorDialog.Free; SetFocus; end; procedure TECColorCombo.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); var aColor: TColor; aExtent: TSize; begin { do not call inherited ! } {$IFDEF DBGCTRLS} DebugLn('DrawItem', ColorToString(Canvas.Brush.Color)); {$ENDIF} if not (odSelected in State) then Canvas.Brush.Color := clWindow; if (Index <> 0) or (ARect.Top = 0) then Canvas.FillRect(ARect); if FNeedMeasure then begin if ColorLayout in [eclRGBColor, eclBGRColor, eclCMYColor, eclYMCColor] then aExtent := Canvas.TextExtent(Prefix + 'F9CDEB') else aExtent := Canvas.TextExtent(Prefix + 'F9CDEBA8'); FTextTop := (ARect.Bottom - ARect.Top - aExtent.cy) div 2;; FTextWidth := aExtent.cx; FNeedMeasure := False; end; Canvas.Brush.Style := bsClear; if not (odSelected in State) or ((Index = 0) and (ARect.Top <> 0)) then Canvas.Font.Color := clWindowText else Canvas.Font.Color := clHighlightText; Canvas.TextOut(ARect.Left + 3, ARect.Top + FTextTop, Items[Index]); if TryStrToColorLayouted(Items[Index], ColorLayout, aColor) then with Canvas do begin Brush.Style := bsSolid; Brush.Color := aColor; Rectangle(ARect.Left + FTextWidth + 5, ARect.Top + 1, ARect.Right - 3, ARect.Bottom - 1); if (Index = 0) and (Items.Count <= 1) then CustomColor := aColor; end; end; procedure TECColorCombo.Validate; var aColor: TColor; begin if TryStrToColorLayouted(Text, ColorLayout, aColor) then CustomColor := aColor; end; procedure TECColorCombo.Select; { only when ItemIndex changes by mouse } var aColor: TColor; begin {$IFDEF DBGCTRLS} DebugLn('Select ', inttostr(ItemIndex)); {$ENDIF} if ItemOrder = eioHistory then begin Items.Move(ItemIndex, 0); ItemIndex := 0; end; inherited Select; if (ItemOrder <> eioHistory) and TryStrToColorLayouted(Items[ItemIndex], ColorLayout, aColor) then CustomColor := aColor; end; procedure TECColorCombo.SetItemIndex(const Val: Integer); { only when ItemIndex changes by code } var aColor: TColor; aLoading: Boolean; aText: string; begin {$IFDEF DBGCTRLS} DebugLn('TECColorCombo.SetItemIndex'); {$ENDIF} aLoading := (csLoading in ComponentState); if not aLoading and (ItemOrder = eioHistory) then begin if (Val > 0) and (Val < Items.Count) then Items.Move(Val, 0); inherited SetItemIndex(0); end else inherited SetItemIndex(Val); if not aLoading then begin if Val >= 0 then aText := Items[Val] else aText := Text; if TryStrToColorLayouted(aText, ColorLayout, aColor) then CustomColor := aColor; end; end; { TECColorCombo.Setters } procedure TECColorCombo.SetColorLayout(AValue: TColorLayout); var aColor: TColor; i: Integer; aOldLayout: TColorLayout; aPrefix: string; begin if FColorLayout = AValue then exit; aOldLayout := FColorLayout; FColorLayout := AValue; FNeedMeasure := True; if not (AValue = eclSystemBGR) then aPrefix := Prefix else aPrefix := ''; for i := 0 to Items.Count - 1 do if TryStrToColorLayouted(Items[i], aOldLayout, aColor) then Items[i] := aPrefix + ColorToStrLayouted(aColor, AValue); end; procedure TECColorCombo.SetCustomColor(AValue: TColor); var aColorString: string; aIndex: Integer; begin {$IFDEF DBGCTRLS} DebugLn('SetCustomColor ', ColorToString(AValue)); {$ENDIF} if FCustomColor = AValue then exit; FCustomColor := AValue; FButton.GlyphColor := AValue and $FFFFFF; if not (csLoading in ComponentState) then begin aColorString := ColorToStrLayouted(AValue, ColorLayout); if ColorLayout <> eclSystemBGR then aColorString := Prefix + aColorString; aIndex := Items.IndexOf(aColorString); case ItemOrder of eioFixed: begin if aIndex = -1 then begin aIndex := Items.Add(aColorString); ItemIndex := aIndex; end else ItemIndex := aIndex; end; eioHistory: begin if aIndex = -1 then Items.Insert(0, aColorString) else Items.Move(aIndex, 0); ItemIndex := 0; end; eioSorted: begin if aIndex = -1 then begin Items.Add(aColorString); TStringList(Items).Sort; ItemIndex := TStringList(Items).IndexOf(aColorString); end else ItemIndex := aIndex; end; end; if assigned(OnCustomColorChanged) then OnCustomColorChanged(self); end; end; procedure TECColorCombo.SetItemHeight(const AValue: Integer); begin inherited SetItemHeight(AValue); FNeedMeasure := True; end; procedure TECColorCombo.SetPrefix(AValue: string); var i: Integer; begin if FPrefix = AValue then exit; FPrefix := AValue; FNeedMeasure := True; if ColorLayout <> eclSystemBGR then for i := 0 to Items.Count - 1 do Items[i] := AValue + TrimColorString(Items[i]); end; procedure Register; begin {$I eceditbtns.lrs} RegisterComponents('EC-C', [TECSpeedBtn, TECEditBtn, TECColorBtn, TECComboBtn, TECColorCombo]); end; end.