在当前的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;
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;
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;
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;
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;
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;