dbctrlseh.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

    procedure UpdateMask; virtual;
    procedure ValidateEdit; override;
    property Kind: TDateTimeKindEh read FKind write SetKind;
  end;

{ TDBDateTimeEditEh }

  TDBDateTimeEditEh = class(TCustomDBDateTimeEditEh)
  published
    property Alignment;
    property AlwaysShowBorder;
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property EditButton;
    property EditButtons;
    property Font;
    property Flat;
    property ImeMode;
    property ImeName;
    property Kind;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value;
    property Visible;
    property OnButtonClick;
    property OnButtonDown;
    property OnChange;
    property OnClick;
    {$IFDEF EH_LIB_5}
    property OnContextPopup;
    {$ENDIF}
    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 OnUpdateData;
    property OnStartDock;
    property OnStartDrag;
  end;

{ TDropDownBoxEh }

  TDropDownBoxEh = class(TPersistent)
  private
    FAlign: TDropDownAlign;
    FAutoDrop: Boolean;
    FRows: Integer;
    FSizable: Boolean;
    FWidth: Integer;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Align: TDropDownAlign read FAlign write FAlign default daLeft;
    property AutoDrop: Boolean read FAutoDrop write FAutoDrop default False;
    property Rows: Integer read FRows write FRows default 7;
    property Sizable: Boolean read FSizable write FSizable default False;
    property Width: Integer read FWidth write FWidth default 0;
  end;

{ TCustomDBComboBoxEh }

  TCustomDBComboBoxEh = class(TCustomDBEditEh)
  private
    FDropDownBox: TDropDownBoxEh;
    FItemIndex: Integer;
    FItems: TStrings;
    FKeyItems: TStrings;
    FListVisible:Boolean;
    FOnNotInList: TNotInListEventEh;
    FPopupListbox: TWinControl;
    FVarValue:Variant;
    function GetImages: TCustomImageList;
    function GetPopupListbox: TWinControl;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure ItemsChanged(Sender: TObject);
    procedure KeyItemsChanged(Sender: TObject);
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SetDropDownBox(const Value: TDropDownBoxEh);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetItemIndex(const Value: Integer);
    procedure SetItems(const Value: TStrings);
    procedure SetKeyItems(const Value: TStrings);
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  protected
    FItemsCount:Integer;
    FKeyBased:Boolean;
    function ConvertDataText(const Value:String):String;
    function CreateEditButton: TEditButtonEh; override;
    function DefaultAlignment: TAlignment; override;
    function GetVariantValue:Variant; override;
    function IsValidChar(InputChar: Char): Boolean; override;
    function LocateStr(Str: String; PartialKey:Boolean): Boolean; virtual;
    function ProcessSearchStr(Str: String):Boolean; virtual;
    function TextListIndepended: Boolean;
    function TraceMouseMoveForPopupListbox(Sender: TObject; Shift: TShiftState; X, Y: Integer): Boolean;
    procedure ButtonDown(IsDownButton:Boolean); override;
    procedure Change; override;
    procedure Click; override;
    procedure DataChanged; override;
    procedure EditButtonClick(Sender: TObject); override;
    procedure EditButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override;
    procedure InternalSetItemIndex(const Value: Integer);
    procedure InternalSetText(AText:String); override;
    procedure InternalSetValue(AValue:Variant); override;
    procedure InternalUpdatePostData; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure ResetMaxLength; override;
    procedure SetVariantValue(const VariantValue: Variant); override;
    procedure UpdateControlReadOnly; override;
    procedure UpdateItemIndex;
    procedure UpdateItems;
    procedure WndProc(var Message: TMessage); override;
    property PopupListbox: TWinControl read GetPopupListbox;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CloseUp(Accept: Boolean); override;
    procedure DefaultHandler(var Message); override;
    procedure DropDown; override;
    procedure SelectNextValue(IsPrior:Boolean);
    procedure UpdateData; override;
    property DropDownBox: TDropDownBoxEh read FDropDownBox write SetDropDownBox;
    property Images: TCustomImageList read GetImages write SetImages;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property Items: TStrings read FItems write SetItems;
    property KeyItems: TStrings read FKeyItems write SetKeyItems;
    property ListVisible: Boolean read FListVisible;
    property OnNotInList: TNotInListEventEh read FOnNotInList write FOnNotInList;
  end;

{ TDBComboBoxEh }

  TDBComboBoxEh = class(TCustomDBComboBoxEh)
  published
    property Alignment;
    property AlwaysShowBorder;
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BiDiMode;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownBox;
    property Enabled;
    property EditButton;
    property EditButtons;
    property EditMask;
    property Font;
    property Flat;
    property ImeMode;
    property ImeName;
    property Images;
    property Items;
    property KeyItems;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property WordWrap;
    property OnButtonClick;
    property OnButtonDown;
    property OnChange;
    property OnClick;
    {$IFDEF EH_LIB_5}
    property OnContextPopup;
    {$ENDIF}
    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 OnNotInList;
    property OnUpdateData;
    property OnStartDock;
    property OnStartDrag;
  end;

{ TCustomDBNumberEdit }

  TDBNumberValue = (evDisplayFormatEh, evCurrencyEh, evMaxValueEh, evMinValueEh);
  TDBNumberValues = set of TDBNumberValue;

  TCustomDBNumberEditEh = class(TCustomDBEditEh)
  private
    FAssignedValues: TDBNumberValues;
    FCurrency: Boolean;
    FDecimalPlaces: Cardinal;
    FDisplayFormat: String;
    FEditFormat: String;
    FIncrement: Extended;
    FInternalTextSetting:Boolean;
    FMinValue, FMaxValue: Extended;
    FValue:Variant;
//    FFormatting: Boolean;
    function CheckValue(NewValue: Extended): Extended;
    function DisplayFormatToEditFormat(const AFormat: string): string;
    function GetCurrency: Boolean;
    function GetDisplayFormat: string;
    function GetMaxValue: Extended;
    function GetMinValue: Extended;
    function IsCurrencyStored: Boolean;
    function IsDisplayFormatStored: Boolean;
    function IsIncrementStored: Boolean;
    function IsMaxValueStored: Boolean;
    function IsMinValueStored: Boolean;
    function TextToValText(const AValue: string): string;
    procedure SetCurrency(const Value: Boolean);
    procedure SetDecimalPlaces(Value: Cardinal);
    procedure SetDisplayFormat(const Value: string);
    procedure SetMaxValue(AValue: Extended);
    procedure SetMinValue(AValue: Extended);
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
  protected
    function DefaultAlignment: TAlignment; override;
    function DefaultCurrency: Boolean;
    function DefaultDisplayFormat: String;
    function DefaultMaxValue:Extended;
    function DefaultMinValue:Extended;
    function FormatDisplayText(Value: Extended): string;
    function GetDisplayText: string; virtual;
    function GetVariantValue:Variant; override;
    function IsValidChar(Key: Char): Boolean; override;
    procedure ButtonDown(IsDownButton:Boolean); override;
    procedure Change; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DataChanged; override;
    procedure InternalSetControlText(AText:String);
    procedure InternalSetText(AText:String); override;
    procedure InternalSetValue(AValue:Variant); override;
    procedure InternalUpdatePostData; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure ReformatEditText(NewText:String); dynamic;
    procedure UpdateValueFromText;
    property AssignedValues: TDBNumberValues read FAssignedValues;
    property currency:Boolean read GetCurrency write SetCurrency stored IsCurrencyStored;
    property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces default 2;
    property DisplayFormat:String read GetDisplayFormat write SetDisplayFormat stored IsDisplayFormatStored;
    property Increment: Extended read FIncrement write FIncrement stored IsIncrementStored;
    property MaxLength default 0;
    property MaxValue: Extended read GetMaxValue write SetMaxValue stored IsMaxValueStored;
    property MinValue: Extended read GetMinValue write SetMinValue stored IsMinValueStored;
//    property Formatting: Boolean read FFormatting;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
//    procedure Clear; override;
    procedure IncrementValue(IsIncrease:Boolean);
    property DisplayText: string read GetDisplayText;
  end;

{ TNumberEdit }

  TDBNumberEditEh = class(TCustomDBNumberEditEh)
  published
    property Alignment;
    property AlwaysShowBorder;
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property currency;
    property DataField;
    property DataSource;
    property DecimalPlaces;
    property DisplayFormat;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property EditButton;
    property EditButtons;
    property Font;
    property Flat;
    property ImeMode;
    property ImeName;
    property Increment;
    //property MaxLength;
    property MaxValue;
    property MinValue;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value;
    property Visible;
    property OnButtonClick;
    property OnButtonDown;
    property OnChange;
    property OnClick;
    {$IFDEF EH_LIB_5}
    property OnContextPopup;
    {$ENDIF}
    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 OnUpdateData;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses Commctrl, Clipbrd, DbConsts, Dialogs;

type
  TWinControlCracker = class(TWinControl) end;

//const
//  InitRepeatPause:Integer = 500;  { pause before first repeat timer (ms) }
//  RepeatPause:Integer     = 100;  { pause before next repeat timers (ms) }

function AlignDropDownWindow(MasterWin,DropDownWin:TWinControl;Align:TDropDownAlign):TPoint;
var P:TPoint;
    Y:Integer;
    WorkArea: TRect;
begin
  P := MasterWin.Parent.ClientToScreen(Point(MasterWin.Left, MasterWin.Top));
  Y := P.Y + MasterWin.Height;
  SystemParametersInfo(SPI_GETWORKAREA,0,Pointer(@WorkArea),0);

  if ((Y + DropDownWin.Height > WorkArea.Bottom) and (P.Y - DropDownWin.Height >= WorkArea.Top)) or
     ((P.Y - DropDownWin.Height < WorkArea.Top) and (WorkArea.Bottom - Y < P.Y - WorkArea.Top))
  then
  begin
    if P.Y - DropDownWin.Height < WorkArea.Top then
      DropDownWin.Height := P.Y - WorkArea.Top;
    Y := P.Y - DropDownWin.Height;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToTop),0);
  end else
  begin
    if Y + DropDownWin.Height > WorkArea.Bottom then
      DropDownWin.Height := WorkArea.Bottom - Y;