wwdblook.pas

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

    Procedure SetUseTFields(val: boolean);
    Function GetControlType: TStrings;
    Procedure SetControlType(val: TStrings);
    procedure SetButtonGlyph(Value: TBitmap);
    Function GetButtonGlyph: TBitmap;
    procedure SetButtonStyle(val: TwwComboButtonStyle);
    Procedure SetButtonWidth(val: integer);
    function GetButtonWidth: integer;
    procedure SetNavigator(Value: boolean);
    procedure SetController(Value: TwwController);

  protected
    FFieldLink: TFieldDataLink;
    FTimer: TTimer;

    FGrid: TwwPopupGrid;
    FButton: TwwComboButton;
    FLastSearchKey: string;  { Last Incremental Search value }
    InList: Boolean;
    TypedInText: string;
    OldLookupValue, OldDisplayValue: string; { Restore backvalues for unbound case}
    InAutoDropDown: boolean;
    SkipDataChange: boolean;  { Skip DataChange event so index doesn't change }
    FMouseInButtonControl: boolean;
    FFocused: Boolean;

    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    Function HasMasterSource: boolean;
    Function UseSeqSearch: boolean;
    Function LTable: TwwTable;
    Function IsWWCalculatedField: boolean;
    Procedure DrawButton(Canvas: TCanvas; R: TRect; State: TButtonState;
       ControlState: TControlState; var DefaultPaint: boolean); virtual;

    Function SetValue2: string; { Set based on 2nd lookup field }
    Function SetValue3: string; { Set based on 3rd lookup field }
    procedure WwChangeFromLink(AlookupTable: TDataSet; var modified: boolean);
    procedure OnEditTimerEvent(Sender: TObject); virtual; { Delay before doing incremental search }
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    function GetLookupSource: TDataSource;

    procedure UpdateData(Sender: TObject); reintroduce; // 5/21/03 - Unicode

    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Change; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure GridClick (Sender: TObject);
    procedure Loaded; override;
    Function GetLookupValue : string;
    procedure RedrawListGrid;
    Procedure UpdateButtonGlyph;
//    Function LoadComboGlyph: HBitmap; virtual;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; {handle tab}
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure UpdateFromCurrentSelection;
    procedure UpdateSearchIndex(useDisplayIndex: boolean);
    Function GetSearchIndex: integer;
    Procedure SetModified(val: boolean);
    Function IsValidChar(key: word): boolean;
    Function IsLookupDlg: boolean; virtual;
    Function IsLookupRequired: boolean;
    Function DoFindRecord(ASearchValue, ASearchField: string;  { For TwwTable finds }
                          matchType: TwwLocateMatchType): boolean; virtual;
    Procedure ComputeLookupFields;
    Procedure UpdateButtonPosition;
    function FindRecord(
       KeyValue: string;
       LookupField: string;
       MatchType: TwwLocateMatchType;
       CaseSensitive: boolean;
       PerformLookup: boolean = False): boolean; virtual;
//    procedure GetEditRectForFrame(var Loc: TRect); virtual;
    procedure DrawFrame(Canvas: TCanvas); virtual;
//    procedure GlyphChanged(Sender: TObject); virtual;
    function IsCustom: Boolean; virtual;
    function Is3DBorder: boolean;
    function GetEffectiveAlignment: TAlignment;
    procedure InvalidateTransparentButton;
    procedure PerformCustomSearch(
              SearchField: string;
              SearchValue: string;
              PerformLookup: boolean;
              var Found: boolean); virtual;
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
    function IsVistaComboNonEditable: boolean; virtual;

    property ControlCanvas:TControlCanvas read FCanvas;
    property MouseInControl: boolean read FMouseInControl;
  public
    wwDBCalcFieldType : TwwCalcFieldType;
    Patch: Variant;

    {$ifdef wwdelphi4up}
    function ExecuteAction(Action: TBasicAction): Boolean; override; { 8/24/98 }
    function UpdateAction(Action: TBasicAction): Boolean; override; {8/24/98}
    {$endif}

    function isTransparentEffective: boolean;
    procedure RefreshDisplay;  {Used only by property editor in design mode }
    procedure RefreshButton;
    procedure PerformSearch; { Call this from your onDropDown event if you apply a filter}

    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DropDown; dynamic;
    procedure CloseUp (modified: boolean); dynamic;
    property Value: string read GetValue write SetValue;
    property Value2: string read GetValue2;
    property Value3: string read GetValue3;
    property LookupValue: string read GetLookupValue write SetValue;
    property DisplayValue: string read GetDisplayValue write SetDisplayValue;
    property SearchField: string read FSearchField write FSearchField;

    property DropDownAlignment: TLeftRight read FDropDownAlignment write FDropDownAlignment;
    property Selected : TStrings read getSelectedFields write setSelectedFields;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ButtonStyle: TwwComboButtonStyle read FButtonStyle write SetButtonStyle;
    property ButtonEffects: TwwButtonEffects read FButtonEffects write FButtonEffects;
//    property ButtonFlat : boolean read GetFlatButton write SetFlatButton default False;
//    property ButtonTransparent: boolean read FFlatButtonTransparent write SetFlatButtonTransparent default false;
    property ButtonGlyph: TBitmap read GetButtonGlyph write SetButtonGlyph stored IsCustom;
    property ButtonWidth: integer read GetButtonWidth write SetButtonWidth default 0;
    property LookupTable : TDataSet read getLookupTable write setLookupTable;
    property LookupField: string read GetLookupField write SetLookupField;
    property Options: TwwDBLookupListOptions read GetOptions write SetOptions default [];
    property Style: TwwDBLookupComboStyle read FStyle write SetStyle default csDropDown;
    property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
    property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property AutoDropDown: boolean read FAutoDropDown write FAutoDropDown;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnBeforeDropDown: TNotifyEvent read FOnBeforeDropDown write FOnBeforeDropDown;
    property OnCloseUp: TNotifyCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property ShowButton: boolean read GetShowButton write SetShowButton;
    property SeqSearchOptions: TwwSeqSearchOptions read FSeqSearchOptions write FSeqSearchOptions
             default [ssoEnabled];
//    property Transparent: boolean read FTransparent write SetTransparent;
    property OnNotInList: TNotInListEvent read FOnNotInList write FOnNotInList;
    property Grid : TwwPopupGrid read FGrid write FGrid;
    property OrderByDisplay: boolean read FOrderByDisplay write FOrderByDisplay default True;
    property PreciseEditRegion: boolean read FPreciseEditRegion write SetPreciseEditRegion;
    property AllowClearKey: boolean read FAllowClearKey write FAllowClearKey;
    property ShowMatchText: boolean read FShowMatchText write FShowMatchText default False;
    property UseTFields: boolean read FUseTFields write SetUseTFields default True;
    property ImageList:TImageList read FImageList write FImageList;
    property ControlInfoInDataset: boolean
             read FControlInfoInDataset write FControlInfoInDataSet default True;
    property ControlType: TStrings read GetControlType write SetControlType;
    property Frame: TwwEditFrame read FFrame write FFrame;
    property Controller : TwwController read FController write SetController;
//    property UnboundAlignment : TAlignment read FUnboundAlignment write FUnboundAlignment default taLeftJustify;
    property SearchDelay: integer read FSearchDelay write FSearchDelay default 0;
//    property LookupSearchType: TwwLookupSearchType read FLookupSearchType write FLookupSearchType default lstDefault;
    property DropDownGridOptions: TwwDropDownGridOptions read FDropDownGridOptions write FDropDownGridOptions;
    property OnPerformCustomSearch: TwwPerformSearchEvent read FOnPerformCustomSearch write FOnPerformCustomSearch;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property Navigator : boolean read FNavigator write SetNavigator default False;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
  published
    {$ifdef wwDelphi4Up}
    property Picture: TwwDBPicture read FPicture write FPicture;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property ParentBiDiMode;  { 2/18/99 - Case sensitive name for Builder 4 }
    {$endif}
    property AutoSize;
    property Ctl3D;
    property Font;
    property CharCase;
    property BorderStyle;
  end;

  TwwDBLookupCombo= class(TwwDBCustomLookupCombo)
  published
    property Controller;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property DisableThemes;
    property ControlInfoInDataset;
    property ControlType;
    property DropDownAlignment;
    property Selected;
    property DataField;
    property DataSource;
    property LookupTable;
    property LookupField;
    property Options;
    property Style;
    property AutoSelect;
    property Color;
    property DragCursor;
    property DragMode;
    property DropDownCount;
    property DropDownWidth;
    property Enabled;
    property ButtonStyle default cbsDownArrow;
    property ButtonEffects;
    property Navigator;

    property Frame;
    property ButtonWidth;
    property ButtonGlyph;
    {$ifdef wwDelphi3Up}
    property ImeMode;
    property ImeName;
    {$endif}
    property ImageList;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property AutoDropDown;
    property ShowButton;
    property SeqSearchOptions;
    property OrderByDisplay;
    property SearchDelay;
    property UseTFields;
//    property LookupSearchType;
//    property UnboundAlignment;
//    property Transparent;

    property PreciseEditRegion;
    property AllowClearKey;
    property ShowMatchText;

    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnBeforeDropDown;
    property OnDropDown;
    property OnCloseUp;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnNotInList;
    property OnPerformCustomSearch;
  end;


  TwwDBLookupList = class(TwwCustomDBGrid)
  private
    FCombo: TwwDBCustomLookupCombo;
{    FSelected : TStrings;}

    FFieldLink: TFieldDataLink;
    FNavigatorLink: TFieldDataLink;
    FLookupField: String;
    FDisplayFld: TField;
    FValueFld: TField;  { Lookup Field - Should be unique }
    FValueFld2: TField; { If have 2 lookup fields }
    FValueFld3: TField; { If have 3 lookup fields }
    FValue: String;
    FValue2: String;
    FValue3: String;
    FDisplayValue: String;
    FHiliteRow: Integer;
    FOptions: TwwDBLookupListOptions;
    FTitleOffset: Integer;
    FFoundValue: Boolean;
    FInCellSelect: Boolean;
    FOnListClick: TNotifyEvent;
    BeAccurate: boolean;
    inDataChanged: integer;
    DummyString: string;  { Used so string is on heap instead of stack }

    function getSelectedFields: TStrings;
    procedure setSelectedFields(sel : TStrings);

    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetLookupSource: TDataSource;
    function GetLookupField: string;
    Function GetLookupTable: TDataSet;
    function GetValue: string;
    function GetValue2: string;
    function GetValue3: string;
    function GetDisplayValue: string;
    function GetReadOnly: Boolean;
    procedure FieldLinkActive(Sender: TObject);
    procedure DataChange(Sender: TObject);
    procedure NavigatorDataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetLookupSource(Value: TDataSource);
    procedure SetLookupTable(value : TDataSet);
    procedure SetLookupField(const Value: string);
    procedure SetValue(const Value: string);
    procedure SetDisplayValue(const Value: string);
    procedure SetReadOnly(Value: Boolean);
    procedure SetOptions(Value: TwwDBLookupListOptions);
    procedure NewLayout;
    procedure FastLookup;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
  protected
    procedure UpdateData(Sender: TObject); reintroduce;
    Function LTable: TwwTable;
    Function isWWCalculatedField: boolean;
    function HighlightCell(DataCol, DataRow: Integer; const Value: string;
      AState: TGridDrawState): Boolean; override;
    function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; override;
    procedure DefineFieldMap; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;