wwdbedit.pas

胜天进销存源码,国产优秀的进销存

{
//
// Components : TwwDBEdit
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
//
//  8/12/97 - Clear selLength when handling mask in keypress event.  This fixes
//            a bug which updated the text incorrectly.
//
//  9/24/97 - Modify EditCanModify to return True for non physical fields
//
//  10/2/97 - Avoid beep in record-view
//
//  10/27/97 - Fix for drawing text as disabled when control is dropdownlist style
//
//  12/24/97 - Retrieve maxlength from field
//
//  2/14/98 - Non-editable control that has focus (i.e. combo - dropdownlist)
//  3/31/98 - Allow Horizontal Scroll when WordWrap and a single line edit control.
//  3/31/98 - Modified GetClientEditRect to return the actual Edit Rectangle
//  5/28/98 - Support password char in grid
//  8/24/98 - Support Delphi 4 ActionLists
//  9/2/98 -  Fixed 2 digit year bug in method UpdateData
//  9/15/98 - Fix bug where Calculated fields could not be modified with AutoEdit=False
// 10/12/98 - Avoid converting 4 digit years to prevent 1900 from converting to 2000
// 11/8/98 - Display memo text if outside grid by skipping inherited
// 12/16/98 - Fix problem when attached to memo field in WMPaint
// 12/16/98 - Support different epoch date by setting Patch[0] to the year.
//            Only supported if using Delphi 4.
// 1/7/99 - Avoid beep in record-view dialog
// 1/25/99 - Prevent grid's OnKeyDown from firing twice when encounter tab or cr
// 7/7/99 -  Clear inherited readonly when setting datasource
// 7/14/99 - Fix bug if memo is greater than 255 characters when usnig
//           custom editor
// 12/3/99 - Set focus so that transparent control paints correctly
// 12/12/99 - Honor grid's colors when painting cell
// 1/4/2000 - es_multiline style does not pass carriage return/line feed to form so
              we pass it ourselves
// 1/10/2000 Readonly memo fields not displaying
// 3/7/00 - Use clGrayText for disabled color
// 5/18/00 - Need to save changes in undo mode
// 8/22/00 - New property EditAlignment
// 8/22/01 - Don't call inherited if parent processed keystroke.
//            Parent could process keystroke in case of popup menu with escape
//            key assigned
// 11/9/01 - Fix left-border framing erase problem when using certain fonts
//2/20/2002 - Added check for BidiMode.  Otherwise alignment isn't correct when this ws is removed.
// 1/13/03 - Recognize text assignments and go into edit mode
// 4/17/03 - Support bidimode in csPaintCopy (grid can now use custom control with bidimode)
// 5/7/03 - Support DisplayFormat property to manipulate unbound edit controls
//          Also add supporting public property UnboundValue
}
unit wwdbedit;

interface

{$i wwIfDef.pas}

uses
  windows, Forms, Graphics, Menus, SysUtils, Messages, Classes,
  Controls, Buttons,   wwintl,
  dbctrls, mask, db, dbtables, stdctrls, dialogs, wwdatsrc, grids, wwframe,
  wwtypes,clipbrd;

type

  TwwValidateEvent = procedure(Sender: TObject; PassesPictureTest: boolean) of object;
  TwwEditDataType = (wwDefault, wwEdtDate, wwEdtTime, wwEdtDateTime);

  TwwRegexMask = class(TPersistent)
    private
       FMask: string;
       FCaseSensitive: boolean;
       FAllowInvalidExit: boolean;
       FErrorMessage: string;
       RelatedComponent: TComponent;
       procedure SetMask(value: string);
    public
       constructor Create(Owner: TComponent);
        Procedure Assign(Source: TPersistent); override;
    published
       property Mask: string read FMask write SetMask;
       property CaseSensitive: boolean read FCaseSensitive write FCaseSensitive default true;
       property AllowInvalidExit: boolean read FAllowInvalidExit write FAllowInvalidExit default false;
       property ErrorMessage: string read FErrorMessage write FErrormessage;
  end;

  TwwDBPicture = class(TPersistent)
  private
    FPictureMaskFromDataSet: boolean;
    FPictureMask: String;
    FAutoFill: boolean;
    FAllowInvalidExit: boolean;
    RelatedComponent: TComponent;

    procedure FlushToDataset(SetMask, SetAutoFill, SetUsePictureMask: boolean);
    procedure SetPictureMask(val: string);
    procedure SetAutoFill(val: boolean);
    procedure SetAllowInvalidExit(val: boolean);
    Function GetPictureMask: string;
    Function GetAutoFill: boolean;
    Function GetAllowInvalidExit: boolean;
  public
    constructor Create(Owner: TComponent);
    Procedure Assign(Source: TPersistent); override; { Add override 1/13/97}
    Function IsDatasetMask: boolean;

  published
    property PictureMaskFromDataSet: boolean read FPictureMaskFromDataset write FPictureMaskFromDataset default True;
    property PictureMask: string read GetPictureMask write SetPictureMask;
    property AutoFill: boolean read GetAutoFill write SetAutoFill default True;
    property AllowInvalidExit: boolean read GetAllowInvalidExit write SetAllowInvalidExit default False;
  end;

  TwwCustomMaskEdit = class(TCustomMaskEdit)
  private
    FwwPicture: TwwDBPicture;
    FRegexMask: TwwRegexMask;
    FWordWrap: boolean;
    FOnCheckValue: TwwValidateEvent;
    FUsePictureMask: boolean;
    FWantReturns: boolean;
    FShowVertScrollBar: boolean;
    DoExitPictureError: boolean;
//    FTransparent: boolean;
//    FCreateTransparent: boolean;
    FFrame: TwwEditFrame;
    FMaskStoreLiteralTemplate: boolean;
    FController: TwwController;

    OrigForeColor: TColor;
    OrigBackColor: TColor;

    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
//    procedure SetTransparent(val: boolean);
    procedure SetController(Value: TwwController);

  protected
    ModifiedInKeyPress: boolean; {1/21/97 - True if keypress event modified text }
    SetModifiedInChangeEvent: boolean;

    Function GetMaskBlank: char;
    Function OwnerDraw: boolean; virtual;
    Function CustomDraw: boolean; virtual;    
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure EnableEdit; dynamic;

    procedure SetWordWrap(val: boolean);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoExit; override;

    procedure SetEditRect; virtual;
    procedure CreateWnd; override;
    procedure WMSize(var Message:TWMSize); message wm_size;

    Function HavePictureMask: boolean;
    function RemoveEditFormat(const Value: string): string;
    procedure DoOnCheckValue(Valid: boolean); virtual;
    procedure SetShowVertScrollBar(Value: boolean);
    procedure ValidationErrorUsingMask(msg: string); virtual;
//    procedure GetEditRectForFrame(var Loc: TRect); virtual;
  public
    Patch: Variant;
    procedure ApplyValidationColors(valid: boolean); virtual;
    procedure ResetValidationColors(ForeColor: TColor = clNone;
                                    BackColor: TColor = clNone); virtual;
    procedure DoRefreshValidationDisplay(valid: boolean); overload; virtual;
    procedure DoRefreshValidationDisplay(input: string=''); overload; virtual;

    function IsValidPictureValue(s: string): boolean;
    function IsValidRegexValue(s: string): boolean;
    function IsValidPictureMask(s: string): boolean;
    function IsValidRegexMask(s: string): boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ApplyMask;
    function Is3DBorder: boolean;
    function JustHaveLiteralTemplate: boolean;

    property MaskStoreLiteralTemplate: boolean read FMaskStoreLiteralTemplate write FMaskStoreLiteralTemplate default False;
    property Frame: TwwEditFrame read FFrame write FFrame;
    property Controller : TwwController read FController write SetController;
    property Picture: TwwDBPicture read FwwPicture write FwwPicture;
    property RegexMask: TwwRegexmask read FRegexMask write FRegexMask;
    property WordWrap: boolean read FWordWrap write SetWordWrap;
    property OnCheckValue: TwwValidateEvent read FOnCheckValue write FOnCheckValue;
    property UsePictureMask: boolean read FUsePictureMask write FUsePictureMask default True;
    property WantReturns: boolean read FWantReturns write FWantReturns;
    property ShowVertScrollBar: boolean read FShowVertScrollBar write SetShowVertScrollBar default False;
//    property Transparent: boolean read FTransparent write SetTransparent;
  end;

  TwwPictureValidationError = procedure (Sender: TObject;
     Field: TField; var Msg: string; var DoDefault: boolean) of object;

  TwwDBCustomEdit = class(TwwCustomMaskEdit)
  private
    FDataLink: TFieldDataLink;
    FCanvas: TControlCanvas;
    FAlignment, FUnboundAlignment: TAlignment;
    FTextMargin: Integer;
    StartValue: string;
    FAutoFillDate: boolean;
    FDataType: TwwEditDataType;
//    FUnderlineControl: boolean;
    FEpochYear: integer;
    FEditAlignment: TwwEditAlignment;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FDisplayFormat: string;
    FDisableThemes: boolean;
    FMouseInControl: boolean;
//    FOnValidationErrorUsingMask: TwwPictureValidationError;

    procedure SetPicture(val: TwwDBPicture);
    function GetPicture: TwwDBPicture;

//    procedure SetRegexMask(val: TwwRegexMask);
//    function GetRegexmask: TwwRegexMask;

    Function DoAutoFillDate(var key: char): boolean;
    procedure CalcTextMargin;
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFocused(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure WMUndo(var Message: TMessage); message WM_UNDO;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    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 CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; {handle tab}
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;

    procedure SetUnboundValue(Value: Double);
    function GetUnboundValue: Double;
  protected
    FFocused: Boolean;
    property MouseInControl: boolean read FMouseInControl;

//    function IsPasswordCharAssigned: boolean; virtual;
    // GetDisplayFormat is NOT access method
    procedure Paint; virtual; // inherited Paint
    procedure UpdateData(Sender: TObject); virtual;
    function IsVistaComboNonEditable: boolean; virtual;
    function GetDisplayFormat: string; virtual;
    procedure SetDisplayFormat(val: string); virtual;
    function PreventEdit: boolean; virtual;
    procedure CreateWnd; override;
    procedure DataChange(Sender: TObject);
    procedure Change; override;
    function EditCanModify: Boolean; override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure DoEnter; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; override;

    procedure Reset; override;
    Function GetIconIndent: integer; dynamic;
    Function GetIconLeft: integer; dynamic;
    procedure EnableEdit; override;
    Function IsMemoField: boolean; virtual;
    Function GetDBPicture: string;
    Function Editable: boolean; virtual;
    Function GetClientEditRect: TRect; virtual;
    Function GetStoredText: string; virtual;  { Map Text to stored value }
    Procedure ShowText(ACanvas: TCanvas;
          ARect: TRect; indentLeft, indentTop: integer; AText: string; transparent: boolean = false); virtual;
    Function StorePictureProperty: boolean;
    Procedure SetModified(val: boolean); //virtual; // Make virtual for unicode
    Function ParentGridFocused: boolean;
    Function AllSelected: boolean;
    function GetShowButton: boolean; virtual;
    procedure SetShowButton(sel: boolean); virtual;

    Function isDateField: boolean;
    Function isTimeField: boolean;
    Function isDateTimeField: boolean;
    property ControlCanvas:TControlCanvas read FCanvas write FCanvas;
    property Picture read GetPicture write SetPicture stored StorePictureProperty;
    procedure WndProc(var Message: TMessage); override;
    procedure DrawFrame(Control: TWinControl;
      Canvas: TCanvas); virtual;
    function GetEffectiveAlignment: TAlignment;
//    procedure ValidationErrorUsingMask(Field: TField); virtual; // obsolete
    procedure ValidationErrorUsingMask(msg: string); override;
    Function IsDroppedDown: boolean; virtual;
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
    procedure SetAlignment(Value: TAlignment); virtual; { Unicode }
    procedure DrawFocusRect(ACanvas: TCanvas; ARect: TRect); virtual;    
  public
    property EpochYear: integer read FEpochYear write FEpochYear default 0;
    property DataLink: TFieldDataLink read FDataLink;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function isTransparentEffective: boolean;

    {$ifdef wwdelphi4up}
    function ExecuteAction(Action: TBasicAction): Boolean; override; { 8/24/98 }
    function UpdateAction(Action: TBasicAction): Boolean; override; {8/24/98}
    {$endif}
    Function GetFieldMapText(StoreValue: string; var res: string): boolean; virtual; {Map Value to Display Value }
    procedure UpdateRecord;  { Flush edit's datalink contents to dataset record buffer }
    procedure InitText(val: string);

    property Color;
    property Font;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    property Field: TField read GetField;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property AutoFillDate: boolean read FAutoFillDate write FAutoFillDate default True;
    property ShowButton: boolean read GetShowButton write SetShowButton;
    property UnboundDataType: TwwEditDataType read FDataType write FDataType;

    // Add in InfoPower 5 to support unbound alignment control
    property UnboundAlignment : TAlignment read FUnboundAlignment write FUnboundAlignment default taLeftJustify;
    property UnboundValue: Double read GetUnboundValue write SetUnboundValue;

    property EditAlignment: TwwEditAlignment read FEditAlignment write FEditAlignment default eaLeftAlignEditing;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

    // Possibly publish later to support unbound numeric formatting
    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
  end;

  TwwDBEdit = class(TwwDBCustomEdit)
  published
    property Controller;
    property DisableThemes;
    {$ifdef wwDelphi4Up}
    property Anchors;
    property BiDiMode;
    {$endif}
    property AutoFillDate;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
    {$ifdef wwDelphi4Up}
    property Constraints;
    property ParentBiDiMode;  { 2/18/99 - Case sensitive name for Builder 4 }
    {$endif}

    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;

    property Ctl3D;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property EditAlignment;  // 8/22/00 - Allow user to control editing alignment
    property Enabled;
    property Font;
    property Frame;
    {$ifdef wwDelphi3Up}
    property ImeMode;
    property ImeName;
    {$endif}
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property Picture;
    property RegexMask;
    property PopupMenu;
    property ReadOnly;
    property MaskStoreLiteralTemplate;