qldbflt.pas

详细的ERP设计资料

unit QLDBFlt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, DB, ExtCtrls, ComCtrls;

type

  {
    '等于;不等于;大于;大于或等于;小于;小于或等于;始于;并非起始于;' +
    '止于;并非结束于;包含;不包含';
  }

  TFilterLogical = (flAnd, flOr);

  TFilterCondition = (fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
    fcLess, fcLessEqual, fcBeginWith, fcNotBeginWith, fcEndWith, fcNotEndWith,
    fcContain, fcNotContain);

  { Forward declare }

  TQLDBFilterDialog = class;

  { TQLDBFilterForm }

  TQLDBFilterForm = class(TForm)
    gbFilterConditions: TGroupBox;
    lbFilter: TListBox;
    gbDefineCondition: TGroupBox;
    cbFields: TComboBox;
    Label1: TLabel;
    rbAnd: TRadioButton;
    rbOr: TRadioButton;
    cbConditions: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    btnOK: TButton;
    btnCancel: TButton;
    btnDelete: TButton;
    btnNewConditions: TButton;
    btnAddToList: TButton;
    nbValue: TNotebook;
    edtValue: TEdit;
    cbBoolean: TComboBox;
    dtpDate: TDateTimePicker;
    procedure btnAddToListClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnNewConditionsClick(Sender: TObject);
    procedure lbFilterDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lbFilterDblClick(Sender: TObject);
    procedure edtValueChange(Sender: TObject);
    procedure cbFieldsChange(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    FFilterDialog: TQLDBFilterDialog;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

  { TQLDBFilterDialog }

  TQLDBFilterDialogOption = (dfdOnlyBuildFilter);
  TQLDBFilterDialogOptions = set of TQLDBFilterDialogOption;

//  TFilterStrings = class(TStrings)

  TQLDBFilterDialog = class(TComponent)
  private
    FFilterStrings: TStrings;
    FFilterFields: string;
//    FFieldTypes: array of TFieldType;
    FDataSet: TDataSet;
    FConditions: TStrings;
    FTitle: string;
    FSaveOnFilterRecord: TFilterRecordEvent;
    FSaveFiltered: Boolean;
    FPreFiltered: Boolean;
    FOptions: TQLDBFilterDialogOptions;
//    function GetDataSet: TDataSet;
    function GetFilterFields: string;
    procedure SetTitle(const Value: string);
    procedure SetDataSet(Value: TDataSet);
    procedure SetFilterFields(const Value: string);
    function CanUseFilterCondition(Field: TField; FilterCondition: TFilterCondition): Boolean;
    procedure FilterStringsChange(Sender: TObject);
  protected
//    procedure InitFieldTypes;
    procedure DataSetFilterRecord(DataSet: TDataSet; var Accept: Boolean); virtual;
//    property DataSet: TDataSet read GetDataSet;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
    function GetFilter: string; virtual;
    procedure GetFilterDescriptions(List: TStrings);
    property FilterStrings: TStrings read FFilterStrings;
  published
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property FilterFields: string read GetFilterFields write SetFilterFields;
    property Title: string read FTitle write SetTitle;
    property Options: TQLDBFilterDialogOptions read FOptions write FOptions;
  end;

implementation

uses StrUtils;

{$R *.DFM}

function ExtractSubStr(const Str: string; var Pos: Integer; Delimiter: Char = ';'): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(Str)) and (Str[I] <> Delimiter) do Inc(I);
  Result := Copy(Str, Pos, I - Pos);
  if (I <= Length(Str)) and (Str[I] = Delimiter) then Inc(I);
  Pos := I;
end;

function IndexOfFieldName(const Fields: string; Index: Integer): string;
var
  I, J, Pos: Integer;
begin
  Pos := 1;
  I := Pos;
  J := -1;
  while I <= Length(Fields) do
  begin
    if Fields[I] = ';' then
    begin
      Inc(J);
      if (J = Index) or (Index = -1) then Break;
      Pos := I + 1;
    end;
    Inc(I);
  end;
  Result := Trim(Copy(Fields, Pos, I - Pos));
//  if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
end;

{ TQLDBFilterForm }

constructor TQLDBFilterForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TQLDBFilterDialog then FFilterDialog := AOwner as TQLDBFilterDialog;
end;

procedure TQLDBFilterForm.btnAddToListClick(Sender: TObject);
var
  S: string;
begin
  if rbAnd.Checked then S := '0;'
  else S := '1;';
//  S := S + TField(cbFields.Items.Objects[cbFields.ItemIndex]).FieldName{IntToStr(cbFields.ItemIndex)} + ';' +
//    IntToStr(Integer(cbConditions.Items.Objects[cbConditions.ItemIndex])) + ';';
  S := S + IntToStr(Integer(cbConditions.Items.Objects[cbConditions.ItemIndex])) + ';';
  case nbValue.PageIndex of
    0: S := S + edtValue.Text;
    1: S := S + cbBoolean.Text;
    2: S := S + DateToStr(dtpDate.Date);
  end;
//    + edtValue.Text;
  lbFilter.Items.AddObject(S, cbFields.Items.Objects[cbFields.ItemIndex]);
  lbFilter.ItemIndex := lbFilter.Items.Count - 1;
//  lbFilter.Items.AddObject(cbFields.Text + ' ' + cbConditions.Text + ' ' +
//    edtValue.Text, TObject(Ord(rbAnd.Checked)));
end;

procedure TQLDBFilterForm.btnDeleteClick(Sender: TObject);
begin
  lbFilter.Items.Delete(lbFilter.ItemIndex);
  lbFilter.ItemIndex := lbFilter.Items.Count - 1;
end;

procedure TQLDBFilterForm.btnNewConditionsClick(Sender: TObject);
begin
  lbFilter.Clear;
end;

procedure TQLDBFilterForm.lbFilterDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  Offset = 2;
var
  I: Integer;
  S, Temp: string;
begin
  with (Control as TListBox) do
  begin
    Temp := Items[Index];
    I := 1;
    if Index <> 0 then
    begin
      if ExtractSubStr(Temp, I, ';') = '0' then S := '与'
      else S := '或';
    end else ExtractSubStr(Temp, I);
    S := S + ' ' + TField(Items.Objects[Index]).DisplayLabel;//[StrToInt(ExtractSubStr(Temp, I))];
    S := S + ' ' + cbConditions.Items[StrToInt(ExtractSubStr(Temp, I))];
    S := S + ' ' + ExtractSubStr(Temp, I) + ' 。';
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left + Offset, Rect.Top, S);
  end;
end;

procedure TQLDBFilterForm.lbFilterDblClick(Sender: TObject);
var
  I: Integer;
  Temp: string;
begin
  Temp := lbFilter.Items[lbFilter.ItemIndex];
  I := 1;
  if ExtractSubStr(Temp, I) = '0' then rbAnd.Checked := True
  else rbOR.Checked := True;
  cbFields.ItemIndex := cbFields.Items.IndexOfObject(lbFilter.Items.Objects[lbFilter.ItemIndex]);// StrToInt(ExtractSubStr(Temp, I));
  cbFields.OnChange(cbFields);
  cbConditions.ItemIndex := cbConditions.Items.IndexOfObject(
    TObject(StrToInt(ExtractSubStr(Temp, I))));
  case nbValue.PageIndex of
    0: edtValue.Text := ExtractSubStr(Temp, I);
    1: cbBoolean.ItemIndex := cbBoolean.Items.IndexOf(ExtractSubStr(Temp, I));
    2: dtpDate.Date := StrToDateTime(ExtractSubStr(Temp, I));
  end;
end;

procedure TQLDBFilterForm.edtValueChange(Sender: TObject);
begin
//  btnAddToList.Enabled := TEdit(Sender).Text <> '';
end;

procedure TQLDBFilterForm.cbFieldsChange(Sender: TObject);
var
  I: Integer;
begin
  cbConditions.Clear;
  for I := 0 to FFilterDialog.FConditions.Count - 1 do
    if FFilterDialog.CanUseFilterCondition(TField(cbFields.Items.Objects[cbFields.ItemIndex]),
      TFilterCondition(FFilterDialog.FConditions.Objects[I])) then
      cbConditions.Items.AddObject(FFilterDialog.FConditions[I],
        FFilterDialog.FConditions.Objects[I]);
  cbConditions.Enabled := cbConditions.Items.Count > 0;
  if cbConditions.Enabled then cbConditions.ItemIndex := 0;
  case TField(cbFields.Items.Objects[cbFields.ItemIndex]).DataType of
    ftBoolean: nbValue.PageIndex := 1;
    ftDate, ftDateTime: nbValue.PageIndex := 2;
    ftString, ftWideString, ftFixedChar, ftMemo, ftFmtMemo:
    begin
      cbConditions.ItemIndex := cbConditions.Items.IndexOfObject(TObject(fcContain));
      nbValue.PageIndex := 0;
    end
    else nbValue.PageIndex := 0;
  end;
end;

{ TQLDBFilterDialog }

constructor TQLDBFilterDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConditions := TStringList.Create;
  with FConditions do
  begin
    AddObject('等于', TObject(fcEqual));
    AddObject('不等于', TObject(fcNotEqual));
    AddObject('大于', TObject(fcGreat));
    AddObject('大于或等于', TObject(fcGreatEqual));
    AddObject('小于', TObject(fcLess));
    AddObject('小于或等于', TObject(fcLessEqual));
    AddObject('始于', TObject(fcBeginWith));
    AddObject('并非起始于', TObject(fcNotBeginWith));
    AddObject('止于', TObject(fcEndWith));
    AddObject('并非结束于', TObject(fcNotEndWith));
    AddObject('包含', TObject(fcContain));
    AddObject('不包含', TObject(fcNotContain));
  end;
  FTitle := '筛选';
  FFilterStrings := TStringList.Create;
  TStringList(FFilterStrings).OnChange := FilterStringsChange;
end;

destructor TQLDBFilterDialog.Destroy;
begin
  DataSet := nil;
  FConditions.Free;
  FFilterStrings.Free;
  inherited;
end;

function TQLDBFilterDialog.CanUseFilterCondition(Field: TField;
  FilterCondition: TFilterCondition): Boolean;
begin
  case Field.DataType of
    ftUnknown, ftString, ftFixedChar, ftWideString, ftMemo, ftVariant, ftBlob,
    ftFmtMemo:
      Result := True;
    ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftBytes,
    ftVarBytes, ftAutoInc, ftLargeint:
      Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
        fcLess, fcLessEqual];
    ftBoolean: Result := FilterCondition in [fcEqual, fcNotEqual];
    ftDate, ftTime, ftDateTime:
      Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
        fcLess, fcLessEqual];
    {ftGraphic, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT
    ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
    ftIDispatch, ftGuid}
    else Result := False;
  end;