wwfltdlg.pas

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

unit wwfltdlg;
{
//
// Components : TwwFilterDialog
//
// Copyright (c) 1996-2001 by Woll2Woll Software
//
//
// 9/9/97 - Support alternate display label when operating against a
//          joined query.  Previously SelectedField mappings were ignored
//
// 10/25/97 - Get session name to assign to temporary table object
//
// 11/12/97 - Hide range value select tab if its a memo field for a query
//
// 11/18/97 - Remove Form.IsValueType reference so it works without dialog
//
// 11/18/97 - Treat boolean as non-value type
//
// 11/18/97 - 16 bit BDE treat boolean as string by using quotes when creating sql
// 1/8/98 - Check to see if displaylabel is defined in selectedfields
// 1/17/98 - Add '$' to list of valid characters for GetWord to handle tablenames
//           with $ in them.
//
// 2/24/98 - Support ending range pad character
//
// 4/22/98 - Free FFldList items before clearing it
// 4/30/98 - Default Field would not be on correct field if displaylabel contained '~'
// 9/18/98 - Don't reference wwFilterMemoSize in destructor
// 9/30/98 - When replacing where clause, do not include blank lines
// 10/1/98 - Fix problems when using queries with parameterized queries.
// 11/17/98 - Set patch[0] to True to preserve filter even when dataset is closed
// 11/24/98 - Set patch[1] to True to preserve old behavior of enclosing value in single quotes
//            New behavior supports single quotes in text
// 12/9/98 - Skip clearing of filter when closing table. This fixes a problem
//           where the filter was cleared the 2nd time when optimizations to
//           use table indexes were performed.
// 2/23/99 - Give owner to TempDataSet for 3rd party engines
// 4/8/99 -  Make sure its TParams, so virtual datasets that don't use TParams won't throw an exception
// 5/20/99 - Recognize and save date/time pair
// 5/20/99 - Use AnsiUpperCase instead of Uppercase when converting field value.
// 6/5/99  - RSW - Repaint calling form
// 6/25/99 - Support mapped list
// 9/17/99 - Added FixedChar Support.
// 11/22/99 - Maplist support
// 12/3/99 - fix incompatibility with usetfields and sqltables property.
// 01/13/00 - Add OnEncodeValue event so that user can change how the value is formatted
//            when forming sql string
// 2/01/2000 - Support aliases in fieldnames when using FieldsFetchMethod of fmUseTFields
// 2/8/2000 - Add SQLPropertyName property so that you can use it with component that use
//            a different property name besides SQL.
// 2/9/2000 - Use TDefCollection Find so that FieldDef = nil does not throw exception
// 4/21/00 - Remove patch[0] reference
// 5/1/00 - Restore original case for replacewhereclause
// 5/20/00 - Memo fields should not use = operator
// 6/4/00 - Support values of "or" and "and" as field values instead
//          of operators
// 6/07/00 - PYW - Only put the date and time when there is a Time Value and/or when
//             there is a time separator in the Max Date Range TwwDBDateTimePicker text.
// 7/2/00 - Support non ttables partial match for value type
// 7/25/00 - Fix index out of range problem with filterdialog
// 7/31/00 - Some dataset's close dataset when filter set to false so prevent
//           clearing of fieldinfo
// 11/21/00 - Support OnEncodeValue event for range
// 5/11/2001 - PYW Truncate word after encoding value.
// 8/7/01 - 2nd Time in dialog, it defaults to the wrong tab page.
//          Should default to searched fields tab page.
// 1/4/02 - Refresh with all fields when new search button is clicked.
// 2/28/02 - Make procedure AdjustFieldTabSet public.
// 6/17/02 - Make default (necessary when no bitmaps in button
// 6/25/02 - Support non-tstring type
// 12/17/03 - Add support for ftLargeInt
// 9/4/04 - Set Patch[3] to true to enable alternate code to parse unions
// 2/6/06 - Introduce Patch[4]
}
interface

{$i wwIfDef.pas}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, DB, Wwdatsrc, ExtCtrls, Buttons, wwfltdum, dbtables,
  Tabs, wwcommon, wwsystem, wwDialog, wwDBDateTimePicker, Mask, wwdbedit,
  Wwdotdot, Wwdbcomb, wwclearbuttongroup, wwradiogroup, ComCtrls,
  { wsdlintf, } widestrings,
  typinfo;


type
  TwwFilterDialogOption = (fdCaseSensitive, fdShowCaseSensitive, fdShowOKCancel,
                               fdShowViewSummary, fdShowFieldOrder,
                               fdShowValueRangeTab, fdShowNonMatching,
                               fdHidePartialAnywhere, fdDisableDateTimePicker, fdSizeable,
                               fdTabsAtTop);

  TwwFilterFieldsFetchType = (fmUseTTable, fmUseSQL, fmUseTFields);
  TwwFilterDialogOptions = set of TwwFilterDialogOption;

  TwwFilterDialogSort = (fdSortByFieldNo, fdSortByFieldName);
  TwwFilterMatchType = (fdMatchStart, fdMatchAny, fdMatchExact,
                        fdMatchEnd, fdMatchRange, fdMatchNone);
  TwwFilterMethodAll = (fdByFilter, fdByQueryModify, fdByQueryParams);
  TwwFilterMethod = fdByFilter..fdByQueryModify;

  TwwDefaultMatchType = fdMatchStart..fdMatchExact;
  TwwDefaultFilterBy = (fdSmartFilter, fdFilterByRange, fdFilterByValue);
  TwwFilterDlg = class;
  TwwFilterDialogSummaryEvent = procedure(Sender: TObject; AFieldInfo: TList;
     var DoDefault: boolean) of object;
  TwwOnInitTempDataSetEvent = procedure(
     Sender: TObject;
     OrigDataSet, TempDataSet: TDataSet) of object;
  TwwOnInitFilterDlgEvent = procedure(Dialog : TwwFilterDlg) of object;
  TwwOnExecuteSQLEvent = procedure(Dialog: TwwFilterDlg; Query: TQuery) of object;
  TwwOnEncodeValueEvent = procedure(AFieldType: TFieldType;
       AFieldName: string; var AUserValue: string) of object;
  TwwOnEncodeDateTimeEvent = procedure(ADateTime: TDateTime;
       AFieldType: TFieldType; AFieldName: string; var FormattedDateStr: string) of object;
  TwwFilterOptimization = (fdNone, fdUseAllIndexes, fdUseActiveIndex);
  TwwQueryFormatDateMode = (qfdMonthDayYear, qfdDayMonthYear, qfdYearMonthDay);
  TwwOnSelectFilterField = procedure(
     Sender: TObject;
     FieldName: string;
     var PictureMask: string; ComboList: TStrings) of object;
  TwwOnAcceptFilterRecord = procedure(Sender: TObject;
     DataSet: TDataSet; var Accept: boolean; var DefaultFiltering: boolean) of object;

  TwwFieldInfo = class
  public
     FieldName: string;
     DisplayLabel: string;
     MatchType: TwwFilterMatchType;
     FilterValue: string;
     MinValue: string;
     MaxValue: string;
     CaseSensitive: boolean;
     NonMatching: boolean;
  end;

  TwwFilterDlg = class(TForm)
    FieldCriteriaPanel: TPanel;
    SelectNotebook: TPageControl;
    TabSheet1: TTabSheet;
    FieldValueLbl: TLabel;
    MatchTypeGroup: TRadioGroup;
    Panel1: TPanel;
    CaseSensitive: TCheckBox;
    Nonmatching: TCheckBox;
    FilterValueClearButton: TBitBtn;
    FilterValueCombo: TwwDBComboBox;
    FilterValueEdit: TwwDBEdit;
    TabSheet2: TTabSheet;
    StartingRangeLbl: TLabel;
    EndingRangeLbl: TLabel;
    MinValueEdit: TEdit;
    MaxValueEdit: TEdit;
    MinValueClearButton: TBitBtn;
    MaxValueClearButton: TBitBtn;
    MinDateEdit: TwwDBDateTimePicker;
    MaxDateEdit: TwwDBDateTimePicker;
    FieldListPanel: TPanel;
    FieldTabSet: TTabControl;
    FieldsListBox: TListBox;
    ButtonPanel: TPanel;
    ViewButton: TButton;
    ClearSearchButton: TButton;
    OKCancelPanel: TPanel;
    CriteriaLabelPanel: TPanel;
    FieldCriteria: TLabel;
    FieldsLabelPanel: TPanel;
    FieldsLbl: TLabel;
    FieldOrderPanel: TPanel;
    FieldOrder: TRadioGroup;

    procedure FieldOrderClick(Sender: TObject);
    procedure FieldsListBoxClick(Sender: TObject);
    procedure ViewButtonClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure ValueRangeTabSetChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure ClearSearchButtonClick(Sender: TObject);
    procedure FilterValueComboChange(Sender: TObject);
    procedure MinValueEditChange(Sender: TObject);
    procedure MaxValueEditChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure MinValueClearButtonClick(Sender: TObject);
    procedure MaxValueClearButtonClick(Sender: TObject);
    procedure FilterValueClearButtonClick(Sender: TObject);
    procedure MatchTypeGroupClick(Sender: TObject);
    procedure FieldTabSetChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure FieldCriteriaPanelResize(Sender: TObject);
  private
    LastItemIndex: integer;
    FormActivated: boolean;

    Function IsValueField(ADisplayLabel: string): boolean;
    Function IsValueType(AFieldType: TFieldType): boolean;
    Procedure RefreshClearbutton;
    Function ValidEditValue(val: string): boolean;
    Function ValidEditValues(val: string): boolean; {paul}
    procedure ApplyIntl;
    Function GetFieldType(ADisplayLabel: wwSmallString): TFieldType;
    procedure UpdateFilterEditControl;
    function GetSQLPropertyname: string;
    procedure ShowValueRangeTabs;
  protected   {!!!! - 3/19/2001 - PYW - Move to Protected From Private to allow further customization of dialog.}
    DlgComponent: TComponent;
    DlgDataSet: TDataSet;
    FieldInfo: TList;
    MinValueEditControl, MaxValueEditControl: TCustomEdit;
    FilterValueEditControl: TCustomEdit;
  public
     OKBtn, CancelBtn: TButton;
     FilterChanged: Boolean;

     Procedure RefreshFieldList(ShowAll: boolean);
     procedure AdjustFieldTabSet(NewTab: integer);
     constructor CreateDlg(AOwner: TComponent; ADlgComponent: TComponent);
     destructor Destroy; override;
     Function SelectField(FieldChanged: boolean): boolean;
     Procedure SelectPage;
     Procedure SelectFocus;
     procedure SetFilterfield(ADisplayLabel: wwSmallString;
       AMatchType: TwwFilterMatchType; AFilterValue, AMinValue, AMaxValue: string;
       ACaseSensitive, ANonMatching: boolean);
     Function GetFilterField(ADisplayLabel: wwSmallString; var FldInfo: TwwFieldInfo): boolean;
     Procedure CopyList(fromlist, tolist: TList);

  end;

  TwwDBFieldInfo = class
  public
     LogicalFieldName: string;
     PhysicalFieldName: string;
     TableName: string;
     FieldType: TFieldType;
     DisplayLabel: string;
     Size: integer;
  end;

  TwwDatasetFilterType = (fdUseOnFilter, fdUseFilterProp, fdUseBothFilterTypes);
  TwwFilterPropertyOptions = class(TPersistent)
  private
     FDatasetFilterType: TwwDatasetFilterType;
     FLikeWildcardChar: string;
     FUseBracketsAroundFields: boolean;
     FUseLikeOperator: boolean;
     FLikeSupportsUpperKeyword: boolean;
  published
     property DatasetFilterType: TwwDatasetFilterType read FDatasetFilterType write FDataSetFilterType default fdUseOnFilter;
     property UseLikeOperator : boolean read FUseLikeOperator write FUseLikeOperator default False;
     property LikeWildcardChar: string read FLikeWildcardChar write FLikeWildcardChar;
     property LikeSupportsUpperKeyword: boolean read FLikeSupportsUpperKeyword write FLikeSupportsUpperKeyword default false;
     property UseBracketsAroundFields: boolean read FUseBracketsAroundFields write FUseBracketsAroundFields default true;
  end;

  TwwFieldOperators = class(TPersistent)
  private
     FOrChar: string;
     FAndChar: string;
     FNullChar: string;
     procedure SetOrChar(val: string);
     procedure SetAndChar(val: string);
     procedure SetNullChar(val: string);
     procedure SetOpChar(var opchar: string; val:string);
  public
     constructor Create(Owner: TComponent);
  published
     property OrChar: string read FOrChar write SetOrChar;
     property AndChar: string read FAndChar write SetAndChar;
     property NullChar: string read FNullChar write SetNullChar;
  end;

  TwwSQLTablesCollectionItem = class(TCollectionItem)
  private
    FTableName: string;
    FTableAliasName: string;
  protected
    function GetDisplayName: string; override;
  published
    property TableName: string read FTableName write FTableName;
    property TableAliasName: string read FTableAliasName write FTableAliasName;
  end;


  TwwSQLTablesCollection = class(TCollection)
  protected
    Control: TComponent;
    function GetOwner: TPersistent; override;
//    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Control: TComponent);
    function Add: TwwSQLTablesCollectionItem;
  end;


  TwwOnFilterPropertyOption = (fdClearWhenNoCriteria,
                               fdClearWhenCloseDataSet);
  TwwOnFilterPropertyOptions = set of TwwOnFilterPropertyOption;

  // Rounding only affects local callback filtering. Otherwise
  // these issues are handled by the database driver

  // fdrmRelative not currently supported, but provided for future
  // enhancmement
  TwwFilterDialogRoundingMethod = (fdrmFixed, fdrmRelative);
  TwwFilterDialogRounding =class(TPersistent)
  private
     FEpsilon: Double;
     FRoundingMethod: TwwFilterDialogRoundingMethod;
  public
     constructor Create(Owner: TComponent);
  published
     property Epsilon: Double read FEpsilon write FEpsilon;
     property RoundingMethod: TwwFilterDialogRoundingMethod read FRoundingMethod write FRoundingMethod;
  end;


  TwwFilterDialog = class(TwwCustomDialog)
  private
     FDataLink: TDataLink;
     FOptions: TwwFilterDialogOptions;
     FSortBy: TwwFilterDialogSort;
     FDummyForm: TwwDummyForm;
     FTitle: String;
     FFilterMethod: TwwFilterMethod;
     FDefaultMatchType: TwwDefaultMatchType;
     FDefaultFilterBy: TwwDefaultFilterBy;
     FDefaultField: string;
     FSelectedFields: TStrings;
     FOnInitDialog: TwwOnInitFilterDlgEvent;
     FOnExecuteSQL: TwwOnExecuteSQLEvent;
     FwwOperators: TwwFieldOperators;
     FRounding: TwwFilterDialogRounding;
     FRangeApplied: boolean;
     FFilterOptimization: TwwFilterOptimization;
     FUpperRangePadChar: word;
     FDlgHeight: integer;
     FOnEncodeValue : TwwOnEncodeValueEvent;
     FOnEncodeDateTime : TwwOnEncodeDateTimeEvent;
     FOnSelectField: TwwOnSelectFilterField;
     FOnInitTempDataSet:  TwwOnInitTempDataSetEvent;