flatedits.pas

相信大家已经找很长时间了

    procedure UpClick (Sender: TObject); virtual;
    procedure DownClick (Sender: TObject); virtual;
    procedure KeyDown (var Key: Word; Shift: TShiftState); override;
    procedure KeyPress (var Key: Char); override;
    procedure CreateParams (var Params: TCreateParams); override;
    procedure Loaded; override;
    procedure CreateWnd; override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    property Button: TFlatSpinButton read FButton;
  published
    property Alignment;
    property ColorFocused;
    property ColorBorder;
    property ColorFlat;
    property AdvColorFocused;
    property AdvColorBorder;
    property UseAdvColors;
    property AutoSelect;
    property AutoSize;
    property DragCursor;
    property DragMode;
    property Digits: Integer read FDigits write SetDigits;
    property Precision: Integer read FPrecision write SetPrecision;
    property FloatFormat: TFloatFormat read FFloatFormat write SetFloatFormat;
    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
    property Enabled;
    property Font;
    property Increment: Extended read FIncrement write FIncrement;
    property MaxValue: Extended read FMaxValue write FMaxValue;
    property MinValue: Extended read FMinValue write FMinValue;

    property EditLabel;
    property LabelPosition;
    property LabelSpacing;

    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value: Extended read GetValue write SetValue;
    property Visible;

    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
   {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
   {$ENDIF}
  end;
  { TFlatDBEditFloat }
  TFlatDBEditFloat = class(TFlatFloat)
  private
    FDataLink : TFieldDataLink;
    function  GetField      : TField;
    function  GetDataField  : string;
    procedure SetDataField(const Value: string);
    function  GetDataSource : TDataSource ;
    procedure SetDataSource(Value : TDataSource);
    procedure CMExit(var Message:TCMExit);message CM_Exit;
    procedure EditingChange(Sender: TObject);
    procedure DataChange(sender : TObject);
    procedure UpdateData(sender : TObject);
    procedure ActiveChange(sender : TObject);   
  
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure DownClick (Sender: TObject); override;
    procedure UpClick (Sender: TObject); override;
    procedure Change; override;   
  public
    property Field: TField read GetField;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

 { TFlatDBEditInt }
 TFlatDBEditInt = class (TFlatInteger)
  private
    FDataLink : TFieldDataLink;
    function GetDataField : String;
    function GetDataSource : TDataSource;
    function GetReadOnly : Boolean;
    procedure SetReadOnly (aValue : Boolean);
    procedure SetDataSource (aValue : TDataSource);
    procedure SetDataField (const aValue : String);
    procedure DataChange (Sender : TObject);
    procedure UpdateData(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure CMExit (var Message: TCMExit); message CM_EXIT;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
  protected
    procedure Change; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation);override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure DownClick (Sender: TObject); override;
    procedure UpClick (Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DataSource : TDataSource read GetDataSource write SetDataSource;
    property DataField: string read GetDataField write SetDataField;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;

  //定义IP分段函数
  TIP = packed Record
    NO1:String[3];
    NO2:String[3];
    NO3:String[3];
    NO4:String[3];
  end;

  TValidateEvent = Procedure ( Sender : TObject) of Object;

  { TCustomFlatMask }

  TCustomFlatMask = class(TCustomMaskEdit)
  private
    FUseAdvColors: Boolean;
    FAdvColorFocused: TAdvColors;
    FAdvColorBorder: TAdvColors;
    FParentColor: Boolean;
    FFocusedColor: TColor;
    FBorderColor: TColor;
    FFlatColor: TColor;
    FOnValidate : TValidateEvent;
    MouseInControl: Boolean;
    FAlignment: TAlignment;
    fLabel : TLabel;
    FLabelSpacing: Integer;
    FEditLabel: TFlatLabel;
    FLabelPosition: TLabelPosition;
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetAdvColors (Index: Integer; Value: TAdvColors);
    procedure SetUseAdvColors (Value: Boolean);
    procedure SetParentColor (Value: Boolean);
  protected
    procedure RedrawBorder (const Clip: HRGN);
    procedure NewAdjustHeight;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure SetAlignment(const Value: TAlignment);
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    
    procedure CalcAdvColors;
    procedure Loaded; override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;

    procedure LabelMouseEnter(Sender: TObject);
    procedure SetBMPosition(const Value: TLabelPosition);
    procedure SetLabelSpacing(const Value: Integer);
    procedure SetName(const Value: TComponentName); override;
    procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMBidimodechanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure SetParent(AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property EditLabel: TFlatLabel read FEditLabel;
    property LabelPosition: TLabelPosition read FLabelPosition write SetBMPosition default lpLeft;
    property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3;

    property ColorFocused: TColor index 0 read FFocusedColor write SetColors default clWhite;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default $004080FF;
    property ColorFlat: TColor index 2 read FFlatColor write SetColors default $00E1EAEB;
    property ParentColor: Boolean read FParentColor write SetParentColor default false;
    property AdvColorFocused: TAdvColors index 0 read FAdvColorFocused write SetAdvColors default 10;
    property AdvColorBorder: TAdvColors index 1 read FAdvColorBorder write SetAdvColors default 50;
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;

    property OnValidate : TValidateEvent read FOnValidate write FOnValidate;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetupInternalLabel;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
   {$IFDEF DFS_DELPHI_4_UP}
    procedure ValidateEdit; override;
   {$ENDIF}
  end;
  { TFlatIPEdit }
  TFlatIPEdit = class(TCustomFlatMask)
  private
    fFmt: Char;
    procedure SetFMT(const Value: Char);
  protected
    { Protected declarations }
    IP:TIP;
    fIPText : String;
    function  GetInx: integer;
    function  GetIPText: String;
    procedure SetIPText(const Value: String);
    function  Replace(Start, Len: Integer):integer;
    procedure KeyPress(var Key: Char); override;
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMExit(var Message: TCMExit);  message CM_EXIT;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  public
    property Index:integer read GetInx;
    constructor Create(AOwner: TComponent); override;
  published
    property Fmt:Char read fFmt write SetFMT;
    property IPText : String read GetIPText write SetIPText;

    property EditLabel;
    property LabelPosition;
    property LabelSpacing;

    property ColorFocused;
    property ColorBorder;
    property ColorFlat;
    property ParentColor;
    property AdvColorFocused;
    property AdvColorBorder;
    property UseAdvColors;
    property Alignment;
    property Align;
    property AutoSelect;
    property CharCase;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property OEMConvert;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnValidate;
  end;

  { TFlatMaskEdit }
  TFlatMaskEdit = class(TCustomFlatMask)
  published
    property EditLabel;
    property LabelPosition;
    property LabelSpacing;

    property ColorFocused;
    property ColorBorder;
    property ColorFlat;
    property ParentColor;
    property AdvColorFocused;
    property AdvColorBorder;
    property UseAdvColors;
    property Alignment;
    property Align;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property EditMask;
    property Font;
    property HideSelection;
    property MaxLength;
    property OEMConvert;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnValidate;
    {$IFDEF DFS_DELPHI_4_UP}
    property ImeMode;
    property ImeName;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
   {$ENDIF}
  end;
  { TFlatDBMaskEdit }
  TFlatDBMaskEdit = Class(TCustomFlatMask)
  private
    FDataLink: TFieldDataLink;
    FCanvas: TControlCanvas;
    FAlignment: TAlignment;
    FFocused: Boolean;
    procedure ActiveChange(Sender: TObject);
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure ResetMaxLength;
    procedure UpdateData(Sender: TObject);
    procedure SetFocused(Value: Boolean);
    function GetTextMargins: TPoint;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMUndo(var Message: TMessage); message WM_UNDO;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);
    procedure SetReadOnly(const Value: Boolean);
  protected
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Field: TField read GetField;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;

    property EditLabel;
    property LabelPosition;
    property LabelSpacing;

    property ColorFocused;
    property ColorBorder;
    property ColorFlat;
    property ParentColor;
    property AdvColorFocused;
    property AdvColorBorder;
    property UseAdvColors;
    property Alignment;
    property Align;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
    property Ctl3D;