通用查询组件设计

作者：nxyc_twz@163.com
在当前的MIS系统中，数据维护与数据查询是其两个核心功能。如何设计一个通用的查询组件，使开发的MIS系统中具备统一的查询界面，是MIS系统开发人员一直在偿试解决的问题。笔者在多年的MIS系统的开发设计过程中，经过不断的摸索与实践，终于设计完成了这套相对比较完善、通用的查询组件。
该组件继承自Tcomponet组件，主要包括一个查询窗体及一个显示查询摘要的窗体。主要设计思路是通过设置Tquery组件的Params（参数）以达到通用查询的目的。关于如何设计自定义组件，请参考：创建定制组件
现将其设计思路与技巧公布出来，与广大编程爱好者共勉。定义通用查询类
 
function WordPos(const AWord, AString: string): Integer;
//在指定字符串中查找字符串
var s: string;
    i, p: Integer;
begin
  s := ' ' + AnsiUpperCase(AString) + ' ';  //忽略大小写
  for i := 1 to Length(s) do if not (s[i] in Identifiers) then s[i] := ' '; //常量定义
  p := Pos(' ' + AnsiUpperCase(AWord) + ' ', s);  
  Result := p;
end;
 
type
  TDBFilterDialog = class(TComponent)
  private
    FDialog : TMyDBFilterDialog;//查询窗体类
    FOriginalSQL : TStrings;//原来的SQL语句
    FModifiedSQL : TStrings;//修改后的SQL语句
    FDataSet : TQuery;//数据集
    FDefaultMatchType : TDBFilterMatchType;//过滤类型
    FOptions : TDBOptions;//过滤选项
    FCaption: String;//窗体标题
    FFields: TStringList;//字段列表
    FOriginalVariables : TList;//变量列表
    SQLProp : String;//SQL属性
    procedure SetDataSet(const Value: TQuery);//设置数据集
    procedure SetOptions(const Value: TDBOptions);//设置选项
    procedure SetCaption(const Value: String);//设置标题
    procedure SetDefaultMatchType(const Value: TDBFilterMatchType);//设置默认的匹配类型
    procedure SetFields;//设置字段
    procedure SetFieldsList(const Value: TStringList);//设置字段列表
    procedure SetOriginalSQL(const Value: TStrings);//设置SQL
    procedure RestoreSQL;//恢复SQL
    procedure SaveParamValues;//保存参数值
    { Private declarations }
  protected
    { Protected declarations }
    procedure Loaded; override;//装载过滤对话框
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;//传送消息
    property OriginalSQL : TStrings read FOriginalSQL write SetOriginalSQL;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;//构造函数
    destructor Destroy; override;//析构函数
    function Execute : Boolean;//执行查询
    procedure ReBuildSQL;//重建SQL语句
    property ModifiedSQL : TStrings read FModifiedSQL;
  published
    { Published declarations }
    property Caption : String read FCaption write SetCaption;//设置标题
    property DataSet : TQuery read FDataSet write SetDataSet;//设置数据集
    property DefaultMatchType : TDBFilterMatchType read FDefaultMatchType write SetDefaultMatchType
       default fdMatchStart;//过滤类型
    property Options : TDBOptions read FOptions write SetOptions default
      [fdShowCaseSensitive, fdShowNonMatching];//过滤选项
    property Fields : TStringList read FFields write SetFieldsList;
  end;
 
TDBVariable = class  //参数数据变量
  public
    VariableName : String;  //变量名 
    VariableValue : Variant;  //变量值
    constructor Create(name : String; value : Variant); //构造函数，设置变量名及变量值
  end;
 
constructor TDBVariable.Create(name: String; value : Variant);
begin
//构造函数，设置变量名及变量值
  VariableName := name;
  VariableValue := value;
end;
 
const
  Identifiers = ['a'..'z', 'A'..'Z', '0'..'9', '_', '#', '$', '.', '"', '@'];
 
procedure Register;//注册组件
 
procedure Register;
//注册组件
begin
  RegisterComponents('我的数据库组件', [TDBFilterDialog]);
end; {of Register}
 
//过滤的匹配类型：完全匹配、起始处匹配、结束处匹配、任意位置匹配、范围匹配、不匹配
  TDBFilterMatchType = (fdMatchExact, fdMatchStart, fdMatchEnd,
fdMatchAny, fdMatchRange, fdMatchNone);
 
//过滤选项：大小写敏感　　显示大小写敏感　　显示不匹配记录
  TDBOption = (fdCaseSensitive, fdShowCaseSensitive, fdShowNonMatching);
  TDBOptions = Set of TDBOption;
 
procedure TDBFilterDialog.SetDataSet(const Value: TQuery);
begin
//设置数据集
  if not ((Value is TQuery) or (Value = nil)) then//如果未指定数据集或指定的数据集不是Tquery，则发出异常
    Raise Exception.Create(SDBFilterNonDBError);
//否则 
FDataSet := Value;
SQLProp := 'SQL';   
  if ([csDesigning, csLoading] * ComponentState) = [] then
  begin
    SetFields;//设置字段
    OriginalSQL := TStrings(GetOrdProp(FDataSet, SQLProp));//
  end;
end;
 
procedure TDBFilterDialog.SetOptions(const Value: TDBOptions);
begin
//设置选项
  FOptions := Value;
end;
 
procedure TDBFilterDialog.SetCaption(const Value: String);
begin
//设置标题
  FCaption := Value;
  FDialog.Caption := FCaption;
end;

procedure TDBFilterDialog.SetDefaultMatchType(const Value: TDBFilterMatchType);
begin
//设置默认的匹配类型
FDefaultMatchType := Value;
  if Assigned(FDialog) and not (csDesigning in ComponentState) then
    case FDefaultMatchType of
      fdMatchNone :
      begin
        FDialog.grpSearchType.ItemIndex := 0;
        FDialog.cbxNonMatching.Checked := true;
      end;
      fdMatchRange:
        FDialog.pgeCriteria.ActivePage := FDialog.tabByRange;
      else
        FDialog.grpSearchType.ItemIndex := Integer(FDefaultMatchType);
    end;
end;
 
procedure TDBFilterDialog.SetFields;
var
  i, j, p : Integer;
  field, display : String;
begin
//设置字段
  FDialog.lstAllFields.Clear;//清除所有字段
  if FFields.Count = 0 then
  begin
    for i := 0 to FDataSet.FieldList.Count - 1 do
     if FDataSet.Fields[i].Visible then //定义查询字段
       FDialog.lstAllFields.Items.AddObject(FDataSet.Fields[i].DisplayName,FDataSet.FieldList.Fields[i]);
  end
  else
    for j := 0 to FFields.Count - 1 do
    begin
      p := Pos(';', FFields.Strings[j]);
      field := Copy(FFields.Strings[j], 1, p - 1);
      if p = Length(FFields.Strings[j]) then
        display := field
      else
        display := Copy(FFields.Strings[j], p+1, Length(FFields.Strings[j]));
      for i := 0 to FDataSet.FieldList.Count - 1 do
        if FDataSet.FieldList.Fields[i].FieldName = field then
        FDialog.lstAllFields.Items.AddObject(display, FDataSet.FieldList.Fields[i]);
    end;
  if FDialog.lstAllFields.Items.Count > 0 then
  begin
    FDialog.lstAllFields.ItemIndex := 0;
    FDialog.FieldsListBoxClick(nil);//单击字段列表框
  end;
end;
 
procedure TDBFilterDialog.SetFieldsList(const Value: TStringList);
begin
//设置字段列表
  FFields.Assign(Value);
end;
 
procedure TDBFilterDialog.SetOriginalSQL(const Value: TStrings);
var
  i : Integer;
begin
//设置SQL语句
  if FOriginalSQL.Text <> Value.Text then
  begin
    FOriginalSQL.Clear;
    FOriginalSQL.AddStrings(Value);
    if not (csLoading in ComponentState) then
      FFields.Clear;
    FDialog.NewSQL;//新建SQL查询
  end;
  for i := 0 to FOriginalVariables.Count - 1 do
    TDBVariable(FOriginalVariables[i]).Free;//定义参数数据变量类
  FOriginalVariables.Clear;
  if TStrings(GetOrdProp(FDataSet, SQLProp)).Text = '' then
    exit;
 
for i := 0 to TQuery(FDataSet).Params.Count - 1 do
FOriginalVariables.Add(TDBVariable.Create(TQuery(FDataSet).Params[i].Name, TQuery(FDataSet).Params[i].Value)); //定义参数数据变量类
  SetFields;//设置字段
end;
 
procedure TDBFilterDialog.RestoreSQL;
var
  i : Integer;
begin
//恢复SQL语句
  // Disable the controls while we are working
  FDataSet.DisableControls;
  FDataSet.Close;
  // clear the existing SQL and variable declarations
  // restore the original SQL and variables
  SetOrdProp(FDataSet, SQLProp, Integer(FOriginalSQL));
  if FDataSet is TDataSet then
    for i := 0 to FOriginalVariables.Count - 1 do
      TQuery(FDataSet).ParamByName(TDBVariable(FOriginalVariables[i]).VariableName).Value :=
         TDBVariable(FOriginalVariables[i]).VariableValue
  else
    for i := 0 to FOriginalVariables.Count - 1 do
      TQuery(FDataSet).ParamByName(TdBVariable(FOriginalVariables[i]).VariableName).Value :=
         TDBVariable(FOriginalVariables[i]).VariableValue;
  FDataSet.Open;
  SetFields;
  FDataSet.EnableControls;
  FModifiedSQL.Assign(TStrings(GetOrdProp(FDataSet, SQLProp)));
end;
 
procedure TDBFilterDialog.SaveParamValues;
var
  i : Integer;
begin
//保存参数值
   if FDataSet is TDataSet then
    for i := 0 to FOriginalVariables.Count - 1 do
      TDBVariable(FOriginalVariables[i]).VariableValue :=
        TQuery(FDataSet).ParamByName(TDBVariable(FOriginalVariables[i]).VariableName).Value
  else
    for i := 0 to FOriginalVariables.Count - 1 do
      TDBVariable(FOriginalVariables[i]).VariableValue :=
        TQuery(FDataSet).ParamByName(TDBVariable(FOriginalVariables[i]).VariableName).Value;
end;
 
procedure TDBFilterDialog.Loaded;
var
  i : Integer;
begin
  inherited;
  if Assigned(FDataSet) and not (csDesigning in ComponentState) then
  begin
    SetFields;
    OriginalSQL.Assign(TStrings(GetOrdProp(FDataSet, SQLProp)));
    for i := 0 to TQuery(FDataSet).Params.Count - 1 do
        FOriginalVariables.Add(TDBVariable.Create(TQuery(FDataSet).Params[i].Name,
          TQuery(FDataSet).Params[i].Value));
  end;
end;
 
procedure TDBFilterDialog.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (AComponent = FDataset) and (Operation = opRemove) then
    FDataset := nil;
end;
 
constructor TDBFilterDialog.Create(AOwner: TComponent);
begin
//构造函数
  inherited Create(AOwner);
  FDialog := TMyDBFilterDialog.Create(self);
  FOptions := [fdShowCaseSensitive, fdShowNonMatching];
  FDefaultMatchType := fdMatchStart;
  Caption := SDBFilterCaption;
  FFields := TStringList.Create;
  FOriginalSQL := TStringList.Create;
  FModifiedSQL := TStringList.Create;
  FOriginalVariables := TList.Create;
end;
destructor TDBFilterDialog.Destroy;
var
  i : Integer;
begin
  FDialog.Free;
  FFields.Free;
  FOriginalSQL.Free;
  FModifiedSQL.Free;
  for i := 0 to FOriginalVariables.Count - 1 do
    TDBVariable(FOriginalVariables[i]).Free;
  FOriginalVariables.Free;
  inherited Destroy;
end;
 
function TDBFilterDialog.Execute : Boolean;
var
  CurrentSQL : TStrings;
begin
//执行数据查询
  CurrentSQL := TStrings(GetOrdProp(FDataSet, SQLProp));
  // 检查SQL语句是否已经改变了
  if not FModifiedSQL.Equals(CurrentSQL) then
    OriginalSQL := CurrentSQL;
  if FDialog.lstAllFields.Items.Count = 0 then
    SetFields;
  FDialog.grpSearchType.ItemIndex := Integer(FDefaultMatchType);
  if fdShowCaseSensitive in Options then
    FDialog.cbxCaseSensitive.Visible := true
  else
    FDialog.cbxCaseSensitive.Visible := false;
  if fdShowNonMatching in Options then
    FDialog.cbxNonMatching.Visible := true
  else
    FDialog.cbxNonMatching.Visible := false;
  if fdCaseSensitive in Options then
    FDialog.cbxCaseSensitive.Checked := true
  else
    FDialog.cbxCaseSensitive.Checked := false;
  SaveParamValues;//保存参数值
  Result := FDialog.ShowModal = mrOK; //点击确定按钮
  if Result then
    ReBuildSQL;//重建SQL语句
end;

procedure TDBFilterDialog.SaveParamValues;
var
  i : Integer;
begin
//保存参数值
   for i := 0 to FOriginalVariables.Count - 1 do
     TDBVariable(FOriginalVariables[i]).VariableValue :=
        TQuery(FDataSet).ParamByName(TDBVariable(FOriginalVariables[i]).VariableName).Value;
end;
 
procedure TMyDBFilterDialog.btnOkClick(Sender: TObject);
var
  i : Integer;
  f : TMyFieldInfo;
begin
//点击确定按钮
  for i := FPreviousList.Count - 1 downto 0 do
  begin
    TMyFieldInfo(FPreviousList[i]).Free;
    FPreviousList.Delete(i);
  end;
  GetCriteria;//获取标准
  SetCriteria;//设置标准
  for i := 0 to FFilterList.Count - 1 do
  begin
    f := TMyFieldInfo.Create;//字段定义类
    f.Assign(TMyFieldInfo(FFilterList[i]));
    FPreviousList.Add(f);
  end;
end;
 
procedure TMyDBFilterDialog.GetCriteria ;
//获取标准
var
  FilterIndex, i : Integer;
begin
  FilterIndex := -1;
  i := 0;
  while (i < FFilterList.Count) and (FilterIndex < 0) do
  begin
    if TMyFieldInfo(FFilterList[i]).DisplayLabel = lstAllFields.Items[LastIndex] then
      FilterIndex := i;
    Inc(i);
  end;
  // This is only enabled when at least one of the fields has entry
  if btnNewSearch.Enabled then
  begin
    // The user added a new criteria
    if FilterIndex < 0 then
    begin
      FFilterList.Add(TMyFieldInfo.Create);
      FilterIndex := FFilterList.Count - 1;
      lstSelectedFields.Items.AddObject(lstAllFields.Items[LastIndex],
        lstAllFields.Items.Objects[LastIndex]);
    end;
    // Set the fields
    with TMyFieldInfo(FFilterList[FilterIndex])  do
    begin
      CaseSensitive := cbxCaseSensitive.Checked;
      DisplayLabel := lstAllFields.Items[LastIndex];
      // Save off the TField for this field
      FieldName := TField(lstAllFields.Items.Objects[LastIndex]).FieldName;
      FieldOrigin := TField(lstAllFields.Items.Objects[LastIndex]).Origin;
      FieldType := TField(lstAllFields.Items.Objects[LastIndex]).DataType;
      // Match Criteria is either Range or one of the other 4
      if pgeCriteria.ActivePage = tabByRange then
        MatchType := fdMatchRange
      else
        MatchType := TDBFilterMatchType(grpSearchType.ItemIndex);
      // Only save the criteria that they want to work with
      if MatchType = fdMatchRange then
      begin
        EndingValue := edtEndingRange.Text;
        StartingValue := edtStartingRange.Text;
        FilterValue := '';
      end
      else
      begin
        EndingValue := '';
        StartingValue := '';
        FilterValue := edtFieldValue.Text;
      end;
      NonMatching := cbxNonMatching.Checked;
    end;
  end
  else
    // The user removed a criteria that existed
    if FilterIndex >= 0 then
    begin
      // remove the Selected list item
      lstSelectedFields.Items.Delete(lstSelectedFields.Items.IndexOf(
           TMyFieldInfo(FFilterList[FilterIndex]).DisplayLabel));
      // Free the FieldInfo Object
      TMyFieldInfo(FFilterList[FilterIndex]).Free;
      // Delete it from the list
      FFilterList.Delete(FilterIndex);
      if FFilterList.Count = 0 then
        btnViewSummary.Enabled := false;
    end;
end;
 
procedure TMyDBFilterDialog.SetCriteria;
var
  FilterIndex, i : Integer;
  DisplayName : String;
begin
  DisplayName := lstAllFields.Items[lstAllFields.ItemIndex];
  i := 0;
  FilterIndex := -1;
  // Find the Item in the list if it exists
  while (i < FFilterList.Count) and (FilterIndex < 0) do
  begin
    if TMyFieldInfo(FFilterList[i]).DisplayLabel = DisplayName then
      FilterIndex := i;
    Inc(i);
  end;
  if FilterIndex < 0 then
    // This has no current criteria
    ClearCriteria
  else
  begin
    with TMyFieldInfo(FFilterList[FilterIndex])  do
    begin
      cbxCaseSensitive.Checked := CaseSensitive;
      edtEndingRange.Text := EndingValue;
      edtFieldValue.Text := FilterValue;
      if MatchType <> fdMatchRange then
        grpSearchType.ItemIndex := Integer(MatchType);
      cbxNonMatching.Checked := NonMatching;
      edtStartingRange.Text := StartingValue;
      if MatchType = fdMatchRange then
        pgeCriteria.ActivePage := tabByRange
      else
        pgeCriteria.ActivePage := tabByValue;
    end;
  end;
end;
 
procedure TDBFilterDialog.ReBuildSQL;
var
  s, s1 : String;
  SQL, NewSQL : TStringStream;
  p, i : Integer;
  hasWhere : boolean;
begin
//生成SQL语句
 if FDialog.lstSelectedFields.Items.Count = 0 then //如果没有已选字段，则
  begin
    if TStrings(GetOrdProp(FDataSet, SQLProp)) <> FOriginalSQL then
      RestoreSQL;
    exit;
  end;
 
  NewSQL := TStringStream.Create(s1);
  SQL := TStringStream.Create(s);
  try                              //保存到流
    FOriginalSQL.SaveToStream(SQL);
    SQL.Seek( 0, soFromBeginning);
    p := WordPos('WHERE', SQL.DataString);
 
    if p = 0 then  //如果SQL语句中没有WHERE子句
    begin
      hasWhere := false;
      p := WordPos('GROUP', SQL.DataString);
      if p = 0 then  //如果SQL语句中没有GROUP子句
        p := WordPos('HAVING', SQL.DataString);
        if p = 0 then  //如果SQL语句中没有HAVING子句
          P := WordPos('ORDER', SQL.DataString);
          if p = 0 then  //如果SQL语句中没有ORDER子句
            p := SQL.Size;
    end
    else
    begin //SQL语句中有WHERE子句
      hasWhere := true;
      Inc(p, 5);
    end;
 
    NewSQL.WriteString(SQL.ReadString(p - 1));
    if not hasWhere then  //如果SQL语句中没有WHERE子句
      NewSQL.WriteString(' WHERE ');
    for i := 0 to FDialog.FilterList.Count - 1 do
    begin
      NewSQL.WriteString(FDialog[i].CreateSQL);
      if i < FDialog.FilterList.Count - 1 then
        NewSQL.WriteString(' AND ')
      else
        if hasWhere then
          NewSQL.WriteString(' AND ');
    end;
    NewSQL.WriteString(SQL.ReadString(SQL.Size));
 
    // 在执行SQL时暂停有所的控件
     Application.MessageBox(PChar(NewSQL.DataString),'123',MB_OK);
      if FDataSet is TQuery then
        with FDataSet as TQuery do
        begin
          DisableControls;
          Close;
          SQL.Clear;
          SQL.Add(NewSQL.DataString);
          for i := 0 to FOriginalVariables.Count - 1 do
          begin
            ParamByName(TDBVariable(FOriginalVariables[i]).VariableName).Value :=
                  TDBVariable(FOriginalVariables[i]).VariableValue;
          end;
          // 设置新的变量
          for i := 0 to FDialog.FilterList.Count - 1 do
            FDialog[i].SetVariables(FDataSet);
          try
            Open;
          except
            RestoreSQL;  //如果出错，则恢复原来的SQL语句
          end;
        end;
 
    SetFields;
    FDataSet.EnableControls;
    FModifiedSQL.Assign(TStrings(GetOrdProp(FDataSet, SQLProp)));
  finally
    SQL.Free;
    NewSQL.Free;
  end;
end;

procedure TMyFieldInfo.SetVariables(d: TDataset);
var
  value : String;
begin
//设置变量值
  if AnsiUpperCase(FilterValue) = 'NULL' then //如果FilterValue为空，则退出
    exit;
  if FieldType = ftString then //如果字段类型为字符串型，则
  begin
    if CaseSensitive then  //如果大小写敏感
      case MatchType of  //匹配类型
        fdMatchStart, fdMatchAny :  //起始部分匹配或任意位置匹配
          value := FilterValue;
        fdMatchEnd : //结束部分匹配
          value := '%' + FilterValue; 
        fdMatchExact : //非匹配记录
          value := FilterValue;
      end
else  //大小写不敏感
  case MatchType of
        fdMatchStart, fdMatchAny : //起始部分匹配或任意位置匹配
          value := AnsiUpperCase(FilterValue);
        fdMatchEnd : //结束部分匹配
          value := '%' + AnsiUpperCase(FilterValue);  {do not localize}
        fdMatchExact : //非匹配记录
          value := AnsiUpperCase(FilterValue);
      end;
  end
  else//字段类型为非字符串型
 value := FilterValue;
 
  if MatchType <> fdMatchRange then//如果匹配类型不为按范围
TQuery(d).ParamByName(FieldName + 'Filter').Value :=  value
else //否则
    begin
      if CaseSensitive then //如果大小写敏感
      begin
        if StartingValue <> '' then //如果起始范围值不为空　
          TQuery(d).ParamByName(FieldName + 'Start').Value := StartingValue;  
    if EndingValue <> '' then //如果结束范围不为空
          TQuery(d).ParamByName(FieldName + 'End').Value := EndingValue;  
  end
      else //大小写敏感
      begin
        if StartingValue <> '' then //如果起始范围值不为空
          TQuery(d).ParamByName(FieldName + 'Start').Value := AnsiUpperCase(StartingValue);
         if EndingValue <> '' then //如果结束范围值不为空
          TQuery(d).ParamByName(FieldName + 'End').Value := AnsiUpperCase(EndingValue); 
      end;
    end;
  end
end;
 
TMyFieldInfo = class   //字段类
  public
    FieldName : String;  //字段名
    FieldOrigin : String; 
    FieldType : TFieldType;  //字段类型
    DisplayLabel : String;  //显示的名称
    MatchType : TDBFilterMatchType;  //匹配类型
    FilterValue : String; //过滤值
    StartingValue : String; //开始值
    EndingValue : String;  //结束值
    CaseSensitive : boolean; //是否大小写敏感
    NonMatching : boolean;  //不匹配
    procedure Assign(o : TMyFieldInfo); //指定字段定义
function CreateSQL : String;  //创建SQL语句
procedure SetVariables( d : TDataset);  //设置字段变量
  end;
procedure TMyFieldInfo.Assign(o : TMyFieldInfo);
begin
//指定字段信息
  FieldName := o.FieldName;
  FieldOrigin := o.FieldOrigin;
  FieldType := o.FieldType;
  DisplayLabel := o.DisplayLabel;
  MatchType := o.MatchType;
  FilterValue := o.FilterValue;
  StartingValue := o.StartingValue;
  EndingValue := o.EndingValue;
  CaseSensitive := o.CaseSensitive;
  NonMatching := o.NonMatching;
end;
function TMyFieldInfo.CreateSQL: String;
var
  Field : String;
begin
//创建SQL语句
  if FieldOrigin <> '' then
    Field := FieldOrigin
  else
    Field := FieldName;
  if NonMatching then
    Result := ' not ( '
  else
    Result := ' ( ';
  if AnsiUpperCase(FilterValue) = 'NULL' then
  begin
    Result := Result + Format('%s is NULL) ', [Field]);
    exit;
  end;
  if FieldType = ftString then
  begin
    if CaseSensitive then
      case MatchType of
        fdMatchStart:
          Result := Result + Format('%0:s starting with :%1:sFilter ) ', [Field, FieldName]);
        fdMatchAny:
          Result := Result + Format('%0:s containing :%1:sFilter ) ', [Field, FieldName]);
        fdMatchEnd :
          Result := Result + Format('%0:s = :%1:sFilter ) ', [Field, FieldName]);
        fdMatchExact :
          Result := Result + Format('%0:s = :%1:sFilter ) ', [Field, FieldName]);
        fdMatchRange :
        begin
          if StartingValue <> '' then
            Result := Result + Format('%0:s >= :%1:sStart)', [Field, FieldName]);
          if (StartingValue <> '') and (EndingValue <> '') then
            Result := Result + ' and (';
          if EndingValue <> '' then
            Result := Result + Format('%0:s <= :%1:sEnd)', [Field, FieldName]);
        end;
      end
    else
      case MatchType of
        fdMatchStart:
          Result := Result + Format('UPPER(%0:s) starting with :%1:sFilter ) ', [Field, FieldName]); {do not localize}
        fdMatchAny:
          Result := Result + Format('UPPER(%0:s) containing :%1:sFilter ) ', [Field, FieldName]); {do not localize}
        fdMatchEnd :
          Result := Result + Format('UPPER(%0:s) like :%1:sFilter ) ', [Field, FieldName]);  {do not localize}
        fdMatchExact :
          Result := Result + Format('UPPER(%0:s) = :%1:sFilter ) ', [Field, FieldName]);  {do not localize}
        fdMatchRange :
        begin
          if FieldType = ftString then
          begin
            if StartingValue <> '' then
              Result := Result + Format('UPPER(%0:s) >= :%1:sStart)', [Field, FieldName]); {do not localize}
            if (StartingValue <> '') and (EndingValue <> '') then
              Result := Result + ' and (';  {do not localize}
            if EndingValue <> '' then
              Result := Result + Format('UPPER(%0:s) <= :%1:sEnd)', [Field, FieldName]); {do not localize}
          end
          else
          begin
            if StartingValue <> '' then
              Result := Result + Format('%0:s >= :%1:sStart)', [Field, FieldName]);   {do not localize}
            if (StartingValue <> '') and (EndingValue <> '') then
              Result := Result + ' and (';   {do not localize}
            if EndingValue <> '' then
              Result := Result + Format('%0:s <= :%1:sEnd)', [Field, FieldName]);  {do not localize}
          end
        end;
      end;
  end
  else
    case MatchType of
      fdMatchRange :
      begin
        if StartingValue <> '' then
          Result := Result + Format('%0:s >= :%1:sStart)', [Field, FieldName]); {do not localize}
        if (StartingValue <> '') and (EndingValue <> '') then
          Result := Result + ' and ('; {do not localize}
        if EndingValue <> '' then
          Result := Result + Format('%0:s <= :%1:sEnd)', [Field, FieldName]);  {do not localize}
      end;
      else
        Result := Result + Format('%0:s = :%1:sFilter ) ', [Field, FieldName]); {do not localize}
    end;
end;

procedure TMyFieldInfo.SetVariables(d: TDataset);
var
  value : String;
begin
//设置变量值
  if AnsiUpperCase(FilterValue) = 'NULL' then
    exit;
  if FieldType = ftString then
  begin
    if CaseSensitive then
      case MatchType of
        fdMatchStart, fdMatchAny :
          value := FilterValue;
        fdMatchEnd :
          value := '%' + FilterValue;
        fdMatchExact :
          value := FilterValue;
      end
    else
      case MatchType of
        fdMatchStart, fdMatchAny :
          value := AnsiUpperCase(FilterValue);
        fdMatchEnd :
          value := '%' + AnsiUpperCase(FilterValue);
        fdMatchExact :
          value := AnsiUpperCase(FilterValue);
      end;
  end
  else
    value := FilterValue;
  if d is TDataSet then
  begin
    if MatchType <> fdMatchRange then
      TQuery(d).ParamByName(FieldName + 'Filter').Value :=  value
    else
    begin
      if CaseSensitive then
      begin
        if StartingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'Start').Value := StartingValue;
        if EndingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'End').Value := EndingValue;
      end
      else
      begin
        if StartingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'Start').Value := AnsiUpperCase(StartingValue);
        if EndingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'End').Value := AnsiUpperCase(EndingValue);
      end;
    end;
  end
  else
  begin
    if MatchType <> fdMatchRange then
      TQuery(d).ParamByName(FieldName + 'Filter').Value :=  value
    else
    begin
      if CaseSensitive then
      begin
        if StartingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'Start').Value := StartingValue;
        if EndingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'End').Value := EndingValue;
      end
      else
      begin
        if StartingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'Start').Value := AnsiUpperCase(StartingValue);
        if EndingValue <> '' then
          TQuery(d).ParamByName(FieldName + 'End').Value := AnsiUpperCase(EndingValue);  
      end;
    end;
  end
end;
 
TDBVariable = class  //参数数据变量
  public
    VariableName : String;  //变量名 
    VariableValue : Variant;  //变量值
    constructor Create(name : String; value : Variant); //构造函数
  end;
posted @ 2005-06-14 08:13  toddzhuang  阅读(1231)  评论(0)  编辑  收藏  举报