wwfltdlg.pas

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

     FOnAcceptFilterRecord: TwwOnAcceptFilterRecord;
     FFieldsFetchMethod : TwwFilterFieldsFetchType;
     FOnDialogSummary: TwwFilterDialogSummaryEvent;

     FOrigSQL: TStrings;
     FFldList: TList;
     FShowDialog: boolean;
     FDependentComponents: Tlist;
     FQueryFormatDateMode : TwwQueryFormatDateMode;
     FFilterPropertyOptions: TwwFilterPropertyOptions;
     FOnFilterPropertyOptions: TwwOnFilterPropertyOptions;
     FSQLTables: TwwSQLTablesCollection;
     FSQLUpperString: string;
     SkipClearFieldInfo: boolean;
     FSQLPropertyName: string;
//     FEpsilon: Double;

     procedure SetDataSource(value : TDataSource);
     function GetDataSource: TDataSource;
     procedure SetFilterMethod(val: TwwFilterMethod);
     procedure ReplaceRemoteSQL(querySQL: TStrings);
     Function PadUpperRange(size: integer; val: string): string;
     Procedure SetDlgHeight(val: integer);
     function GetEffectiveSQLUpperString: string;

  protected
      procedure FilterDialogView(AFieldInfo: TList); virtual;
      function GetSQLPropertyname: string; virtual;
      Procedure DoInitDialog; virtual;   { This method should only be called by TwwFilterDlg }
      Function AddDBFieldInfo: TwwDBFieldInfo;
      procedure LinkActive(active: Boolean); virtual;
      Procedure DoSelectField(
          FieldName: string;
          var PictureMask: string;
          ComboList: TStrings); virtual;
      Procedure DoInitTempDataSet(OrigDataSet, TempDataset: TDataSet); virtual;
      Procedure DoAcceptFilterRecord(DataSet: TDataSet;
         var Accept: boolean;
         var DefaultFiltering: boolean); virtual;
     Procedure InitQueryFields; virtual;
     Procedure InitTableFields; virtual;
     Procedure ReplaceWhereClause(whereClause: TStrings); virtual;
     Function GetCommandTextDataSet(ADataSet: TDataSet = nil): TDataSet; virtual;
     function IsWideSql(dataSet: TDataSet; propInfo: PPropInfo): boolean;
  public
     MemoBuffer: PChar;
     Form: TwwFilterDlg;
     FieldInfo: TList;
     FieldsInDblQuotes: boolean;
     Patch: Variant;

     SQLWhereClause: TStringList;

     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     Function ExecuteDialog(ExecuteQuery: boolean = True;
                      ReturnWhereClause: TStrings = nil): boolean;
     Function Execute: boolean; override;
     function GetPrimaryDataSet: TDataSet; override;
     Procedure ApplyFilter;
     Procedure ClearFilter;
     Procedure InitFields; virtual;
     property AllFields: TList read FFldList; { Used by filter fields property editor}
     property ShowDialog: boolean read FShowDialog write FShowDialog;
     Function GetDBInfoForField(AFilterFieldName: wwSmallString): TwwDBFieldInfo; { Used by filter fields property editor}
     Procedure AddDependent(value: TComponent);
     Procedure RemoveDependent(value: TComponent);
     Function AddFieldInfo: TwwFieldInfo;

  published
     property DataSource: TDataSource read GetDataSource write SetDataSource;
     property OnDialogSummary: TwwFilterDialogSummaryEvent read FOnDialogSummary write FOnDialogSummary;
     property Options: TwwFilterDialogOptions read FOptions write FOptions default
              [fdShowCaseSensitive, fdShowOKCancel, fdShowViewSummary, fdShowFieldOrder,
               fdShowValueRangeTab];

     property SortBy: TwwFilterDialogSort read FSortBy write FSortBy;
     property Caption: string read FTitle write FTitle;
     property FilterMethod: TwwFilterMethod read FFilterMethod write SetFilterMethod;
     property DefaultMatchType: TwwDefaultMatchType read FDefaultMatchType write FDefaultMatchType;
     property DefaultFilterBy: TwwDefaultFilterBy read FDefaultFilterBy write FDefaultFilterBy;
     property DefaultField: string read FDefaultField write FDefaultField;
     property FieldsFetchMethod : TwwFilterFieldsFetchType read FFieldsFetchMethod write FFieldsFetchMethod default fmUseTTable;
     property FieldOperators: TwwFieldOperators read FwwOperators write FwwOperators;

     // Rounding only affects local callback filtering. Otherwise
     // these issues are handled by the database driver
     property Rounding: TwwFilterDialogRounding read FRounding write FRounding;
     property FilterPropertyOptions: TwwFilterPropertyOptions read FFilterPropertyOptions write FFilterPropertyOptions;
     property OnFilterPropertyOptions: TwwOnFilterPropertyOptions read FOnFilterPropertyOptions write FOnFilterPropertyOptions
                  Default [fdClearWhenNoCriteria,
                           fdClearWhenCloseDataSet];
     property SelectedFields: TStrings read FSelectedFields write FSelectedFields;
     property FilterOptimization: TwwFilterOptimization read FFilterOptimization write FFilterOptimization;
     property UpperRangePadChar: word read FUpperRangePadChar write FUpperRangePadChar default 122;
     property DlgHeight: integer read FDlgHeight write SetDlgHeight default 267;
     property QueryFormatDateMode : TwwQueryFormatDateMode read FQueryFormatDateMode write FQueryFormatDateMode;
     property SQLTables: TwwSQLTablesCollection read FSQLTables write FSQLTables;
     property SQLUpperString: string read FSQLUpperString write FSQLUpperString;
     property SQLPropertyName: string read FSQLPropertyName write FSQLPropertyName;

     property OnInitDialog: TwwOnInitFilterDlgEvent read FOnInitDialog write FOnInitDialog;
     property OnExecuteSQL: TwwOnExecuteSQLEvent read FOnExecuteSQL write FOnExecuteSQL;
     property OnEncodeValue : TwwOnEncodeValueEvent read FOnEncodeValue write FOnEncodeValue;
     property OnEncodeDateTime : TwwOnEncodeDateTimeEvent read FOnEncodeDateTime write FOnEncodeDateTime;
     property OnSelectField: TwwOnSelectFilterField read FOnSelectField write FOnSelectField;
     property OnInitTempDataSet: TwwOnInitTempDataSetEvent
              read FOnInitTempDataSet write FOnInitTempDataSet;
     property OnAcceptFilterRecord: TwwOnAcceptFilterRecord
              read FOnAcceptFilterRecord write FOnAcceptFilterRecord;
//     property Epsilon: Double read FEpsilon write FEpsilon;

  end;

  TwwFilterDataLink = class(TDataLink)
    private
      FilterDialog: TwwFilterDialog;
    protected
      procedure ActiveChanged; override;
    public
      constructor Create(AFilterDialog: TwwFilterDialog);
  end;


  Function wwGetFilterOperator(FilterValue: string;
                             FilterOperator: TwwFieldOperators;
                             var OrFlg: boolean; var AndFlg: boolean): string;

  Function wwGetFilterToken(FilterValue: string;
                          SearchDelimiter: string;
                          var CurPos: integer): string;

Function wwPadUpperRange(size: integer; s: string; UpperRangePadChar: word): string;

  procedure Register;

var
  wwFilterDlg: TwwFilterDlg;

implementation
{$R *.DFM}

uses wwtable, wwquery, wwqbe, wwstorep, wwstr, wwfltvw, wwtypes,
 {$ifdef wwDelphi6Up}
 variants,
 {$endif}
 wwintl;

const dbl='"';
      single='''';

constructor TwwFieldOperators.Create(Owner: TComponent);
begin
   FOrChar:= 'or';
   FAndChar:= 'and';
   FNullChar := 'null';
end;

Procedure TwwFilterDlg.CopyList(fromlist, tolist: TList);
var i: integer;
    srcFieldInfo, tempFieldInfo: TwwFieldInfo;
begin
   for i:= 0 to toList.count-1 do TwwFieldInfo(toList[i]).Free;
   toList.clear;
   for i:= 0 to fromList.count-1 do begin
      tempFieldInfo:= TwwFieldInfo.create;
      srcFieldInfo:= TwwFieldInfo(fromList[i]);
      if srcFieldInfo.DisplayLabel='' then
         srcFieldInfo.DisplayLabel:= srcFieldInfo.FieldName;

      tempFieldInfo.DisplayLabel:= srcFieldInfo.DisplayLabel;
      tempFieldInfo.MatchType:= srcFieldInfo.MatchType;
      tempFieldInfo.FilterValue:= srcFieldInfo.FilterValue;
      tempFieldInfo.MinValue:= srcFieldInfo.MinValue;
      tempFieldInfo.MaxValue:= srcFieldInfo.MaxValue;
      tempFieldInfo.CaseSensitive:= srcFieldInfo.CaseSensitive;
      tempFieldInfo.NonMatching:= srcFieldInfo.NonMatching;

      tempFieldInfo.FieldName:= wwGetFieldNameFromTitle(DlgDataSet, srcFieldInfo.DisplayLabel);

      toList.add(tempFieldInfo);
   end;
end;

constructor TwwFilterDlg.CreateDlg(AOwner: TComponent; ADlgComponent: TComponent);
begin
  inherited Create(AOwner);
  FieldInfo:= TList.create;
  DlgDataSet:= TwwFilterDialog(ADlgComponent).DataSource.DataSet;
  CopyList(TwwFilterDialog(ADlgComponent).FieldInfo, FieldInfo);
  LastItemIndex:= -1;
  FormActivated:= False;
  DlgComponent:= ADlgComponent;
  (DlgComponent as TwwFilterDialog).InitFields;

  OkBtn:= TButton(wwCreateCommonButton(self, bkOK));
  OkBtn.default:=true;  // 6/17/02 - Make default (necessary when no bitmaps in button
  OKBtn.parent:= OKCancelPanel;
  OKBtn.TabOrder := 2;
  OKBtn.Top:= (22 * PixelsPerInch) div 96;
  OKBtn.Left:= ((7 * PixelsPerInch) div 96);
//  OKBtn.Left := FieldCriteria.Left + FieldCriteria.Width + ((7 * PixelsPerInch) div 96);
//  OKBtn.Left := SelectNotebook.Left + SelectNotebook.Width + ((7 * PixelsPerInch) div 96);
  OKBtn.visible:= True;
  OkBtn.enabled:= False;
  CancelBtn:= TButton(wwCreateCommonButton(self, bkCancel));
  CancelBtn.parent:= OKCancelPanel;
  CancelBtn.TabOrder := 3;
  CancelBtn.Top:= (62 * PixelsPerInch) div 96;
  CancelBtn.Left := ((7 * PixelsPerInch) div 96);
//  CancelBtn.Left := FieldCriteria.Left + FieldCriteria.Width + ((7 * PixelsPerInch) div 96);
//  CancelBtn.Left := SelectNotebook.Left + SelectNotebook.Width + ((7 * PixelsPerInch) div 96);
  cancelBtn.visible:= True;
//  SelectNotebook.borderstyle:= bsNone;
end;

destructor TwwFilterDlg.Destroy;
var i :integer;
begin
  for i:= 0 to FieldInfo.count-1 do TwwFieldInfo(FieldInfo[i]).Free; { Free items }
  FieldInfo.Free;
  inherited destroy;
end;

constructor TwwFilterDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
//  FEpsilon:= 0.0001;
  FDataLink:= TwwFilterDataLink.create(self);
  FSortBy:= fdSortByFieldNo;
  FDummyForm:= TwwDummyForm.create(self);
  FDummyForm.DlgComponent:= self;
  GetMem(MemoBuffer, wwFilterMemoSize);
  FieldInfo:= TList.create;
  FOrigSQL:= TStringList.create;
  FFldList:= TList.create;
  FFilterMethod:= fdByFilter;
  FSelectedFields:= TStringlist.create;
  FOptions:= [fdShowCaseSensitive, fdShowOKCancel, fdShowViewSummary, fdShowFieldOrder, fdShowValueRangeTab];
  FShowDialog:= True;
  FDependentComponents:= TList.create;
  FwwOperators:=TwwFieldOperators.create(self);
  FRounding:= TwwFilterDialogRounding.create(self);
  FUpperRangePadChar:= 122;
  FDlgHeight:= 267;
  FQueryFormatDateMode := qfdMonthDayYear;
  FieldsInDblQuotes:= False;
  FFilterPropertyOptions:= TwwFilterPropertyOptions.create;
  FFilterPropertyOptions.UseBracketsAroundFields:= True;
  FFilterPropertyOptions.LikeWildcardChar:='%';
  FSQLTables:= TwwSQLTablesCollection.create(self);

  FOnFilterPropertyOptions:= [fdClearWhenNoCriteria, fdClearWhenCloseDataSet];

  Patch:= VarArrayCreate([0, 4], varVariant);
  Patch[0]:= False; { 11/17/98 - Set to True to preserve filter even when dataset is closed }
  Patch[1]:= False; { 11/24/98 - Set to True to preserve old behavior of enclosing value in single quotes }
                    { New behavior supports single quotes in text }
  Patch[2]:= False; { Set to true to disable checking of origin }
  Patch[3]:= False; { Set to true to enable extended parsing courtesy of JCC }
  Patch[4]:= False; { Set to true to prevent the control from setting active to false when calling ExecuteDialog }
  FieldsFetchMethod := fmUseTTable;
  SQLWhereClause:= TStringList.create;

end;

destructor TwwFilterDialog.Destroy;
var i: integer;
begin
  { Detach onFilter event 10/22/96 -
    Consider case where table is destroyed before dialog.
    Comment out code until this issue is resolved.   }
{  if datasource.dataset is TwwQuery then
     (datasource.dataset as TwwQuery).OnFilter:= nil
  else if datasource.dataset is TwwTable then
     (datasource.dataset as TwwTable).OnFilter:= nil
  else if datasource.dataset is TwwQBE then
     (datasource.dataset as TwwQBE).onFilter:= nil;
}
  FDataLink.free;
  FDataLink:= Nil;
  FDummyForm.Free;
  FwwOperators.Free;
  FRounding.Free;
//  FreeMem(memoBuffer, wwFilterMemoSize);
  FreeMem(memoBuffer);  { 9/18/98 - Don't reference wwFilterMemoSize in destructor }

  for i:= 0 to FieldInfo.count-1 do TwwFieldInfo(FieldInfo[i]).Free;
  FieldInfo.Free;
  FOrigSQL.free;

  for i:= 0 to FFldList.count-1 do TwwDBFieldInfo(FFldList[i]).Free;
  FFldList.Free;
  FSelectedFields.Free;

  for i:= 0 to FDependentComponents.count-1 do
     TwwCheatCastNotify(FDependentComponents[i]).notification(self, opRemove);
  FDependentComponents.Free;
  FFilterPropertyOptions.Free;
  FSQLTables.Free;
  SQLWhereClause.Free;

  inherited destroy;
end;

Procedure TwwFilterDialog.SetDlgHeight(val: integer);
begin
   if val>267 then FDlgHeight:= val;
end;

procedure TwwFilterDialog.SetDataSource(value : TDataSource);
begin
   if (value<>nil) and (value.dataset<>nil) then begin
      if (value.dataset is TTable) then
        FFilterMethod:= fdByFilter
   end;
   FDataLink.dataSource:= value;
end;

function TwwFilterDialog.GetPrimaryDataSet: TDataSet;
begin
  if DataSource = nil then result := nil else result := DataSource.DataSet;
end;

Function TwwFilterDialog.GetDataSource: TDataSource;
begin
   if FDataLink<>Nil then Result:= FDataLink.dataSource
   else Result:= nil;
end;

{ Fill listbox with fields }
Procedure TwwFilterDlg.RefreshFieldList(ShowAll: boolean);
var i, curpos: integer;
    FldInfo: TwwFieldInfo;
    ParamName: wwSmallString;
    query: TQuery;
    Dlg: TwwFilterDialog;
    dbInfo: TwwDBFieldInfo;
    TempDisplayLabel, FieldName: wwSmallString;

    Procedure AddFieldToListBox(ADisplaylabel: wwSmallString);
    var TempLabelName: wwSmallString;
    begin
       if ShowAll or (GetFilterField(ADisplayLabel, FldInfo)) then
       begin
         TempLabelname:= strReplaceChar(ADisplayLabel,'~', ' ');