thehomectrls.pas

67个控件,回车代替TAB,非空检查,记录数据库中记录的ID,也可自己定义关键字段,关联LABEL以便提示,

// 源文件名：ThehomeCtrls.pas
// 软件版权：杭州人和软件开发有限公司
// 系统名称：
// 功能说明：自制Delphi控件
// 作    者：丁华强
// 历    史：
unit ThehomeCtrls;

{$R-}
{$B-}

interface

uses
  Messages, Windows, Classes, Controls, StdCtrls, Buttons, CheckLst, Forms,
  ComCtrls, Dialogs, Graphics, Math, SysUtils, Registry;

type
  TSetItemPropertyEvent = procedure(Canvas: TCanvas; Index: Integer; State: TOwnerDrawState) of object;
  TCheckInputEvent = procedure(Sender: TObject; var Valid: Boolean) of object;
  TArrowExitStyle = (asNever, asTopBottomOnly, asAlways);
  TTHEditStyle = (esInteger, esNumeric, esString, esDate, esTime);
  TInputWay = (iwFundAccount, iwInterAccount, iwFundCard, iwBankCard, iwStockAccount);

{ TCustomTHEdit }
  TCustomTHEdit = class(TCustomEdit)
  private
    FCaption: string;
    FLeadLabel: TLabel;
    FMin: Extended;
    FMax: Extended;
    FMinable: Boolean;
    FMaxable: Boolean;
    FNullable: Boolean;
    FScale: Byte;
    FStyle: TTHEditStyle;
    FChanged: Boolean;
    FOnValidate: TCheckInputEvent;
    function GetAsFloat: Extended;
    function GetAsInteger: Longint;
    function GetAsString: string; virtual;
    function GetAsDate: Longint;
    function GetAsTime: Longint;
    function GetIsNull: Boolean;
    function GetRangeMsg(bLess: Boolean): string;
    procedure SetMin(Value: Extended);
    procedure SetMax(Value: Extended);
    procedure SetMinable(Value: Boolean);
    procedure SetMaxable(Value: Boolean);
    procedure SetScale(Value: Byte);
    procedure SetStyle(Value: TTHEditStyle);
    function ValidateNumeric: Boolean;
    function ValidateInteger: Boolean;
    function ValidateDate: Boolean;
    function ValidateTime: Boolean;
  protected
    procedure Change; override;
    procedure DoEnter; override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Clear; override;
    procedure Reset;
    procedure Unchange;
    function Validate: Boolean; virtual;
    property AsDate: Longint read GetAsDate;
    property AsFloat: Extended read GetAsFloat;
    property AsInteger: Longint read GetAsInteger;
    property AsString: string read GetAsString;
    property AsTime: Longint read GetAsTime;
    property Caption: string read FCaption write FCaption;
    property IsNull: Boolean read GetIsNull;
    property LeadLabel: TLabel read FLeadLabel write FLeadLabel;
    property Nullable: Boolean read FNullable write FNullable default False;
    property Scale: Byte read FScale write SetScale;
    property Style: TTHEditStyle read FStyle write SetStyle default esString;
    property Max: Extended read FMax write SetMax;
    property Maxable: Boolean read FMaxable write SetMaxable default False;
    property Min: Extended read FMin write SetMin;
    property Minable: Boolean read FMinable write SetMinable default False;
    property OnValidate: TCheckInputEvent read FOnValidate write FOnValidate;
  end;

{ TTHEdit }
  TTHEdit = class(TCustomTHEdit)
  published
    property Anchors;
    property AsDate;
    property AsFloat;
    property AsInteger;
    property AsString;
    property AsTime;
    property AutoSelect;
    property AutoSize;
    property BiDiMode;
    property BorderStyle;
    property Caption;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Height default 21;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property IsNull;
    property LeadLabel;
    property Max;
    property Maxable;
    property MaxLength;
    property Min;
    property Minable;
    property Nullable;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property Scale;
    property ShowHint;
    property Style;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property Width default 121;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnValidate;
  end;

{ TTHPasswordEdit }
{ TArrowExit }
  TArrowExit = class(TPersistent)
  private
    FArrowExitStyle: array[0..1] of TArrowExitStyle;
    function GetArrowExit(Index: Integer): TArrowExitStyle;
    procedure SetArrowExit(Index: Integer; Value: TArrowExitStyle);
  public
    constructor Create; virtual;
  published
    property LeftRight: TArrowExitStyle index 0 read GetArrowExit write SetArrowExit default asAlways;
    property UpDown: TArrowExitStyle index 1 read GetArrowExit write SetArrowExit default asTopBottomOnly;
  end;

{ TCutomTHCheckBox }
  TCutomTHCheckBox = class(TCustomCheckBox)
  private
    FSavedState: Integer;
    FOnValidate: TCheckInputEvent;
  protected
    procedure DoEnter; override;
    procedure KeyPress(var Key: Char); override;
  public
    procedure Reset;
    procedure Clear;
    constructor Create(AOwner: TComponent); override;
    function Validate: Boolean;
    property OnValidate: TCheckInputEvent read FOnValidate write FOnValidate;
  end;

{ TTHCheckBox }
  TTHCheckBox = class(TCutomTHCheckBox)
  published
    property Action;
    property Alignment;
    property AllowGrayed;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property State;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnValidate;
  end;

{ TTHBitBtn }
  TTHBitBtn = class(TBitBtn)
  protected
    procedure DoEnter; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TCustomTHComboBox }
  TCustomTHComboBox = class(TCustomComboBox)
  private
    FCaption: string;
    FLeadLabel: TLabel;
    FMarkChar: Char;
    FNullable: Boolean;
    FValueWidth: Integer;
    FChanged: Boolean;
    FOnSetItemProperty: TSetItemPropertyEvent;
    FOnValidate: TCheckInputEvent;
    FSavedItemHeight: Integer;
    FSavedText: string;
    function GetChecked: string;
    function GetPrompt: string;
    procedure SetChecked(const Value: string);
  protected
    procedure DoEnter; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure DropDown; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Reset;
    function Validate: Boolean;
    property Caption: string read FCaption write FCaption;
    property Checked: string read GetChecked write SetChecked;
    property LeadLabel: TLabel read FLeadLabel write FLeadLabel;
    property MarkChar: Char read FMarkChar write FMarkChar default '|';
    property Nullable: Boolean read FNullable write FNullable default False;
    property Prompt: string read GetPrompt;
    property ValueWidth: Integer read FValueWidth write FValueWidth default 12;
    property OnSetItemProperty: TSetItemPropertyEvent read FOnSetItemProperty write FOnSetItemProperty;
    property OnValidate: TCheckInputEvent read FOnValidate write FOnValidate;
  end;

{ TTHComboBox }
  TTHComboBox = class(TCustomTHComboBox)
  published
    property Anchors;
    property BiDiMode;
    property Caption;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property Height default 22;
    property ImeMode;
    property ImeName;
    property ItemHeight default 16;
    property Items;
    property LeadLabel;
    property MarkChar;
    property MaxLength;
    property Nullable;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property ValueWidth;
    property Visible;
    property Width default 121;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnSetItemProperty;
    property OnStartDock;
    property OnStartDrag;
    property OnValidate;
  end;

{ TTHCheckCombo }
  TPopupGrid = class;

  TTHCheckCombo = class(TCustomEdit)
  private
    FCaption: string;
    FBtnControl: TWinControl;
    FButton: TSpeedButton;
    FGrid: TPopupGrid;
    FDropDownCount: Integer;
    FDropDownWidth: Integer;
    FLeadLabel: TLabel;
    FMarkChar: Char;
    FNullable: Boolean;
    FSeparator: Char;
    FValueWidth: Integer;
    FSelectAll: Boolean;
    FChanged: Boolean;
    FItemsAccessed: Boolean;
    FNeverDropped: Boolean;
    FReadOnly: Boolean;
    FSeparate: Boolean;
    FOnDropDown: TNotifyEvent;
    FOnSetItemProperty: TSetItemPropertyEvent;
    FOnValidate: TCheckInputEvent;
    function GetMinHeight: Integer;
    procedure SetEditRect;
    procedure SetReadOnly(Value: Boolean);
    procedure RecalcSeparate;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMLostFocus); message CM_EXIT;
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    procedure CMChanged(var Message: TMessage); message CM_CHANGED;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    function GetChecked(Index: Integer): Boolean;
    function GetFlat: Boolean;
    function GetItemHeight: Integer;
    function GetItems: TStrings;
    function GetSorted: Boolean;
    procedure SetChecked(Index: Integer; Checked: Boolean);
    procedure SetFlat(Value: Boolean);
    procedure SetItemHeight(Value: Integer);
    procedure SetItems(Value: TStrings);
    procedure SetSorted(Value: Boolean);
    procedure DoEnter; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DropDown; dynamic;
    procedure CheckedAll(Value: Boolean);
    procedure CloseUp; dynamic;
    procedure Clear; override;
    procedure Reset;
    function Validate: Boolean;
    property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
    property Separate: Boolean read FSeparate;
  published
    property AutoSelect;
    property Caption: string read FCaption write FCaption;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
    property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
    property Enabled;
    property Flat: Boolean read GetFlat write SetFlat default True;
    property Font;
    property Height default 24;
    property Items: TStrings read GetItems write SetItems;
    property ItemHeight: Integer read GetItemHeight write SetItemHeight default 16;
    property LeadLabel: TLabel read FLeadLabel write FLeadLabel;
    property MarkChar: Char read FMarkChar write FMarkChar default '|';
    property Nullable: Boolean read FNullable write FNullable default False;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    //property MReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ReadOnly read FReadOnly write SetReadOnly default False;
    property Separator: Char read FSeparator write FSeparator default ',';
    property ShowHint;
    property Sorted: Boolean read GetSorted write SetSorted default False;
    property TabOrder;
    property TabStop;
    property Text;
    property ValueWidth: Integer read FValueWidth write FValueWidth default 12;
    property Visible;
    property Width default 121;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSetItemProperty: TSetItemPropertyEvent read FOnSetItemProperty write FOnSetItemProperty;
    property OnStartDock;
    property OnStartDrag;
    property OnValidate: TCheckInputEvent read FOnValidate write FOnValidate;
  end;

  TPopupGrid = class(TCheckListBox)
  private
    function GetAllChecked: string;
    procedure SetAllChecked(const Value: string);
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    procedure SetReadOnly(Value: Boolean);
  end;