dbctrlseh.pas

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

{*******************************************************}
{                                                       }
{                       EhLib v2.1                      }
{            TDBEditEh,TDBDateTimeEditEh,               }
{      TDBComboBoxEh,TDBNumberEditEh components         }
{                                                       }
{     Copyright (c) 2001 by Dmitry V. Bolshakov         }
{                                                       }
{*******************************************************}

unit DBCtrlsEh;

{$I EhLib.Inc}

interface

uses Windows, SysUtils, Messages, Classes, Controls, Forms, Graphics, Menus,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
  StdCtrls, ExtCtrls, Mask, Buttons, ComCtrls, Db, DBCtrls, Imglist,
  ToolCtrlsEh, Consts;

const
   CM_EDITIMAGECHANGEDEH = WM_USER + 101;
   CM_IGNOREEDITDOWN =  WM_USER + 102;
type

{ TEditImageEh }

  TEditImageEh = class(TPersistent)
  private
    FEditControl: TWinControl;
    FImageIndex:Integer;
    FImages:TCustomImageList;
    FUseImageHeight: Boolean;
    FVisible: Boolean;
    FWidth: Integer;
    procedure SetImageIndex(const Value: Integer);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetUseImageHeight(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
  public
    constructor Create(EditControl: TWinControl);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ImageIndex: Integer read FImageIndex write SetImageIndex default 0;
    property Images: TCustomImageList read FImages write SetImages;
    property UseImageHeight: Boolean read FUseImageHeight write SetUseImageHeight default True;
    property Visible: Boolean read FVisible write SetVisible default False;
    property Width: Integer read FWidth write SetWidth default 0;
  end;

{ TFieldDataLinkEh }

  TFieldDataLinkEh = class(TDataLink)
  private
    FFields:TFieldsArrEh;
    FFieldName: string;
    FControl: TComponent;
    //FEditing: Boolean;
    //FModified: Boolean;
    FOnDataChange: TNotifyEvent;
    FOnEditingChange: TNotifyEvent;
    FOnUpdateData: TNotifyEvent;
    FOnActiveChange: TNotifyEvent;
    FMultiFields: Boolean;
    FDataIndepended: Boolean;
    FEditing: Boolean;
    FModified: Boolean;

    function GetActive: Boolean;
    function GetCanModify: Boolean;
    function GetDataSetActive: Boolean;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetFieldsCount: Integer;
    function GetFieldsField(Index: Integer): TField;
    procedure SetDataSource(const Value: TDataSource);
    procedure SetEditing(Value: Boolean);
    procedure SetField(Value: TList);
    procedure SetFieldName(const Value: string);
    procedure SetMultiFields(const Value: Boolean);
    procedure UpdateField;
    procedure UpdateRightToLeft;
  protected
    DataIndependentValue:Variant;

    function FieldFound(Value:TField):Boolean;
    procedure ActiveChanged; override;
    procedure EditingChanged; override;
    procedure FocusControl(Field: TFieldRef); override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
    procedure UpdateDataIndepended;
  public
    constructor Create;
    function Edit: Boolean;
    procedure Modified;
    procedure SetText(Text:String);
    procedure SetValue(Value:Variant);
    procedure Reset;

    property Active: Boolean read GetActive;
    property CanModify: Boolean read GetCanModify;
    property Control: TComponent read FControl write FControl;
    property DataIndepended: Boolean read FDataIndepended;
    property DataSetActive: Boolean read GetDataSetActive;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Editing: Boolean read FEditing;
    property Field: TField read GetField;
    property FieldName: string read FFieldName write SetFieldName;
    property Fields[Index: Integer]: TField read GetFieldsField;
    property FieldsCount: Integer read GetFieldsCount;
    property MultiFields: Boolean read FMultiFields write SetMultiFields;
    property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange;
    property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
    property OnEditingChange: TNotifyEvent read FOnEditingChange write FOnEditingChange;
    property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  end;

{ TCustomDBEditEh }

  TDBEditEhValue = (evAlignmentEh, evEditMaskEh);
  TDBEditEhValues = set of TDBEditEhValue;

  TCustomDBEditEh = class(TCustomMaskEdit, IComobEditEh, IUnknown)
  private
    FAlwaysShowBorder: Boolean;
    FAssignedValues: TDBEditEhValues;
    FCanvas: TControlCanvas;
    FCompleteKeyPress: String;
    FEditButton: TEditButtonEh;
    FEditButtons: TEditButtonsEh;
    FEditImage: TEditImageEh;
    FFlat: Boolean;
    FOnButtonClick: TButtonClickEventEh;
    FOnButtonDown: TButtonDownEventEh;
    FOnUpdateData: TUpdateDataEventEh;
    FReadOnly: Boolean;
    FWordWrap: Boolean;
    function GetAlignment: TAlignment;
   {$IFNDEF EH_LIB_6}
    function GetAutoSize: Boolean;
    {$ENDIF}
    function GetEditMask: String;
    function GetField: TField;
    function GetReadOnly: Boolean;
    function GetText: String;
    function GetTextMargins: TPoint;
    function GetValue: Variant;
    function ImageRect: TRect;
    function IsAlignmentStored: Boolean;
    function IsEditMaskStored: Boolean;
    function IsTextStored: Boolean;
    function IsValueStored: Boolean;
    procedure ActiveChange(Sender: TObject);
    procedure CheckCursor;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMEditImageChangedEh(var Message: TMessage); message CM_EDITIMAGECHANGEDEH;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure DataChange(Sender: TObject);
    procedure DrawBorder(DC: HDC; ActiveBorder: Boolean);
    procedure DrawEditImage(DC: HDC);
    procedure EditButtonChanged(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure InternalUpdateData(Sender: TObject);
    procedure ReadEditMask(Reader: TReader);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetAlwaysShowBorder(const Value: Boolean);
    procedure SetEditButton(const Value: TEditButtonEh);
    procedure SetEditButtons(const Value: TEditButtonsEh);
    procedure SetEditImage(const Value: TEditImageEh);
    procedure SetEditMask(const Value: String);
    procedure SetEditRect;
    procedure SetFlat(const Value: Boolean);
    procedure SetFocused(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure SetText(const Value: String);
    procedure SetValue(const Value: Variant);
    procedure SetWordWrap(const Value: Boolean);
    procedure UpdateDrawBorder;
    procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure WMNCPaint(var Message: TMessage);  message WM_NCPAINT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMUndo(var Message: TMessage); message WM_UNDO;
    procedure WriteEditMask(Writer: TWriter);
  protected
    FAlignment: TAlignment;
    FBorderActive: Boolean;
    FButtonHeight: Integer;
    FButtonWidth: Integer;
    FDataLink: TFieldDataLinkEh;
    FDataPosting: Boolean;
    FDownButton: Integer;
    FDroppedDown: Boolean;
    FEditButtonControlList: TEditButtonControlList;
    FFocused: Boolean;
    FImageWidth:Integer;
    FMouseAboveControl: Boolean;
    FNoClickCloseUp: Boolean;
    FPressed: Boolean;
    FPressedRect :TRect;
    function ButtonEnabled: Boolean; virtual;
    function ButtonRect: TRect;
    function CreateDataLink:TFieldDataLinkEh; virtual;
    function CreateEditButton: TEditButtonEh; virtual;
    function CreateEditButtonControl: TEditButtonControlEh; virtual;
    function CreateEditButtons: TEditButtonsEh; virtual;
    function CreateEditImage: TEditImageEh; virtual;
    function DataIndepended:Boolean; virtual;
    function DefaultAlignment: TAlignment; virtual;
    function DefaultEditMask: String; virtual;
    function EditCanModify: Boolean; override;
    function EditRect:TRect;
    function GetDataField: string; virtual;
    function GetDataSource: TDataSource; virtual;
    function GetEditButtonByShortCut(ShortCut: TShortCut): TEditButtonEh;
    function GetVariantValue:Variant; virtual;
    function IsValidChar(InputChar: Char): Boolean; virtual;
    function PostDataEvent: Boolean;
    procedure ActiveChanged; virtual;
    procedure AdjustHeight; virtual;
    procedure ButtonDown(IsDownButton:Boolean); virtual;
    procedure Change; override;
    procedure CloseUp(Accept: Boolean); virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DataChanged; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DropDown; virtual;
    procedure EditButtonClick(Sender: TObject); virtual;
    procedure EditButtonDown(Sender: TObject; TopButton: Boolean;
      var AutoRepeat: Boolean; var Handled: Boolean); virtual;
    procedure EditButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
    procedure EditButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); virtual;
    procedure EditingChanged; virtual;
    procedure InternalSetText(AText:String); virtual;
    procedure InternalSetValue(AValue:Variant); virtual;
    procedure InternalUpdatePostData; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PaintWindow(DC: HDC); override;
    procedure ResetMaxLength; virtual;
    procedure SetAutoSize(Value: Boolean); {$IFDEF EH_LIB_6} override; {$ELSE} virtual; {$ENDIF}
    procedure SetControlEditMask(Value:string);
    procedure SetControlReadOnly(Value:Boolean);
    procedure SetDataField(const Value: string); virtual;
    procedure SetDataSource(Value: TDataSource); virtual;
    procedure SetVariantValue(const VariantValue: Variant); virtual;
    procedure UpdateControlReadOnly; virtual;
    procedure UpdateEditButtonControlList;
    procedure UpdateEditButtonControlsState;
    procedure UpdateHeight; virtual;
    procedure WndProc(var Message: TMessage); override;
    property AssignedValues: TDBEditEhValues read FAssignedValues;
   {$IFNDEF EH_LIB_6}
    property AutoSize: Boolean read GetAutoSize write SetAutoSize default True;
    {$ENDIF}
    property EditButton: TEditButtonEh read FEditButton write SetEditButton;
    property EditButtons: TEditButtonsEh read FEditButtons write SetEditButtons;
    property EditImage: TEditImageEh read FEditImage write SetEditImage;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
    property OnButtonClick: TButtonClickEventEh read FOnButtonClick write FOnButtonClick;
    property OnButtonDown: TButtonDownEventEh read FOnButtonDown write FOnButtonDown;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function GetCompleteKeyPress: String;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    procedure DefaultHandler(var Message); override;
    procedure Reset; override;
    procedure UpdateData; virtual;
    property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property AlwaysShowBorder: Boolean read FAlwaysShowBorder write SetAlwaysShowBorder default False;
    property DataField: String read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property EditMask: String read GetEditMask write SetEditMask stored False;
    property Field: TField read GetField;
    property Flat:Boolean read FFlat write SetFlat default False;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property Text: String read GetText write SetText stored IsTextStored;
    property Value:Variant read GetValue write SetValue stored IsValueStored;
    property OnUpdateData: TUpdateDataEventEh read FOnUpdateData write FOnUpdateData;
  end;

  TDBEditEh = class(TCustomDBEditEh)
  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 EditButtons;
    property Enabled;
    property EditMask;
    property Font;
    property Flat;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property WordWrap;
    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;

{ TCustomDBDateTimeEditEh }

  TDateTimeKindEh = (dtkDateEh, dtkTimeEh {, dtkDateTimeEh} );

  TCustomDBDateTimeEditEh = class(TCustomDBEditEh)
  private
    FCalendarVisible:Boolean;
    FDropDownCalendar:TWinControl;
    FEditValidating:Boolean;
    FInternalTextSetting:Boolean;
    FKind: TDateTimeKindEh;
    FValue:Variant;
    function GetDropDownCalendar: TWinControl;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure SetKind(const Value: TDateTimeKindEh);
    procedure UpdateValueFromText;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  protected
    FFourDigitYear: Boolean;
    function CreateEditButton: TEditButtonEh; override;
    function GetVariantValue:Variant; override;
    procedure ButtonDown(IsDownButton:Boolean); override;
    procedure Change; override;
    procedure DataChanged; override;
    procedure EditButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override;
    procedure IncrementItemAtCurPos(IsIncrease:Boolean);
    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 UpdateFourDigitYear; virtual;
    procedure WndProc(var Message: TMessage); override;
    property DropDownCalendar: TWinControl read GetDropDownCalendar;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DateTimeFormat:String;
    procedure CloseUp(Accept: Boolean); override;
    procedure DropDown; override;