wwkeycb.pas

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

unit Wwkeycb;
{
//
// Components : TwwIncrementalSearch, wwKeyCombo
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 11/5/97 - Use IndexDefs property for 3rd party engines
// 2/18/98 - Backwards logic before in case sensitivity for clientdatasets.
// 2/19/98 - Support client-datasets with TwwKeyCombo (Use IndexFieldNames
//           property
// 5/30/98 - Support automatic refresh of keycombo when table changes index
// 7/4/98  - Support picture masks
// 8/27/98 - Virtual dataset fix for keycombo
// 9/15/98 - Only show visible fields in ClientDataSet
// 9/15/98 - SkipRefresh patch in Change method
// 10/12/98 - Remove error message when attached to child table
// 11/12/98 - Map fieldname to displayname in TClientDataSet
// 3/18/99 - Don't add calculated or lookupfields to list
// 1/6/00 - es_multiline style does not pass carriage return/line feed to form so
//            we pass it ourselves
// 1/31/2000 - Fix problem of tab not being passed
// 2/3/2000 - Check for nil dataset in change method
// 3/12/00 - Cast to TTable, not TwwTable
// 5/19/00 - Carriage return going to next line when borderstyle=bsnone
//           Also fix escape not closing dialog problem after backspace entered
// 1/21/01 - Give priority to indexes with 1 field index
// 2/14/04 - Should not exit if tempSearchField is blank, but instead use index field
// 7/8/04 - break or infinit loop
}

interface

{$i wwIfDef}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, db, dbtables, wwtable, wwstr, dialogs, wwcommon,
  wwSystem, ExtCtrls, wwdatsrc, menus, wwtypes, wwpict, wwframe, wwdbcomb, wwintl,
{$IFDEF WIN32}
bde
{$ELSE}
dbiprocs, dbiTypes, dbierrs
{$ENDIF}
;


type

  TwwKeyDataLink = class;
  TwwIncrementalSearch = class;
  TwwKeyCombo = class;
  TwwAfterSearchEvent = Procedure(Sender: TwwIncrementalSearch; MatchFound: boolean) of object;
  TwwKeyComboCloseUpEvent = procedure(Sender: TwwKeyCombo; Select: boolean) of object;

//  TwwKeyCombo = class(TCustomComboBox)
  TwwKeyCombo = class(TwwDBCustomComboBox)
    private
      FDataLink: TwwKeyDataLink;
      FShowAllIndexes: boolean;
      FPrimaryKeyName: string;
      skipReload: boolean;
      FShowAllFields: boolean;
      FOnCloseUp: TwwKeyComboCloseUpEvent;

    protected
      procedure CloseUp(Accept: Boolean); override;
      procedure Change; override;
      procedure SetDataSource(value : TDataSource);
      Function GetDataSource: TDataSource;
      Function GetPrimaryName: string;
      procedure SetShowAllIndexes(value: boolean);
      procedure SetShowAllFields(value: boolean);
      procedure Notification(AComponent: TComponent;
        Operation: TOperation); override;

    public
      Patch: Variant;
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure LinkActive(active: Boolean);
      procedure DataChanged; virtual;
      procedure InitCombo;
      procedure InitComboWithGrid(grid: TComponent);
      procedure RefreshDisplay;
      procedure DropDown; override;
      function UseAllFields(value: TDataSet): boolean; virtual;
      property ShowAllFields: boolean read FShowAllFields write SetShowAllFields;

    published
      property Controller;
      property DisableThemes;

      {$ifdef wwDelphi4Up}
      property Anchors;
      property Constraints;
      {$endif}

      property Style; {Must be published before Items}
      property AutoSize;
      property BorderStyle;
      property Color;
      property Ctl3D;
      property DragMode;
      property DragCursor;
      property DropDownCount;
      property Enabled;
      property Font;
      property ItemHeight;
{      property Items;}
      property MaxLength;
      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property PopupMenu;
      property ShowHint;
      property Sorted;
      property TabOrder;
      property TabStop;
      property Text;
      property Visible;
      property OnChange;
      property OnClick;
      property OnDblClick;
      property OnDragDrop;
      property OnDragOver;
      property OnDrawItem;
      property OnDropDown;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMeasureItem;
      property ShowAllIndexes: boolean read FShowAllIndexes write SetShowAllIndexes;
      property DataSource: TDataSource read getDataSource write setDataSource;
      property PrimaryKeyName: string read FPrimaryKeyName write FPrimaryKeyName;

      property ButtonEffects;
      property Frame;
      property ButtonWidth;
      property ButtonGlyph;
      property ButtonStyle;
      property OnCloseUp: TwwKeyComboCloseUpEvent read FOnCloseUp write FOnCloseUp;

  end;


  TwwSearchCaseSensitivity = (wwcsAutoDetect, wwcsCaseSensitive, wwcsCaseInsensitive);

  TwwIncrementalSearch = class(TCustomEdit)
    private
      FDataLink: TDataLink;
      FTimerInterval: integer;
      FTimer: TTimer;
      FOnAfterSearch: TwwAfterSearchEvent;
      FShowMatchText: boolean;
      LastValue: string;
      FieldNo: integer;
      FSearchField: string;
      FPictureMask: string;
      FPictureMaskAutoFill: boolean;
      FPictureMaskFromField: boolean;
      FFrame: TwwEditFrame;
      FFocused: boolean;
      FCanvas: TControlCanvas;
      FSearchDelay: integer;
      FCaseSensitivity: TwwSearchCaseSensitivity;
      FOnPerformCustomSearch: TwwPerformSearchEvent;
      FController: TwwController;
      FDisableThemes: boolean;
      function isTransparentEffective: boolean;
      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 WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
      procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; {handle tab}
      procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
      procedure SetController(Value: TwwController);

    protected
      procedure SetDataSource(value : TDataSource);
      Function GetDataSource: TDataSource;
      Function FindSearchField: string;
      procedure CreateParams(var Params: TCreateParams); override;
      procedure CreateWnd; override;
      procedure SetEditRect; virtual;
      procedure PerformCustomSearch(
              SearchField: string;
              SearchValue: string;
              PerformLookup: boolean;
              var Found: boolean); virtual;
      procedure Notification(AComponent: TComponent;
           Operation: TOperation); override;

    public
      Patch: Variant;
      property DelayTimer : TTimer read FTimer;

      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure FindValue;
      procedure OnEditTimerEvent(Sender: TObject);
      procedure KeyPress(var Key: Char); override;
      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
      procedure SetSearchField(ASearchField: string);
      procedure Clear;
      {$ifdef wwDelphi3Up} override; {$endif}


    published
      property Controller : TwwController read FController write SetController;
      property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
      {$ifdef wwDelphi4Up}
      property Anchors;
      property Constraints;
      {$endif}
      property Frame: TwwEditFrame read FFrame write FFrame;
      property DataSource: TDataSource read getDataSource write setDataSource;
      property SearchField : string read FSearchField write FSearchField;
      property OnAfterSearch: TwwAfterSearchEvent read FOnAfterSearch write FOnAfterSearch;
      property ShowMatchText: boolean read FShowMatchText write FShowMatchText default False;
      property PictureMask: string read FPictureMask write FPictureMask;
      property PictureMaskAutoFill: boolean read FPictureMaskAutoFill write FPictureMaskAutoFill default True;
      property PictureMaskFromField: boolean read FPictureMaskFromField write FPictureMaskFromField default False;
      property SearchDelay: integer read FSearchDelay write FSearchDelay default 0;
      property CaseSensitivity: TwwSearchCaseSensitivity read FCaseSensitivity write FCaseSensitivity default wwcsAutoDetect;
      property OnPerformCustomSearch: TwwPerformSearchEvent read FOnPerformCustomSearch write FOnPerformCustomSearch;
      property AutoSelect;
      property AutoSize;
      property BorderStyle;
      property CharCase;
      property Color;
      property Ctl3D;
      property DragCursor;
      property DragMode;
      property Enabled;
      property Font;
      property HideSelection;
      {$ifdef wwDelphi3Up}
      property ImeMode;
      property ImeName;
      {$endif}
      property MaxLength;
      property OEMConvert;
      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property PasswordChar;
      property PopupMenu;
      property ReadOnly;
      property ShowHint;
      property TabOrder;
      property TabStop;
      property Visible;
      property OnChange;
      property OnClick;
      property OnDblClick;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
  end;


  TwwKeyDataLink = class(TDataLink)
    private
      FwwKeyCombo: TwwKeyCombo;
    protected
      procedure DataSetChanged; override;
      procedure ActiveChanged; override;
    public
      constructor Create(key: TwwKeyCombo);
  end;

implementation

uses wwlocate, wwdbigrd, typinfo,
{$ifdef wwDelphi6Up}
variants,
{$endif}
 wwquery;
 
constructor TwwKeyDataLink.Create(key: TwwKeyCombo);
begin
   inherited Create;
   FwwKeyCombo:= key;
end;

procedure TwwKeyDataLink.ActiveChanged;
begin
   if FwwKeyCombo=Nil then exit;
   FwwKeyCombo.linkActive(active);
end;

constructor TwwKeyCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowAllFields := False;
  FDataLink:= TwwKeyDataLink.create(self);

  style:= csDropDownList;
  FPrimaryKeyName:='PrimaryKey';

  Patch:= VarArrayCreate([0, 0], varVariant);
  Patch[0]:= False; { SkipRefresh in Change method }

end;

destructor TwwKeyCombo.Destroy;
begin
  FDataLink.dataSource:= nil;
  FDataLink.free;
  FDataLink:= Nil;
  inherited destroy;
end;

procedure TwwKeyCombo.CloseUp(Accept: Boolean);
begin
   inherited CloseUp(Accept);
   ShowMatchText:= False;
   if Style=csDropDownList then Windows.HideCaret(Handle);

   if Assigned(FOnCloseUp) then FOnCloseUp(Self, Accept);

end;

procedure TwwKeyCombo.DropDown;
begin
   ShowMatchText:= True;
   inherited DropDown;
end;

function TwwKeyCombo.UseAllFields(value: TDataSet): boolean;
begin
   result:=
      wwIsClass(value.classType, 'TClientDataSet') or ShowAllFields or

      { Require client-side cursor if all fields are being shown in combo }
      ((wwGetDatabaseCursorType(value)=1) and

       // 8/14/02 - Support TADODataSet indexes
       (wwIsClass(value.classType, 'TADOTable') or wwIsClass(value.classType, 'TADODataSet')));

{   if result and wwIsClass(value.ClassType, 'TADODataSet') then
   begin
      if (wwGetCommandType(value)<>2) and
         (wwGetCommandType(value)<>3) then result:=false;
   end;
}
end;

procedure TwwKeyCombo.SetDataSource(value : TDataSource);
var PropInfo: PPropInfo;
begin
   if (value<>Nil) and
      (value.dataSet<>Nil) and
      { 2/19/98 - Allow table or clientdataset }
      not (wwIsClass(value.dataset.classType, 'TTable') or
           UseAllFields(value.dataset)) then
   begin
      PropInfo:= Typinfo.GetPropInfo(Value.DataSet.ClassInfo,'IndexDefs');
      if PropInfo=Nil then begin
         MessageDlg('DataSource must point to a dataset containing index information.',
                    mtWarning, [mbok], 0);
         exit;
      end
   end;

   FDataLink.dataSource:= value;
{$IFDEF WIN32}
   if value<>Nil then Value.FreeNotification(self); { Win95}
{$ENDIF}
   LinkActive(FdataLink.active);
end;

Function TwwKeyCombo.GetDataSource: TDataSource;
begin
   if FDataLink=Nil then Result:=Nil
   else Result:= FDataLink.dataSource;
end;

procedure TwwKeyCombo.LinkActive(active: Boolean);
begin
   if not Active then exit;
   InitCombo;
end;

Function TwwKeyCombo.GetPrimaryName: string;
begin
   if FPrimaryKeyName='' then result:= 'PrimaryKey'
   else result:= FPrimaryKeyName;
end;

procedure TwwKeyCombo.SetShowAllIndexes(value: boolean);
begin
   FShowAllIndexes:= value;
   if (datasource<>nil) {and (FShowAllIndexes<>value) }then
   begin
      initCombo;
   end