frxcustomdb.pas

这个是功能强大的报表软件

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;
      Params[i].DataType := Item.DataType;
      { Bound should be True in design mode }
      if not (Query.IsLoading or Query.IsDesigning) then
        Params[i].Bound := False
      else
      begin
        if Item.Expression <> '' then
          Params[i].Value := 0;
        Params[i].Bound := True;
      end;

      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;

function TfrxCustomQuery.GetIgnoreDupParams: Boolean;
begin
  Result := FParams.FIgnoreDuplicates;
end;

procedure TfrxCustomQuery.SetIgnoreDupParams(const Value: Boolean);
begin
  FParams.FIgnoreDuplicates := Value;
  FParams.UpdateParams(SQL.Text);
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;
  FDataSet := TfrxDBDataSet(Report.GetDataset(FDataSetName));
  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(FindDataSet(FDataSet, FDataSetName));
  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);
  Self.OnActivate := OnOpenDS;
end;


procedure TfrxDBLookupComboBox.OnOpenDS(Sender: TObject);
begin
  UpdateDataSet;
  if (FDataSet <> nil) and (FAutoOpenDataSet) then
    FDataSet.Open;
end;

initialization
  frxObjects.RegisterObject1(TfrxDBLookupComboBox, nil, '', '', 0, 41);

finalization
  frxObjects.UnRegister(TfrxDBLookupComboBox);


end.


//