skinboxctrls.pas

一套及时通讯的原码

    foNoOEMFonts, foOEMFontsOnly, foScalableOnly, foNoSymbolFonts);
  TspFontListOptions = set of TspFontListOption;

  TspSkinFontComboBox = class(TspSkinCustomComboBox)
  protected
    FDevice: TspFontDevice;
    FUpdate: Boolean;
    FUseFonts: Boolean;
    FOptions: TspFontListOptions;
    procedure SetFontName(const NewFontName: TFontName);
    function GetFontName: TFontName;
    function GetTrueTypeOnly: Boolean;
    procedure SetDevice(Value: TspFontDevice);
    procedure SetOptions(Value: TspFontListOptions);
    procedure SetTrueTypeOnly(Value: Boolean);
    procedure SetUseFonts(Value: Boolean);
    procedure Reset;
    procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE;

    procedure DrawLBFontItem(Cnvs: TCanvas; Index: Integer;
      ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);

    procedure DrawCBFontItem(Cnvs: TCanvas; Index: Integer;
      ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
    procedure CreateWnd; override;

    procedure DrawTT(Cnvs: TCanvas; X, Y: Integer; C: TColor);
  public
    constructor Create(AOwner: TComponent); override;
    procedure PopulateList;
  published
    property ListBoxCaption;
    property ListBoxCaptionMode;
    property Enabled;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Visible;
    property Device: TspFontDevice read FDevice write SetDevice default fdScreen;
    property FontName: TFontName read GetFontName write SetFontName;
    property Options: TspFontListOptions read FOptions write SetOptions default [];
    property TrueTypeOnly: Boolean read GetTrueTypeOnly write SetTrueTypeOnly
      stored False;
    property UseFonts: Boolean read FUseFonts write SetUseFonts default False;
    property Align;
    property ItemIndex;
    property DropDownCount;
    property Font;
    property Sorted;
    property Style;
    property OnChange;
    property OnClick;
  end;

  TspValueType = (vtInteger, vtFloat);

  TspSkinSpinEdit = class(TspSkinCustomControl)
  private
    StopCheck: Boolean;
    FMinValue, FMaxValue, FIncrement: Extended;
    FromEdit: Boolean;
    FOnChange: TNotifyEvent;
    FValue: Extended;
    OldActiveButton, ActiveButton, CaptureButton: Integer;
    TimerMode: Integer;
    WaitMode: Boolean;

    FDecimal: Byte;
    FValueType: TspValueType;

    procedure StartTimer;
    procedure StopTimer;
    procedure SetValue(AValue: Extended);
    procedure SetMinValue(AValue: Extended);
    procedure SetMaxValue(AValue: Extended);
    procedure SetEditorEnabled(AValue: Boolean);
    function  GetEditorEnabled: Boolean;
    procedure SetMaxLength(AValue: Integer);
    function  GetMaxLength: Integer;

    procedure SetValueType(NewType: TspValueType);
    procedure SetDecimal(NewValue: Byte);

   protected
    Buttons: array[0..1] of TspCBButtonX;
    FOnEditKeyDown: TKeyEvent;
    FOnEditKeyPress: TKeyPressEvent;
    FOnEditKeyUp: TKeyEvent;

    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditKeyPress(Sender: TObject; var Key: Char);

    procedure UpClick(Sender: TObject);
    procedure DownClick(Sender: TObject);
    function CheckValue (NewValue: Extended): Extended;
    procedure EditChange(Sender: TObject);
    procedure ButtonDown(I: Integer; X, Y: Integer);
    procedure ButtonUp(I: Integer; X, Y: Integer);
    procedure ButtonEnter(I: Integer);
    procedure ButtonLeave(I: Integer);
    procedure TestActive(X, Y: Integer);
    procedure CalcRects;
    procedure DrawButton(Cnvs: TCanvas; i: Integer);
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure WMTimer(var Message: TWMTimer); message WM_Timer;
    procedure GetSkinData; override;
    procedure DefaultFontChange; override;

    procedure CreateControlDefaultImage(B: TBitMap); override;
    procedure CreateControlSkinImage(B: TBitMap); override;

    procedure Change; virtual;
  public
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor: TColor;
    UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
    DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
    //
    FEdit: TspSkinNumEdit;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    function IsNumText(AText: String): Boolean;
    procedure ChangeSkinData; override;
    property Text;
    procedure SimpleSetValue(AValue: Double);
  published
    property Align;
    property ValueType: TspValueType read FValueType write SetValueType;
    property Decimal: Byte read FDecimal write SetDecimal default 2;
    property MinValue: Extended read FMinValue write SetMinValue;
    property MaxValue: Extended read FMaxValue write SetMaxValue;
    property Value: Extended read FValue write SetValue;
    property Increment: Extended read FIncrement write FIncrement;
    property EditorEnabled: Boolean read GetEditorEnabled write SetEditorEnabled;
    property MaxLength: Integer read GetMaxLength write SetMaxLength;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnEditKeyDown: TKeyEvent read FOnEditKeyDown write FOnEditKeyDown;
    property OnEditKeyPress: TKeyPressEvent read FOnEditKeyPress write FOnEditKeyPress;
    property OnEditKeyUp: TKeyEvent read FOnEditKeyUp write FOnEditKeyUp;
  end;


  TspSkinCheckListBox = class;
  TspCheckListBox = class(TListBox)
  protected
    FSaveStates: TList;
    FOnClickCheck: TNotifyEvent;

    procedure SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);

    procedure PaintBGWH(Cnvs: TCanvas; AW, AH, AX, AY: Integer);
    function CreateWrapper(Index: Integer): TObject;
    function GetWrapper(Index: Integer): TObject;
    function HaveWrapper(Index: Integer): Boolean;
    function ExtractWrapper(Index: Integer): TObject;

    procedure InvalidateCheck(Index: Integer);

    procedure SetChecked(Index: Integer; Checked: Boolean);
    function GetChecked(Index: Integer): Boolean;
    procedure SetState(Index: Integer; AState: TCheckBoxState);
    function GetState(Index: Integer): TCheckBoxState;

    function GetState1(AItemID: Integer): TOwnerDrawState;

    procedure ToggleClickCheck(Index: Integer);

    procedure DeleteString(Index: Integer); override;
    procedure ResetContent; override;

    procedure SetItemData(Index: Integer; AData: LongInt); override;
    function GetItemData(Index: Integer): LongInt; override;

    procedure PaintBG(DC: HDC);
    procedure PaintList(DC: HDC);
    procedure PaintColumnsList(DC: HDC);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WndProc(var Message: TMessage); override;
    procedure DrawDefaultItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
                           State1: TOwnerDrawState);
    procedure DrawSkinItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
                           State1: TOwnerDrawState);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure PaintWindow(DC: HDC); override;
    procedure WMDestroy(var Msg : TWMDestroy);message WM_DESTROY;
    procedure DestroyWnd; override;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Click; override;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
    procedure CreateWnd; override;

  public
    SkinListBox: TspSkinCheckListBox;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
    property State[Index: Integer]: TCheckBoxState read GetState write SetState;
    property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
  end;

  TspSkinCheckListBox = class(TspSkinCustomControl)
  protected
    FRowCount: Integer;
    FImages: TCustomImageList;
    FImageIndex: Integer;

    FGlyph: TBitMap;
    FNumGlyphs: TspSkinPanelNumGlyphs;
    FSpacing: Integer;

    FOnUpButtonClick, FOnDownButtonClick, FOnCheckButtonClick: TNotifyEvent;

    FOnClickCheck: TNotifyEvent;

    FDefaultItemHeight: Integer;

    FOnDrawItem: TspDrawSkinItemEvent;

    NewClRect: TRect;

    ListRect: TRect;

    FDefaultCaptionHeight: Integer;
    FDefaultCaptionFont: TFont;

    FOnListBoxClick: TNotifyEvent;
    FOnListBoxDblClick: TNotifyEvent;
    FOnListBoxMouseDown: TMouseEvent;
    FOnListBoxMouseMove: TMouseMoveEvent;
    FOnListBoxMouseUp: TMouseEvent;

    FOnListBoxKeyDown: TKeyEvent;
    FOnListBoxKeyPress: TKeyPressEvent;
    FOnListBoxKeyUp: TKeyEvent;

    FCaptionMode: Boolean;
    FAlignment: TAlignment;
    Buttons: array[0..2] of TspCBButtonX;
    OldActiveButton, ActiveButton, CaptureButton: Integer;
    NewCaptionRect: TRect;

    TimerMode: Integer;
    WaitMode: Boolean;

    function  GetColumns: Integer;
    procedure SetColumns(Value: Integer);

    procedure SetRowCount(Value: Integer);
    procedure SetImages(Value: TCustomImageList);
    procedure SetImageIndex(Value: Integer);
    procedure SetGlyph(Value: TBitMap);
    procedure SetNumGlyphs(Value: TspSkinPanelNumGlyphs);
    procedure SetSpacing(Value: Integer);

    procedure StartTimer;
    procedure StopTimer;

    procedure ButtonDown(I: Integer; X, Y: Integer);
    procedure ButtonUp(I: Integer; X, Y: Integer);
    procedure ButtonEnter(I: Integer);
    procedure ButtonLeave(I: Integer);
    procedure TestActive(X, Y: Integer);
    procedure DrawButton(Cnvs: TCanvas; i: Integer);

    procedure ListBoxOnClickCheck(Sender: TObject);

    procedure SetChecked(Index: Integer; Checked: Boolean);
    function GetChecked(Index: Integer): Boolean;
    procedure SetState(Index: Integer; AState: TCheckBoxState);
    function GetState(Index: Integer): TCheckBoxState;

    procedure ListBoxMouseDown(Button: TMouseButton; Shift: TShiftState;
                               X, Y: Integer); virtual;
    procedure ListBoxMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure ListBoxMouseUp(Button: TMouseButton; Shift: TShiftState;
                             X, Y: Integer); virtual;
    procedure ListBoxClick; virtual;
    procedure ListBoxDblClick; virtual;
    procedure ListBoxKeyDown(var Key: Word; Shift: TShiftState); virtual;
    procedure ListBoxKeyUp(var Key: Word; Shift: TShiftState); virtual;
    procedure ListBoxKeyPress(var Key: Char); virtual;
    procedure ListBoxEnter; virtual;
    procedure ListBoxExit; virtual;

    procedure ShowScrollBar;
    procedure HideScrollBar;
    procedure GetSkinData; override;
    procedure CalcRects;
    procedure SBChange(Sender: TObject);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
    procedure WMTimer(var Message: TWMTimer); message WM_Timer;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    //
    procedure OnDefaultCaptionFontChange(Sender: TObject);
    procedure SetDefaultCaptionHeight(Value: Integer);
    procedure SetDefaultCaptionFont(Value: TFont);
    procedure SetDefaultItemHeight(Value: Integer);
    procedure SetCaptionMode(Value: Boolean);
    procedure SetAlignment(Value: TAlignment);
    procedure SetItems(Value: TStrings);
    function GetItems: TStrings;
    function GetItemIndex: Integer;
    procedure SetItemIndex(Value: Integer);
    function GetMultiSelect: Boolean;
    procedure SetMultiSelect(Value: Boolean);
    function GetListBoxFont: TFont;
    procedure SetListBoxFont(Value: TFont);
    function GetListBoxTabOrder: TTabOrder;
    procedure SetListBoxTabOrder(Value: TTabOrder);
    function GetListBoxTabStop: Boolean;
    proce