通用查詢組件設(shè)計
前段時間由于工作較忙，無暇整理本組件的相關(guān)文檔，請大家諒解！以后我會陸續(xù)整理公布該組件的所有相關(guān)文檔及源碼！
PRocedure TDBFilterDialog.SaveParamValues;
var
i : Integer;
begin
//保存參數(shù)值
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;//設(shè)置標準
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));
// 在執(zhí)行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;
// 設(shè)置新的變量
for i := 0 to FDialog.FilterList.Count - 1 do
FDialog[i].SetVariables(FDataSet);
try
Open;
except
RestoreSQL; //如果出錯，則恢復(fù)原來的SQL語句
end;
end;
SetFields;
FDataSet.EnableControls;
FModifiedSQL.Assign(TStrings(GetOrdProp(FDataSet, SQLProp)));
finally
SQL.Free;
NewSQL.Free;
end;
end;
新聞熱點
疑難解答
