通用查询组件设计(续二)

作者：nxyc_twz@163.com
　　 前段时间由于工作较忙，无暇整理本组件的相关文档，请大家谅解！以后我会陆续整理公布该组件的所有相关文档及源码！

保存参数值

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;