📄 spcategorybuttons.pas
字号:
{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ DynamicSkinForm }
{ Version 9.15 }
{ }
{ Copyright (c) 2000-2008 Almediadev }
{ ALL RIGHTS RESERVED }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit spCategoryButtons;
interface
uses
Windows, SysUtils, Classes, Controls, ImgList, Forms, Messages,
Graphics, StdCtrls, ActnList, SkinData, SkinCtrls, ExtCtrls,
spUtils;
const
crDragCopy = TCursor(-23); { New cursor, with a plus for copying }
type
TspBaseButtonItem = class;
TspBaseButtonItemClass = class of TspBaseButtonItem;
TspButtonItem = class;
TspButtonItemClass = class of TspButtonItem;
TspButtonCategory = class;
TspButtonCategoryClass = class of TspButtonCategory;
TspButtonCategories = class;
TspButtonCategoriesClass = class of TspButtonCategories;
TspButtonItemActionLink = class;
TspButtonItemActionLinkClass = class of TspButtonItemActionLink;
{ TButtonDrawState }
{
bsbdsSelected: Item is selected and in the "down" state
bsbdsHot: Item has the mouse over it
bsbdsFocused: Item should show focus
bsbdsDown: Item is being pressed by the user
bsbdsDragged: The drag image for that button is being drawn
bsbdsInsertLeft: Show that an item can be inserted to the left of this item
bdsInsertTop: Show that an item can be inserted above this item
bsbdsInsertRight: Show that an item can be inserted to the right of this item
bsbdsInsertBottom: Show that an item can be inserted below this item
}
TspButtonDrawState = set of (spbdsSelected, spbdsHot, spbdsFocused, spbdsDown,
spbdsDragged, spbdsInsertLeft, spbdsInsertTop, spbdsInsertRight, spbdsInsertBottom);
TspCatButtonOptions = set of (spboAllowReorder, spboAllowCopyingButtons,
spboFullSize, spboShowCaptions, spboVerticalCategoryCaptions, spboBoldCaptions,
spboUsePlusMinus);
TspCatButtonEvent = procedure(Sender: TObject; const Button: TspButtonItem) of object;
TspCatButtonGetHint = procedure(Sender: TObject; const Button: TspButtonItem;
const Category: TspButtonCategory; var HintStr: string; var Handled: Boolean) of object;
TspCatButtonDrawEvent = procedure(Sender: TObject;
const Button: TspButtonItem; Canvas: TCanvas; Rect: TRect;
State: TspButtonDrawState) of object;
TspCatButtonDrawIconEvent = procedure(Sender: TObject;
const Button: TspButtonItem; Canvas: TCanvas; Rect: TRect;
State: TspButtonDrawState; var TextOffset: Integer) of object;
TspCatButtonReorderEvent = procedure(Sender: TObject; const Button: TspButtonItem;
const SourceCategory, TargetCategory: TspButtonCategory) of object;
TspCatButtonCopyEvent = procedure(Sender: TObject;
const SourceButton, CopiedButton: TspButtonItem) of object;
TspCategoryReorderEvent = procedure(Sender: TObject; const SourceCategory,
TargetCategory: TspButtonCategory) of object;
TspCategoryCollapseEvent = procedure(Sender: TObject;
const Category: TspButtonCategory) of object;
TspCatButtonFlow = (bscbfVertical, bscbfHorizontal);
TspSkinCategoryButtons = class(TspSkinControl)
private
FIs9XOS: Boolean;
FMouseTimer: TTimer;
FButtonsSkinDataName: String;
FCategorySkinDataName: String;
FShowBorder: Boolean;
FSkinScrollBar: TspSkinScrollBar;
FButtonFlow: TspCatButtonFlow;
FCollapsedHeight: Integer;
FDownButton: TspButtonItem;
FDragButton: TspButtonItem;
FDragCategory: TspButtonCategory;
FDragStartPos: TPoint;
FDragStarted: Boolean;
FDragImageList: TDragImageList;
FGutterSize: Integer; { Also, used as the scroll size }
FSideBufferSize: Integer;
FHotButton: TspButtonItem;
FImageChangeLink: TChangeLink;
FImages: TCustomImageList;
FInsertLeft, FInsertTop, FInsertRight, FInsertBottom: TspButtonItem;
FIgnoreUpdate: Boolean;
FScrollBarMax: Integer;
FSCROLLBARPOS: Integer;
FPageAmount: Integer;
FButtonCategories: TspButtonCategories;
FButtonOptions: TspCatButtonOptions;
FButtonWidth, FButtonHeight: Integer;
FSelectedItem: TspButtonItem;
FFocusedItem: TspButtonItem;
FMouseInControl: Boolean;
FOnButtonClicked: TspCatButtonEvent;
FOnCopyButton: TspCatButtonCopyEvent;
FOnSelectedItemChange: TspCatButtonEvent;
FOnHotButton: TspCatButtonEvent;
FOnGetHint: TspCatButtonGetHint;
FOnDrawButton: TspCatButtonDrawEvent;
FOnBeforeDrawButton: TspCatButtonDrawEvent;
FOnAfterDrawButton: TspCatButtonDrawEvent;
FOnMouseLeave: TNotifyEvent;
FOnReorderButton: TspCatButtonReorderEvent;
FOnReorderCategory: TspCategoryReorderEvent;
FOnCategoryCollapase: TspCategoryCollapseEvent;
FOnClick: TNotifyEvent;
FHotButtonColor, FSelectedButtonColor, FRegularButtonColor: TColor;
FUseSkinFont: Boolean;
//
procedure OnMouseTimerEvent(Sender: TObject);
procedure AdjustScrollBar;
function GetScrollSize: Integer;
procedure SBChange(Sender: TObject);
procedure SBUpClick(Sender: TObject);
procedure SBDownClick(Sender: TObject);
procedure SBPageUp(Sender: TObject);
procedure SBPageDown(Sender: TObject);
//
procedure AutoScroll(ScrollCode: TScrollCode);
procedure ImageListChange(Sender: TObject);
function CalcButtonsPerRow: Integer;
function CalcButtonsPerCol: Integer;
procedure CalcBufferSizes;
function CalcCategoryHeight(const Category: TspButtonCategory;
const ButtonsPerRow: Integer): Integer;
function CalcCategoryWidth(const Category: TspButtonCategory;
const ButtonsPerCol: Integer): Integer;
procedure DrawCategory(const Category: TspButtonCategory;
const Canvas: TCanvas; StartingPos: Integer);
procedure DrawSkinCategory(const Category: TspButtonCategory;
const Canvas: TCanvas; StartingPos: Integer);
procedure GetCategoryBounds(const Category: TspButtonCategory;
const StartingPos: Integer; var CategoryBounds,
ButtonBounds: TRect);
function GetChevronBounds(const CategoryBounds: TRect): TRect;
function GetIndexOfFirstCategory: Integer;
function GetNextButtonInGroup(const StartingButton: TspButtonItem;
GoForward: Boolean): TspButtonItem;
function GetNextButton(const StartingButton: TspButtonItem;
GoForward: Boolean): TspButtonItem;
function GetScrollOffset: Integer;
function GetScrollBuffer: Integer;
procedure ScrollPosChanged(ScrollCode: TScrollCode;
ScrollPos: Integer);
procedure SetOnDrawButton(const Value: TspCatButtonDrawEvent);
procedure SetButtonCategories(const Value: TspButtonCategories);
procedure SetButtonHeight(const Value: Integer);
procedure SetCatButtonOptions(const Value: TspCatButtonOptions);
procedure SetButtonWidth(const Value: Integer);
procedure SetFocusedItem(const Value: TspButtonItem);
procedure SetImages(const Value: TCustomImageList);
procedure SetSelectedItem(const Value: TspButtonItem);
procedure ShowSkinScrollBar(const Visible: Boolean);
procedure SetHotButtonColor(const Value: TColor);
procedure SetRegularButtonColor(const Value: TColor);
procedure SetSelectedButtonColor(const Value: TColor);
procedure SetButtonFlow(const Value: TspCatButtonFlow);
function ShouldScrollDown(out Delay: Integer): Boolean;
function ShouldScrollUp(out Delay: Integer): Boolean;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CNKeydown(var Message: TWMKeyDown); message CN_KEYDOWN;
procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure SetDragButton(const Value: TspButtonItem);
procedure SetShowBorder(Value: Boolean);
protected
procedure PaintBorder(ADC: HDC; AUseExternalDC: Boolean);
procedure PaintSkinBorder(ADC: HDC; AUseExternalDC: Boolean);
procedure PaintDefaultBorder(ADC: HDC; AUseExternalDC: Boolean);
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
procedure BeginAutoDrag; override;
procedure CreateHandle; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure DoBeginDrag(Immediate: Boolean; Threshold: Integer); virtual;
procedure DoCopyButton(const Button: TspButtonItem;
const TargetCategory: TspButtonCategory; const TargetButton: TspButtonItem); dynamic;
procedure DoEndDrag(Target: TObject; X: Integer; Y: Integer); override;
procedure DoHotButton; dynamic;
procedure DoMouseLeave; dynamic;
procedure DoReorderButton(const Button: TspButtonItem;
const TargetCategory: TspButtonCategory; const TargetButton: TspButtonItem); dynamic;
procedure DoReorderCategory(const SourceCategory,
TargetCategory: TspButtonCategory); dynamic;
procedure DoStartDrag(var DragObject: TDragObject); override;
procedure DragOver(Source: TObject; X: Integer; Y: Integer;
State: TDragState; var Accept: Boolean); override;
procedure DrawButton(const Button: TspButtonItem; Canvas: TCanvas;
Rect: TRect; State: TspButtonDrawState); virtual;
procedure DrawSkinButton(const Button: TspButtonItem; Canvas: TCanvas;
Rct: TRect; State: TspButtonDrawState);
procedure DrawStretchSkinButton(const Button: TspButtonItem; Canvas: TCanvas;
Rct: TRect; State: TspButtonDrawState);
procedure DoItemClicked(const Button: TspButtonItem); dynamic;
procedure DoSelectedItemChanged(const Button: TspButtonItem); dynamic;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function GetAllowReorder: Boolean; dynamic;
function GetDragImages: TDragImageList; override;
function GetButtonCategoriesClass: TspButtonCategoriesClass; virtual;
function GetButtonCategoryClass: TspButtonCategoryClass; virtual;
function GetButtonItemClass: TspButtonItemClass; virtual;
function GetScrollPos: Integer;
procedure SetScrollPos(const Value: Integer);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Resize; override;
procedure ScrollRectIntoView(const Rect: TRect);
procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CMBENCPaint(var Message: TMessage); message CM_BENCPAINT;
procedure CMSENCPaint(var Message: TMessage); message CM_SENCPAINT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure Assign(Source: TPersistent); override;
procedure ChangeSkinData; override;
{ DragButton: If a drag operation is coming from this control, it is
becuase they are dragging this item, or the category. One can
write to it if they want to control what button is being dragged. }
property DragButton: TspButtonItem read FDragButton write SetDragButton;
property DragCategory: TspButtonCategory read FDragCategory write FDragCategory;
property DragImageList: TDragImageList read FDragImageList;
procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override;
function GetButtonRect(const Button: TspButtonItem): TRect;
function GetCategoryRect(const Category: TspButtonCategory): TRect;
function GetButtonAt(X, Y: Integer;
Category: TspButtonCategory = nil): TspButtonItem;
function GetCategoryAt(X, Y: Integer): TspButtonCategory;
procedure RemoveInsertionPoints;
procedure ScrollIntoView(const Button: TspButtonItem); overload;
procedure ScrollIntoView(const Category: TspButtonCategory); overload;
{ SetInsertionButton: Call this to set the current insertion "marks".
Call RemoveInsertionPoints to remove the "marks". }
procedure SetInsertionButton(InsertionButton: TspButtonItem;
InsertionCategory: TspButtonCategory);
{ GetTargetAt: Gives you the target insertion point in the given group.
TargetButton may be nil, while the TargetCategory is not (or, both may be nil)}
procedure GetTargetAt(X, Y: Integer; var TargetButton: TspButtonItem;
var TargetCategory: TspButtonCategory);
procedure UpdateButton(const Button: TspButtonItem);
procedure UpdateAllButtons;
property SelectedItem: TspButtonItem read FSelectedItem write SetSelectedItem;
property FocusedItem: TspButtonItem read FFocusedItem write SetFocusedItem;
published
property UsesSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property Align;
property Anchors;
property ShowBoder: Boolean read FShowBorder write SetShowBorder;
property ButtonsSkinDataName: String read FButtonsSkinDataName write FButtonsSkinDataName;
property CategorySkinDataName: String read FCategorySkinDataName write FCategorySkinDataName;
property ButtonFlow: TspCatButtonFlow read FButtonFlow write SetButtonFlow;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 24;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 24;
property ButtonOptions: TspCatButtonOptions read FButtonOptions
write SetCatButtonOptions default [spboShowCaptions, spboVerticalCategoryCaptions];
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property Height default 100;
property Images: TCustomImageList read FImages write SetImages;
property Categories: TspButtonCategories read FButtonCategories write SetButtonCategories;
property Color default clWindow;
property Cursor;
property HotButtonColor: TColor read FHotButtonColor write SetHotButtonColor default $00EFD3C6;
property PopupMenu;
property RegularButtonColor: TColor read FRegularButtonColor write SetRegularButtonColor nodefault;
property SelectedButtonColor: TColor read FSelectedButtonColor write SetSelectedButtonColor nodefault;
property ShowHint;
property TabOrder;
property TabStop default True;
property Width default 100;
property Visible;
property OnAfterDrawButton: TspCatButtonDrawEvent read FOnAfterDrawButton write FOnAfterDrawButton;
property OnBeforeDrawButton: TspCatButtonDrawEvent read FOnBeforeDrawButton write FOnBeforeDrawButton;
property OnButtonClicked: TspCatButtonEvent read FOnButtonClicked write FOnButtonClicked;
property OnCategoryCollapase: TspCategoryCollapseEvent read FOnCategoryCollapase write FOnCategoryCollapase;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnContextPopup;
property OnCopyButton: TspCatButtonCopyEvent read FOnCopyButton write FOnCopyButton;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnDrawButton: TspCatButtonDrawEvent read FOnDrawButton write SetOnDrawButton;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetHint: TspCatButtonGetHint read FOnGetHint write FOnGetHint;
property OnHotButton: TspCatButtonEvent read FOnHotButton write FOnHotButton;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnReorderButton: TspCatButtonReorderEvent read FOnReorderButton write FOnReorderButton;
property OnReorderCategory: TspCategoryReorderEvent read FOnReorderCategory write FOnReorderCategory;
property OnMouseDown;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnSelectedItemChange: TspCatButtonEvent read FOnSelectedItemChange write FOnSelectedItemChange;
property OnStartDock;
property OnStartDrag;
end;
TspBaseButtonItem = class(TCollectionItem)
private
FActionLink: TspButtonItemActionLink;
FImageIndex: TImageIndex;
FCaption: string;
FData: Pointer;
FHint: string;
FOnClick: TNotifyEvent;
procedure SetAction(const Value: TBasicAction);
procedure SetCaption(const Value: string);
procedure SetImageIndex(const Value: TImageIndex);
function GetAction: TBasicAction;
procedure DoActionChange(Sender: TObject);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
function IsImageIndexStored: Boolean;
function IsOnClickStored: Boolean;
protected
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
function GetNotifyTarget: TComponent; virtual; abstract;
function GetDisplayName: string; override;
function GetActionLinkClass: TspButtonItemActionLinkClass; virtual;
property ActionLink: TspButtonItemActionLink read FActionLink write FActionLink;
public
constructor Create(Collection: TCollection); override;
procedure Assign(Source: TPersistent); override;
property Data: Pointer read FData write FData;
procedure ScrollIntoView; virtual; abstract;
published
property Action: TBasicAction read GetAction write SetAction;
property Caption: string read FCaption write SetCaption stored IsCaptionStored;
property Hint: string read FHint write FHint stored IsHintStored;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored;
property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored;
end;
TspButtonItem = class(TspBaseButtonItem)
private
{ FInterfaceData: IInterface; }
function GetButtonGroup: TspSkinCategoryButtons;
function GetCategory: TspButtonCategory;
protected
function GetNotifyTarget: TComponent; override;
public
procedure Assign(Source: TPersistent); override;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -