scomboboxes.pas

AlphaControls是一个Delphi标准控件的集合

unit sComboBoxes;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ToolWin, ExtCtrls, sConst, sUtils, sGraphUtils,
  sGlyphUtils, math, sStyleEdits, sCommonData, ImgList, sDefaults;

Type
  TsCommonCombo = class;

  TsCustomComboBoxStrings = class(TStrings)
  private
    FComboBox: TsCommonCombo;
  protected
    function GetCount: Integer; override;
    function Get(Index: Integer): string; override;
    function GetObject(Index: Integer): TObject; override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
    property ComboBox: TsCommonCombo read FComboBox write FComboBox;
  public
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    function IndexOf(const S: string): Integer; override;
  end;

  TsCustomComboBoxStringsClass = class of TsCustomComboBoxStrings;

  TsComboBoxStrings = class(TsCustomComboBoxStrings)
  public
    function Add(const S: string): Integer; override;
    procedure Insert(Index: Integer; const S: string); override;
  end;

  TsCustomListControl = class(TWinControl)
  protected
    FCommonData: TsCommonData;
    function GetCount: Integer; virtual; abstract;
    function GetItemIndex: Integer; virtual; abstract;
    procedure SetItemIndex(const Value: Integer); overload; virtual; abstract;
  public
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure AddItem(Item: String; AObject: TObject); virtual; abstract;
    procedure Clear; virtual; abstract;
    procedure ClearSelection; virtual; abstract;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure WndProc (var Message: TMessage); override;

    procedure CopySelection(Destination: TsCustomListControl); virtual; abstract;
    procedure DeleteSelected; virtual; abstract;
    procedure MoveSelection(Destination: TsCustomListControl); virtual;
    procedure SelectAll; virtual; abstract;
    property CommonData : TsCommonData read FCommonData write FCommonData;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  end;

  TsCommonCombo = class(TsCustomListControl)
  private
    FCanvas: TCanvas;
    FMaxLength: Integer;
    FDropDownCount: Integer;
    FItemIndex: Integer;
    FOnChange: TNotifyEvent;
    FOnSelect: TNotifyEvent;
    FOnDropDown: TNotifyEvent;
    FOnCloseUp: TNotifyEvent;
    FItemHeight: Integer;
    FItems: TStrings;
    procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
    procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
    procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  protected
    FListHandle: HWnd;
    FDropHandle: HWnd;
    FEditInstance: Pointer;
    FDefEditProc: Pointer;
    FListInstance: Pointer;
    FDefListProc: Pointer;
    FDroppingDown: Boolean;
    FFocusChanged: Boolean;
    FIsFocused: Boolean;
    FSaveIndex: Integer;
    procedure AdjustDropDown; virtual;
    procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); virtual;
    procedure CreateWnd; override;
    procedure EditWndProc(var Message: TMessage);
    function GetItemsClass: TsCustomComboBoxStringsClass; virtual; abstract;
    function GetItemHt: Integer; virtual; abstract;
    procedure SetItemHeight(Value: Integer); virtual;
    function GetCount: Integer; override;
    function GetItemCount: Integer; virtual; abstract;
    function GetItemIndex: Integer; override;
    function GetDroppedDown: Boolean;
    function GetSelLength: Integer;
    function GetSelStart: Integer;
    procedure ListWndProc(var Message: TMessage);
    procedure Change; dynamic;
    procedure Select; dynamic;
    procedure DropDown; dynamic;
    procedure CloseUp; dynamic;
    procedure DestroyWindowHandle; override;
    procedure SetDroppedDown(Value: Boolean);
    procedure SetSelLength(Value: Integer);
    procedure SetSelStart(Value: Integer);
    procedure SetMaxLength(Value: Integer);
    procedure SetDropDownCount(const Value: Integer); virtual;
    procedure SetItemIndex(const Value: Integer); override;
    procedure SetItems(const Value: TStrings); virtual;
    procedure UpdateMargins; virtual;
    property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 14;
    property ItemCount: Integer read GetItemCount;
    property ItemHeight: Integer read GetItemHt write SetItemHeight default 16;
    property ListHandle: HWnd read FListHandle;
    property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
    property ParentColor default False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
    property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  public
    FEditHandle: HWnd;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure WndProc(var Message: TMessage); override;
    procedure Invalidate; override;
    procedure AddItem(Item: String; AObject: TObject); override;
    procedure Clear; override;
    procedure ClearSelection; override;
    procedure CopySelection(Destination: TsCustomListControl); override;
    procedure DeleteSelected; override;
    function Focused: Boolean; override;
    procedure Loaded; override;
    procedure PaintButton; virtual;
    function ButtonRect : TRect;
    procedure SelectAll; override;
    property EditHandle: HWnd read FEditHandle;
    property Canvas: TCanvas read FCanvas;
    property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown;
    property Items: TStrings read FItems write SetItems;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property SelStart: Integer read GetSelStart write SetSelStart;
    property TabStop default True;
    property Height default 22;
  end;

  TsCommonComboBox = class(TsCommonCombo)
  private
    FAutoComplete: Boolean;
    FAutoDropDown: Boolean;
    FLastTime: Cardinal;
    FFilter: String;
    FCharCase: TEditCharCase;
    FSorted: Boolean;
    FStyle: TComboBoxStyle;
    FSaveItems: TStringList;
    FOnDrawItem: TDrawItemEvent;
    FOnMeasureItem: TMeasureItemEvent;
    FDisabledKind: TsDisabledKind;
    procedure SetCharCase(Value: TEditCharCase);
    procedure SetSelText(const Value: string);
    procedure SetSorted(Value: Boolean);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure SkinPaint(DC : HDC); virtual;
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
    procedure DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
    function  GetItemHt: Integer; override;
    function GetItemsClass: TsCustomComboBoxStringsClass; override;
    function GetSelText: string;
    procedure KeyPress(var Key: Char); override;
    procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
    function SelectItem(const AnItem: String): Boolean;
    procedure SetStyle(Value: TComboBoxStyle); virtual;
    property Sorted: Boolean read FSorted write SetSorted default False;
    property Style: TComboBoxStyle read FStyle write SetStyle default csDropDown;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
    function GetItemCount: Integer; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure WndProc(var Message: TMessage); override;
    property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
    property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default False;
    property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
    property SelText: string read GetSelText write SetSelText;
  published
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
  end;

  TsColorBoxStyles = (cbStandardColors, // first sixteen RGBI colors
                     cbExtendedColors, // four additional reserved colors
                     cbSystemColors,   // system managed/defined colors
                     cbIncludeNone,    // include clNone color, must be used with cbSystemColors
                     cbIncludeDefault, // include clDefault color, must be used with cbSystemColors
                     cbCustomColor,    // first color is customizable
                     cbPrettyNames);   // instead of 'clColorNames' you get 'Color Names'
  TsColorBoxStyle = set of TsColorBoxStyles;

  TsCustomColorBox = class(TsCommonComboBox)
  private
    FStyle: TsColorBoxStyle;
    FNeedToPopulate: Boolean;
    FListSelected: Boolean;
    FDefaultColorColor: TColor;
    FNoneColorColor: TColor;
    FSelectedColor: TColor;
    FShowColorName: boolean;
    FMargin: integer;
    function GetColor(Index: Integer): TColor;
    function GetColorName(Index: Integer): string;
    function GetSelected: TColor;
    procedure SetSelected(const AColor: TColor);
    procedure ColorCallBack(const AName: string);
    procedure SetDefaultColorColor(const Value: TColor);
    procedure SetNoneColorColor(const Value: TColor);
    procedure SetShowColorName(const Value: boolean);
    procedure SetMargin(const Value: integer);
  protected
    procedure CloseUp; override;
    function ColorRect(SourceRect : TRect; State: TOwnerDrawState) : TRect;
    procedure CreateWnd; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    function PickCustomColor: Boolean; virtual;
    procedure PopulateList;
    procedure Select; override;
    procedure SetStyle(AStyle: TsColorBoxStyle); reintroduce;
  public
    constructor Create(AOwner: TComponent); override;
    property Style: TsColorBoxStyle read FStyle write SetStyle default [cbStandardColors, cbExtendedColors, cbSystemColors];
    property Colors[Index: Integer]: TColor read GetColor;
    property ColorNames[Index: Integer]: string read GetColorName;
    property Margin : integer read FMargin write SetMargin default 0;
    property Selected: TColor read GetSelected write SetSelected default clBlack;
    property ShowColorName : boolean read FShowColorName write SetShowColorName default True;
    property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack;
    property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack;
  end;

  TsColorBox = class(TsCustomColorBox)
  published
    property AutoComplete;
    property AutoDropDown;
    property DefaultColorColor;
    property NoneColorColor;
    property Selected;
    property Style;

    property Anchors;
    property BevelEdges;
//    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BiDiMode;
    property Color;
    property CommonData;
    property Constraints;
    property Ctl3D;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property Margin;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowColorName;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnCloseUp;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseUp;
    property OnSelect;
    property OnStartDock;
    property OnStartDrag;
  end;

  TsCustomComboBoxEx = class;
  TsComboItem = class;

  TsComboItems = class(TCollection)
  private
    FOwner: TsCustomComboBoxEx;
    function GetItem(Index: Integer): TsComboItem;
    procedure SetItem(Index: Integer; Value: TsComboItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TsCustomComboBoxEx);
    destructor Destroy; override;
    property Items[Index: Integer]: TsComboItem read GetItem write SetItem; default;
  end;

  TsComboItem = class(TCollectionItem)
  private
    FCaption: string;
    FSelectedImageIndex: TImageIndex;
    FImageIndex: TImageIndex;
    FOverlayImageIndex: TImageIndex;
    FIndend: integer;
    procedure SetCaption(const Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetDisplayName: string; override;
  published
    property Caption : string read FCaption write SetCaption;
    property ImageIndex : TImageIndex read FImageIndex write FImageIndex default -1;
    property Indend : integer read FIndend write FIndend default -1;
    property OverlayImageIndex : TImageIndex read FOverlayImageIndex write FOverlayImageIndex default -1;
    property SelectedImageIndex : TImageIndex read FSelectedImageIndex write FSelectedImageIndex default -1;
  end;

  TsCustomComboBoxEx = class(TsCommonComboBox)
  private
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FItemsEx: TsComboItems;
    NeedToUpdate : boolean;
    procedure ImageListChange(Sender: TObject);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetItemsEx(const Value: TsComboItems);
    function GetSelectedItem: TsComboItem;
  protected
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure UpdateList;
    function ImgRect(Item : TsComboItem; State: TOwnerDrawState) : TRect;
    function CurrentImage(Item : TsComboItem; State: TOwnerDrawState) : integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    procedure Invalidate; override;
    procedure UpdateMargins; override;
    property Images : TCustomImageList read FImages write SetImages;
    property ItemsEx : TsComboItems read FItemsEx write SetItemsEx;
    property SelectedItem : TsComboItem read GetSelectedItem;
  end;

  TsComboBoxEx = class(TsCustomComboBoxEx) // Is not finished
  published
    property Action;
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Images;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ItemsEx;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;

    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property CommonData;
    property DropDownCount;

    property OnChange;
    property OnCloseUp;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;

    property OnEndDock;