通用查询组件设计
前段时间由于工作较忙，无暇整理本组件的相关文档，请大家谅解！以后我会陆续整理公布该组件的所有相关文档及源码！
保存参数值
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;
重建SQL语句
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;
本文地址：http://com.8s8s.com/it/it5115.htm