📄 frxcustomdb.pas
字号:
begin
Report.DataSets.Add(Self);
if Report.Designer <> nil then
Report.Designer.UpdateDataTree;
end;
end;
end;
procedure TfrxCustomDataset.SetUserName(const Value: String);
begin
inherited;
if (Report <> nil) and (Report.Designer <> nil) then
Report.Designer.UpdateDataTree;
end;
procedure TfrxCustomDataset.OnPaste;
var
i: Integer;
sl: TStringList;
begin
if Report.DataSets.Find(Self) = nil then
Report.DataSets.Add(Self);
sl := TStringList.Create;
if Report <> nil then
Report.GetDatasetList(sl);
for i := 0 to sl.Count - 1 do
if (sl.Objects[i] <> Self) and (CompareText(sl[i], UserName) = 0) then
begin
if Name <> '' then
UserName := Name;
break;
end;
sl.Free;
Report.Designer.UpdateDataTree;
end;
procedure TfrxCustomDataset.SetActive(Value: Boolean);
begin
Dataset.Active := Value;
end;
procedure TfrxCustomDataset.SetFilter(const Value: String);
begin
Dataset.Filter := Value;
end;
function TfrxCustomDataset.GetActive: Boolean;
begin
Result := Dataset.Active;
end;
function TfrxCustomDataset.GetFields: TFields;
begin
Result := Dataset.Fields;
end;
function TfrxCustomDataset.GetFilter: String;
begin
Result := Dataset.Filter;
end;
function TfrxCustomDataset.GetFiltered: Boolean;
begin
Result := Dataset.Filtered;
end;
procedure TfrxCustomDataset.SetFiltered(Value: Boolean);
begin
Dataset.Filtered := Value;
end;
procedure TfrxCustomDataset.InternalSetMaster(const Value: TfrxDBDataSet);
begin
FMaster := Value;
if FMaster <> nil then
FDataSource.DataSet := FMaster.GetDataSet
else
FDataSource.DataSet := nil;
end;
procedure TfrxCustomDataset.InternalSetMasterFields(const Value: String);
var
sl: TStringList;
s: String;
i: Integer;
function ConvertAlias(const s: String): String;
begin
if FMaster <> nil then
Result := FMaster.ConvertAlias(s)
else
Result := s;
end;
begin
FMasterFields := Value;
sl := TStringList.Create;
frxSetCommaText(Value, sl);
s := '';
for i := 0 to sl.Count - 1 do
s := s + ConvertAlias(sl.Values[sl.Names[i]]) + ';';
s := Copy(s, 1, Length(s) - 1);
SetMasterFields(s);
s := '';
for i := 0 to sl.Count - 1 do
s := s + ConvertAlias(sl.Names[i]) + ';';
s := Copy(s, 1, Length(s) - 1);
if Self is TfrxCustomTable then
TfrxCustomTable(Self).SetIndexFieldNames(s);
sl.Free;
end;
procedure TfrxCustomDataset.SetMaster(const Value: TDataSource);
begin
// do nothing
end;
procedure TfrxCustomDataset.SetMasterFields(const Value: String);
begin
// do nothing
end;
{ TfrxCustomTable }
function TfrxCustomTable.GetIndexFieldNames: String;
begin
Result := '';
end;
function TfrxCustomTable.GetIndexName: String;
begin
Result := '';
end;
function TfrxCustomTable.GetTableName: String;
begin
Result := '';
end;
procedure TfrxCustomTable.SetIndexFieldNames(const Value: String);
begin
// do nothing
end;
procedure TfrxCustomTable.SetIndexName(const Value: String);
begin
// do nothing
end;
procedure TfrxCustomTable.SetTableName(const Value: String);
begin
// do nothing
end;
{ TfrxCustomQuery }
constructor TfrxCustomQuery.Create(AOwner: TComponent);
begin
inherited;
FParams := TfrxParams.Create;
FSaveOnBeforeOpen := DataSet.BeforeOpen;
DataSet.BeforeOpen := OnBeforeOpen;
FSaveOnChange := TStringList(SQL).OnChange;
TStringList(SQL).OnChange := OnChangeSQL;
end;
destructor TfrxCustomQuery.Destroy;
begin
FParams.Free;
inherited;
end;
procedure TfrxCustomQuery.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('Parameters', ReadData, WriteData, True);
end;
procedure TfrxCustomQuery.ReadData(Reader: TReader);
begin
frxReadCollection(FParams, Reader, Self);
UpdateParams;
end;
procedure TfrxCustomQuery.WriteData(Writer: TWriter);
begin
frxWriteCollection(FParams, Writer, Self);
end;
procedure TfrxCustomQuery.OnBeforeOpen(DataSet: TDataSet);
begin
UpdateParams;
if Assigned(FSaveOnBeforeOpen) then
FSaveOnBeforeOpen(DataSet);
end;
procedure TfrxCustomQuery.OnChangeSQL(Sender: TObject);
begin
if Assigned(FSaveOnChange) then
FSaveOnChange(Sender);
FParams.UpdateParams(SQL.Text);
end;
procedure TfrxCustomQuery.SetParams(Value: TfrxParams);
begin
FParams.Assign(Value);
end;
function TfrxCustomQuery.ParamByName(const Value: String): TfrxParamItem;
begin
Result := FParams.Find(Value);
if Result = nil then
raise Exception.Create('Parameter "' + Value + '" not found');
end;
procedure TfrxCustomQuery.SetSQL(Value: TStrings);
begin
//
end;
function TfrxCustomQuery.GetSQL: TStrings;
begin
Result := nil;
end;
procedure TfrxCustomQuery.UpdateParams;
begin
//
end;
{$IFDEF QBUILDER}
function TfrxCustomQuery.QBEngine: TfqbEngine;
begin
Result := nil;
end;
{$ENDIF}
{ frxParamsToTParams }
procedure frxParamsToTParams(Query: TfrxCustomQuery; Params: TParams);
var
i: Integer;
Item: TfrxParamItem;
begin
for i := 0 to Params.Count - 1 do
if Query.Params.IndexOf(Params[i].Name) <> -1 then
begin
Item := Query.Params[Query.Params.IndexOf(Params[i].Name)];
Params[i].Clear;
{ Bound should be True in design mode }
if not (Query.IsLoading or Query.IsDesigning) then
Params[i].Bound := False
else
Params[i].Bound := True;
Params[i].DataType := Item.DataType;
if Trim(Item.Expression) <> '' then
if not (Query.IsLoading or Query.IsDesigning) then
if Query.Report <> nil then
begin
Query.Report.CurObject := Query.Name;
Item.Value := Query.Report.Calc(Item.Expression);
end;
if not VarIsEmpty(Item.Value) then
begin
Params[i].Bound := True;
if Params[i].DataType in [ftDate, ftTime, ftDateTime] then
Params[i].Value := Item.Value
else
Params[i].Text := VarToStr(Item.Value);
end;
end;
end;
{ TfrxDBLookupComboBox }
constructor TfrxDBLookupComboBox.Create(AOwner: TComponent);
begin
inherited;
FDBLookupComboBox := TDBLookupComboBox.Create(nil);
InitControl(FDBLookupComboBox);
Width := 145;
Height := 21;
FDataSource := TDataSource.Create(nil);
FDBLookupComboBox.ListSource := FDataSource;
end;
destructor TfrxDBLookupComboBox.Destroy;
begin
FDataSource.Free;
inherited;
end;
class function TfrxDBLookupComboBox.GetDescription: String;
begin
Result := frxResources.Get('obDBLookup');
end;
function TfrxDBLookupComboBox.GetDataSetName: String;
begin
if FDataSet = nil then
Result := FDataSetName else
Result := FDataSet.UserName;
end;
function TfrxDBLookupComboBox.GetKeyField: String;
begin
Result := FDBLookupComboBox.KeyField;
if FDataSet <> nil then
Result := FDataSet.GetAlias(Result);
end;
function TfrxDBLookupComboBox.GetKeyValue: Variant;
begin
Result := FDBLookupComboBox.KeyValue;
end;
function TfrxDBLookupComboBox.GetListField: String;
begin
Result := FDBLookupComboBox.ListField;
if FDataSet <> nil then
Result := FDataSet.GetAlias(Result);
end;
function TfrxDBLookupComboBox.GetText: String;
begin
Result := FDBLookupComboBox.Text;
end;
procedure TfrxDBLookupComboBox.SetDataSet(const Value: TfrxDBDataSet);
begin
FDataSet := Value;
if FDataSet = nil then
FDataSetName := '' else
FDataSetName := FDataSet.UserName;
UpdateDataSet;
end;
procedure TfrxDBLookupComboBox.SetDataSetName(const Value: String);
begin
FDataSetName := Value;
FDataSet := TfrxDBDataSet(frxFindDataSet(FDataSet, FDataSetName, Report));
UpdateDataSet;
end;
procedure TfrxDBLookupComboBox.SetKeyField(Value: String);
begin
if FDataSet <> nil then
Value := FDataSet.ConvertAlias(Value);
FDBLookupComboBox.KeyField := Value;
end;
procedure TfrxDBLookupComboBox.SetKeyValue(const Value: Variant);
begin
FDBLookupComboBox.KeyValue := Value;
end;
procedure TfrxDBLookupComboBox.SetListField(Value: String);
begin
if FDataSet <> nil then
Value := FDataSet.ConvertAlias(Value);
FDBLookupComboBox.ListField := Value;
end;
procedure TfrxDBLookupComboBox.UpdateDataSet;
begin
if FDataSet <> nil then
FDataSource.DataSet := FDataSet.GetDataSet else
FDataSource.DataSet := nil;
end;
procedure TfrxDBLookupComboBox.BeforeStartReport;
begin
SetListField(FDBLookupComboBox.ListField);
SetKeyField(FDBLookupComboBox.KeyField);
end;
initialization
frxObjects.RegisterObject1(TfrxDBLookupComboBox, nil, '', 'Other controls', 0, 41);
end.
//<censored>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -