wwdblook.pas

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

unit wwdblook;
{
//
// Components : TwwDBLookupCombo
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 7/10/97 - Support non TwwTable lookup against a Linked or Lookup Field
// 7/21/97 - Added try/finally block to handle exceptions in EnableEdit
// 7/21/97 - ChangeFromLink now sets modified to True if just a plain calculated field
//           Previously would always be false in this case.
// 7/24/97 - Limit length to be up to field size
//
// 7/28/97 - If processing OnNotInList then ignore focus change since its
//           triggered by a message dialog by the user.  If we do call
//           UpdateRecord then the component incorrectly updates the tfield
//           even though the OnNotInList handler may indicate that it
//           it should not be updated.  Also select all text when
//           restoring back-values if user sets accept to false.
//
// 7/28/97   If modified then escape restores previous text.  Code added
//           to CnKeyDown.  UpdateData calls Closeup to handle NotInList.
//
// 7/30/97   Remove index switching on detail lookuptable when using a lookupfield
//
// 9/10/97 - Method UpdateFromCurrentSelection - Do not update active record if
//           its a TwwDBLookupComboDlg
//
// 9/18/97 - Reset backvalues when getting focus
//           Previously this code was in WMSetFocus, but that is fired also when
//           the form gets focus.  When the following code was placed in WMSetFocus,
//           the backvalues were incorrectly reset
//
// 9/18/97 - Escape updates FGrid.FDisplayValue instead of DisplayValue.
//           Previously in some cases could clear FDisplayValue to blank
//
// 9/18/97 - Don't beep when ShowMatchText is True
//
// 9/19/97 - Method KeyDown, Set ProcessingNotInList to True on escape so
//           validation is skipped in CMExit
//
// 9/28/97 - Assign TField.Text property intead of AsString property to fire
//           TField.OnSetText
//
// 10/5/97 - Method RefreshDisplay modifed to call DoLookup(False) to ensure
//           that lookuptable is positioned correctly before reading values.
//           Call this method to refresh the lookupcombo based on changes in
//           lookuptable.
//
// 10/12/97- Allows component to left-justify when exiting by setting selStart
//           to 0 in cmExit
// 10/16/97- When you have multiple combos on a form and the state changed from
//           Browse to Edit, then the combo would have its index changed while the
//           dropdown list was visible.  SetValue modified.
//
// 10/20/97- Use EnableEdit instead of FFieldLink.Edit so flag is set
// 10/20/97- Prevent the index from switching when delete key is pressed
// 10/21/97- Fix bug when drop-down grid remains visible after leaving column in
//           grid
//
// 10/27/97 - Fix for drawing text as disabled when control is dropdownlist style
//
// 10/29/97 - Search on calculated or lookup fields during incremental searching.
//            Previously used Locate method which did not support this.
//
// 11/6/97 -  Control was blank in some cases (i.e record-view dialog).  This
//            problem is now fixed.
//
// 11/15/97 - In Some Cases Quicken-Style would not work with autodropdown.
//            problem is now fixed.
//
// 11/19/97 - Fix - AllowClearKey when dropped down would change index order
// 11/25/97 - csDropDownList previosly did not update text when display field
//            differed from stored field in certain cases.
//
// 12/2/97 -  linked/lookup field use linked/lookup field value.
//            Optmization code now executed even when control is not visible
// 1/22/98 -  Don't allow clear key if csDropDownList
// 1/23/98 -  Clear FDisplayValue and hiliterow in AllowClearKey dropped-down case
//
// 2/5/98 -   Clear FDatalink.modified when encountering a vk_esc
//
// 2/20/98 - Don't clear tfield, so that esc can restore original contents
// 2/24/98 - Enable timer in KeyPress instead of KeyUp
//
// 3/1/98 -  Have NotInList event support for expression indexes
// 4/17/98 - Finish drawing down state in TwwComboButton MouseDown event
// 5/11/98 - Support Ctl3d=False
// 6/11/98 - Check for readonly flag when changing linked fields
// 8/24/98 - Support Delphi 4 ActionLists
// 8/25/98 - RefreshDisplay did not work properly with blank lookup values
// 8/25/98 - Update horzscrollbar property based on column widths.  This fixes
//           problem when have less rows than drop-down count.  The problem caused
//           the drop-down list to have the wrong active row when the last record
//           was selected.
// 8/26/98 - Adjust height more accurately as drop-down list was too tall when
//           titles were not shown in drop-down list
// 9/1/98 -  Don't call SetFocus unless CanFocus returns true in CMExit
// 9/2/98 -  Call FButton.Update in paint event so Delphi 4 paints icon correctly
//           in DBCtrlGrid
// 10/6/98 - Check dgTabs in cnKeyDown
// 10/8/98 - Fix problem with dgRowLines having the wrong number of records dropped down
// 10/16/98 - Drop-down grid created with height=0 for faster performance
// 11/15/98 - Calling closeup immediately would cause problems from hook
// 11/24/98 - Fix issues with pasting into control with respect to cs_DropDownList
// 1/20/99 -  Don't allow clear key if csDropDownList with AllowClearKey=False
// 1/21/99 -  Fix paint problem in situations where user invokess a dialog
              and when the dialog closes the focus returns to this control.
// 1/25/99 - Prevent grid's OnKeyDown from firing twice when encounter tab or cr
// 1/27/99 - Fixed problem with lookupfields where it was trying to assign a string
//           to the lookup field
// 3/9/99 -  Raise exception if exception raised in TField OnValidate.  Previously
//           the exception message would not be shown.  Also the focus could be lost without
//           this change.
// 3/14/99 - Remove flicker when shortening drop-down list (Delphi 4 problem only )
// 3/23/99 - Fix for 3/14/99 change
// 3/29/99 - RSW Don't clear unbound control if not in list
// 5/12/99 - Avoid exception by checking if semi-color exists in lookup field
// 5/27/99 - When clicking on a different combo dropdown controls edit area the
//           current combos text would be cleared after a delete.
// 6/16/99 - Fix problem where text didn't get cleared in tfield
// 7/25/99 - If entered text is not subset of current lookup record,
//           then set inlist to false.  This could happen if a trailing space
//           was in the entered text
// 10/20/99  Fixed alignment problem where it was using stored field's alignment
// 10/23/99 - Skip grid's hide controls when going into edit mode so
//            that focus does not move to the grid. Otherwise this could cause
//            the first character to be lost in some instances.
// 12/3/99 - Fix bug with button width not being used
// 12/11/99 - Fix problem of text not getting restored when OnNotInList sets
//            accept to false.
// 1/10/2000 -Fix problem of non TwwDatasets not recognizing control
//            information in drop-down list
// 3/7/00 - Use clGrayText for disabled color
// 3/9/00 - Fix problem when searching calculated field, as it was
//          not updating higlighted record.
// 3/14/00 - MDI forms should check ActiveControl instead of focused
//           to fix problem where 2nd button clicked was not recognized in MDI child
// 4/12/00 - Don't unselectall if showmatch text and partial selection from start already there
// 5/3/00 - Don't go into edit for readonly dataset
// 6/14/00 - RSW Fix problem with scroll thumb being too small as visiblerowcount is incorrect
// 7/31/00 - Makes sure modified is set in combo's change
// 8/17/00 - Add Option | loFixedDropDownHeight to support custom search
// 8/17/00 - Add OnPerformCustomSearch event for paramaterized query searching
// 9/13/00 - Workaround problem where locate ignores trailing spaces
// 10/17/00 - Height not accurate when multiple title lines are shown
// 11/28/2000 - PYW - Check based on actual work area.
// 8/8/01 - If auto-dropping down the item would not be highlighted in some cases.
// 9/7/2001 - Don't Clear unbound control if Accept was True.
// 3/12/02 - Support mousewheel
// 4/16/02 - Use AnsiUppercase instead.
// 12/12/02 - Don't unclear unbound control if accept is true
// 12/13/02 - Fix bug where still cleared even though AutoEdit=False
// 12/16/02 - Delphi 7 needs topmost so that hint window doesn't send the
//            listbox to the background
// 3/06/03 - Check for blank field name om timer event
// 4/9/03 - Fix bug with Navigator property causing Access violation
// 4/26/03 - Fix problem where hint for other control closing up dialog
// 5/17/03 - Call DropDown in cases where previously exited.  Otherwise AutoDropDown
//           does not always drop down if not found in list
// 6/10/03 - Respect bidi mode
// 8/16/04 - Update text to be same as lookupfield
// 10/24/06 - Performance issue - Remove extra unnecessary search
}
interface

{$i wwIfDef.pas}

uses Windows, Classes, StdCtrls, DB, Controls, Messages, SysUtils,
  Forms, Graphics, Menus, Buttons, DBTables, Grids, dialogs,
  wwTable, {dsgnintf, }wwCommon, wwstr, wwdbigrd, extctrls, wwlocate, dbctrls,
  wwtypes, wwframe, wwdbedit, wwcombobutton, wwintl;

type

  TNotifyCloseUpEvent = procedure(Sender: TObject;
     LookupTable: TDataSet; FillTable: TDataSet; modified: boolean) of object;
  TNotInListEvent = procedure(Sender: TObject;
     LookupTable: TDataSet; NewValue: string; var Accept: boolean) of object;
  TwwPerformSearchEvent = procedure(Sender: TObject;
     LookupTable: TDataSet;
     SearchField: string;
     SearchValue: string;
     PerformLookup: boolean;
     var Found: boolean) of object;

  TwwPopupGrid = class;

  TwwDBLookupComboStyle = (csDropDown, csDropDownList);
  TwwDBLookupListOption = (loColLines, loRowLines, loTitles, loFixedDropDownHeight,
                           loSearchOnBackspace);
  TwwDBLookupListOptions = set of TwwDBLookupListOption;

  TwwCalcFieldType = (cftUnknown, cftCalculated, cftNotCalculated);

  TwwSeqSearchOption = (ssoEnabled, ssoCaseSensitive);
  TwwSeqSearchOptions = set of TwwSeqSearchOption;
  TwwLookupSearchType = (lstDefault, lstCustom);

//  TwwLookupComboButtonStyle = (lcbsEllipsis, lcbsDownArrow, lcbsCustom);

  TwwDropDownGridOptions = class(TPersistent)
  private
     FTitleLines: integer;
     FColor: TColor;
     FTitleAlignment: TAlignment;
  public
     constructor Create(AOwner: TComponent);
  published
     property TitleLines: integer read FTitleLines write FTitleLines default 1;
     property Color: TColor read FColor write FColor default clWindow;
     property TitleAlignment: TAlignment read FTitleAlignment write FTitleAlignment default taLeftJustify;
  end;

  TwwDBCustomLookupCombo= class(TCustomEdit)
  private
    FController: TwwController;
    FPicture: TwwDBPicture;
    FDropDownAlignment: TLeftRight;
    FCanvas: TControlCanvas;
    FDropDownCount: Integer;
    FDropDownWidth: Integer;
    FBtnControl: TWinControl;
    FStyle: TwwDBLookupComboStyle;
    FOnDropDown: TNotifyEvent;
    FOnCloseUp: TNotifyCloseUpEvent;
    FOnNotInList: TNotInListEvent;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FShowMatchText: boolean;
//    FLookupSearchType: TwwLookupSearchType;
    FOnPerformCustomSearch: TwwPerformSearchEvent;
    FOnBeforeDropDown: TNotifyEvent;
    FDropDownGridOptions: TwwDropDownGridOptions;
    FNavigator: boolean;

    ChangingFromLink: boolean;
    ProcessingNotInList: boolean;
    InCloseUpEvent: boolean;
    FSearchDelay: integer;
    FAutoDropDown: boolean;
    FSearchField: String;
    FSeqSearchOptions: TwwSeqSearchOptions;
    FOrderByDisplay: boolean;
    FItemCount: integer;
    FPreciseEditRegion: boolean;
    FAllowClearKey: boolean;
    FUseTFields: boolean;
    FImageList: TImageList;
    FButtonStyle: TwwComboButtonStyle;

    ExtraHeight: integer;     { Extra 1 pixel for height when in 16 bit }
    FControlInfoInDataset: boolean;
    FFrame: TwwEditFrame;
//    FUnboundAlignment: TAlignment;
    FButtonEffects: TwwButtonEffects;
//    FButtonGlyph: TBitmap;
    FButtonWidth: integer;
//    FFlatButton: boolean;
//    FFlatButtonTransparent: boolean;
//    FTransparent: boolean;
//    FCreateTransparent: boolean;

//    procedure SetTransparent(val: boolean);
    SkipUpdate: boolean;
    SetModifiedInChangeEvent: boolean;
//    InDropDownEvent, InCustomSearch: boolean;
    InDropDownEvent: boolean;
    InCustomSearch: boolean;
    FDisableThemes: boolean;
    OldShowHint: boolean;
    FMouseInControl: boolean;

    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetLookupTable: TDataSet;
    function GetLookupField: string;
    function GetReadOnly: Boolean;
    function GetValue: string;
    function GetValue2: string;
    function GetValue3: string;

//    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton;
//       Shift: TShiftState; X, Y: Integer);
    procedure EnableEdit;
    function GetDisplayValue: string;
    function GetMinHeight: Integer;
    function GetOptions: TwwDBLookupListOptions;
    function CanEdit: Boolean;
    function Editable: Boolean;
    function MouseEditable: Boolean;
    procedure SetValue(const NewValue: string);
    procedure SetDisplayValue(const NewValue: string);
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
{    procedure SetLookupSource(Value: TDataSource);} { 4/30/97 - Not used }
    procedure SetLookupTable(sel : TDataSet);
    procedure SetLookupField(const Value: string);
    procedure SetReadOnly(Value: Boolean);
    procedure SetOptions(Value: TwwDBLookupListOptions);
    procedure SetStyle(Value: TwwDBLookupComboStyle);
    Procedure SetPreciseEditRegion(val: boolean);
    procedure FieldLinkActive(Sender: TObject);
    procedure NonEditMouseDown(var Message: TWMLButtonDown);
    procedure DoSelectAll;
    procedure SetEditRect;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure WMPaste (var Message: TMessage); message WM_PASTE;
    procedure WMCut (var Message: TMessage); message WM_CUT;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;    
    function getSelectedFields: TStrings;
    procedure setSelectedFields(sel : TStrings);

    function GetShowButton: boolean;
    procedure SetShowButton(sel: boolean);
    Function IsLookup: boolean;