frxadocomponents.pas

报表控件。FastReport 是非常强大的报表控件

  i: Integer;
  l: TList;
begin
  inherited;
  l := Report.AllObjects;
  for i := 0 to l.Count - 1 do
    if TObject(l[i]) is TfrxADODatabase then
    begin
      SetDatabase(TfrxADODatabase(l[i]));
      break;
    end;
end;

class function TfrxADOTable.GetDescription: String;
begin
  Result := frxResources.Get('obADOTb');
end;

procedure TfrxADOTable.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FDatabase) then
    SetDatabase(nil);
end;

procedure TfrxADOTable.SetDatabase(Value: TfrxADODatabase);
begin
  FDatabase := Value;
  if Value <> nil then
    FTable.Connection := Value.Database
  else if ADOComponents <> nil then
    FTable.Connection := ADOComponents.DefaultDatabase
  else
    FTable.Connection := nil;
  DBConnected := FTable.Connection <> nil;
end;

function TfrxADOTable.GetIndexFieldNames: String;
begin
  Result := FTable.IndexFieldNames;
end;

function TfrxADOTable.GetIndexName: String;
begin
  Result := FTable.IndexName;
end;

function TfrxADOTable.GetTableName: String;
begin
  Result := FTable.TableName;
end;

procedure TfrxADOTable.SetIndexFieldNames(const Value: String);
begin
  FTable.IndexFieldNames := Value;
end;

procedure TfrxADOTable.SetIndexName(const Value: String);
begin
  FTable.IndexName := Value;
end;

procedure TfrxADOTable.SetTableName(const Value: String);
begin
  FTable.TableName := Value;
end;

procedure TfrxADOTable.SetMaster(const Value: TDataSource);
begin
  FTable.MasterSource := Value;
end;

procedure TfrxADOTable.SetMasterFields(const Value: String);
begin
  FTable.MasterFields := Value;
end;

procedure TfrxADOTable.BeforeStartReport;
begin
  SetDatabase(FDatabase);
end;

{$IFDEF FR_COM}
function TfrxADOTable.Get_DataBase(out Value: IfrxADODatabase): HResult; stdcall;
begin
  Value := Database;
  Result := S_OK;
end;

function TfrxADOTable.Set_DataBase(const Value: IfrxADODatabase): HResult; stdcall;
var
  idsp : IfrxComponentSelf;
begin
  if Value <> nil then
  begin
    Result := Value.QueryInterface(IfrxComponentSelf, idsp);
    if Result = S_OK then
      Database := TfrxADODatabase(idsp.GetObject);
  end
  else
  begin
    Database := nil;
    Result := S_OK;
  end;
end;

function TfrxADOTable.Get_IndexName(out Value: WideString): HResult; stdcall;
begin
  Value := FTable.IndexName;
  Result := S_OK;
end;

function TfrxADOTable.Set_IndexName(const Value: WideString): HResult; stdcall;
begin
  FTable.IndexName := Value;
  Result := S_OK;
end;

function TfrxADOTable.Get_TableName( out Value : WideString): HResult; stdcall;
begin
  Value := FTable.TableName;
  Result := S_OK;
end;

function TfrxADOTable.Set_TableName(const Value: WideString): HResult; stdcall;
begin
  FTable.TableName := Value;
  Result := S_OK;
end;

function TfrxADOTable.Get_Name(out Value: WideString): HResult; stdcall;
begin
  Value := Name;
  Result := S_OK;
end;

function TfrxADOTable.Set_Name(const Value: WideString): HResult; stdcall;
begin
  Name := Value;
  Result := S_OK;
end;
{$ENDIF}

{ TfrxADOQuery }

constructor TfrxADOQuery.Create(AOwner: TComponent);
begin
  FStrings := TStringList.Create;
  FQuery := TADOQuery.Create(nil);
  Dataset := FQuery;
  SetDatabase(nil);
  FLock := False;
  inherited;
end;

constructor TfrxADOQuery.DesignCreate(AOwner: TComponent; Flags: Word);
var
  i: Integer;
  l: TList;
begin
  inherited;
  l := Report.AllObjects;
  for i := 0 to l.Count - 1 do
    if TObject(l[i]) is TfrxADODatabase then
    begin
      SetDatabase(TfrxADODatabase(l[i]));
      break;
    end;
end;

destructor TfrxADOQuery.Destroy;
begin
  FStrings.Free;
  inherited;
end;

class function TfrxADOQuery.GetDescription: String;
begin
  Result := frxResources.Get('obADOQ');
end;

procedure TfrxADOQuery.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FDatabase) then
    SetDatabase(nil);
end;

function TfrxADOQuery.GetSQL: TStrings;
begin
  FLock := True;
  FStrings.Assign(FQuery.SQL);
  FLock := False;
  Result := FStrings;
end;

procedure TfrxADOQuery.SetSQL(Value: TStrings);
begin
  FQuery.SQL.Assign(Value);
  FStrings.Assign(FQuery.SQL);
end;

procedure TfrxADOQuery.SetDatabase(Value: TfrxADODatabase);
begin
  FDatabase := Value;
  if Value <> nil then
    FQuery.Connection := Value.Database
  else if ADOComponents <> nil then
    FQuery.Connection := ADOComponents.DefaultDatabase
  else
    FQuery.Connection := nil;
  DBConnected := FQuery.Connection <> nil;
end;

procedure TfrxADOQuery.SetMaster(const Value: TDataSource);
begin
  FQuery.DataSource := Value;
end;

function TfrxADOQuery.GetCommandTimeout: Integer;
begin
  Result := THackQuery(FQuery).CommandTimeout;
end;

procedure TfrxADOQuery.SetCommandTimeout(const Value: Integer);
begin
  THackQuery(FQuery).CommandTimeout := Value;
end;

procedure TfrxADOQuery.UpdateParams;
begin
  frxParamsToTParameters(Self, FQuery.Parameters);
end;

procedure TfrxADOQuery.OnChangeSQL(Sender: TObject);
var
  i, ind: Integer;
  Param: TfrxParamItem;
  QParam: TParameter;
begin
  if not FLock then
  begin
    { needed to update parameters }
    FQuery.SQL.Text := '';
    FQuery.SQL.Assign(FStrings);
    inherited;

    { fill datatype automatically, if possible }
    for i := 0 to FQuery.Parameters.Count - 1 do
    begin
      QParam := FQuery.Parameters[i];
      ind := Params.IndexOf(QParam.Name);
      if ind <> -1 then
      begin
        Param := Params[ind];
        if (Param.DataType = ftUnknown) and (QParam.DataType <> ftUnknown) then
          Param.DataType := QParam.DataType;
      end;
    end;
  end;
end;

procedure TfrxADOQuery.BeforeStartReport;
begin
  SetDatabase(FDatabase);
  { needed to update parameters }
  SQL.Text := SQL.Text;
end;

{$IFDEF QBUILDER}
function TfrxADOQuery.QBEngine: TfqbEngine;
begin
  Result := TfrxEngineADO.Create(nil);
  TfrxEngineADO(Result).FQuery.Connection := FQuery.Connection;
end;
{$ENDIF}

{$IFDEF FR_COM}
function TfrxADOQuery.Get_DataBase(out Value: IfrxADODatabase): HResult; stdcall;
begin
  Value := Database;
  Result := S_OK;
end;

function TfrxADOQuery.Set_DataBase(const Value: IfrxADODatabase): HResult; stdcall;
var
  idsp : IfrxComponentSelf;
begin
  if Value <> nil then
  begin
    Result := Value.QueryInterface(IfrxComponentSelf, idsp);
    if Result = S_OK then Database := TfrxADODatabase(idsp.GetObject);
  end
  else
  begin
    Database := nil;
    Result := S_OK;
  end
end;

function TfrxADOQuery.Get_Query(out Value: WideString): HResult; stdcall;
begin
  Value := String(SQL.GetText);
  Result := S_OK;
end;

function TfrxADOQuery.Set_Query(const Value: WideString): HResult; stdcall;
begin
  SQL.Text := Value;
  Result := S_OK;
end;

function TfrxADOQuery.Get_Name(out Value: WideString): HResult; stdcall;
begin
  Value := Name;
  Result := S_OK;
end;

function TfrxADOQuery.Set_Name(const Value: WideString): HResult; stdcall;
begin
  Name := Value;
  Result := S_OK;
end;

function TfrxADOQuery.Get_CommandTimeout(out Value: Integer): HResult; stdcall;
begin
  Value := CommandTimeout;
  Result := S_OK;
end;

function TfrxADOQuery.Set_CommandTimeout(Value: Integer): HResult; stdcall;
begin
  CommandTimeout := Value;
  Result := S_OK;
end;


function TfrxADOQuery.ParamByName(const Name: WideString; out Param: IfrxParamItem): HResult; stdcall;
var
  par: TfrxParamItem;
begin
  par := inherited ParamByName(Name);
  if par <>  nil then
  begin
    Param := par;
    Result := S_OK;
  end
  else Result := E_INVALIDARG;

end;
{$ENDIF}

{$IFDEF QBUILDER}
constructor TfrxEngineADO.Create(AOwner: TComponent);
begin
  inherited;
  FQuery := TADOQuery.Create(Self);
end;

destructor TfrxEngineADO.Destroy;
begin
  FQuery.Free;
  inherited;
end;

procedure TfrxEngineADO.ReadFieldList(const ATableName: string;
  var AFieldList: TfqbFieldList);
var
  TempTable: TADOTable;
  Fields: TFieldDefs;
  i: Integer;
  tmpField: TfqbField;
begin
  AFieldList.Clear;
  TempTable := TADOTable.Create(Self);
  TempTable.Connection := FQuery.Connection;
  TempTable.TableName := ATableName;
  Fields := TempTable.FieldDefs;
  try
    try
      TempTable.Active := True;
      tmpField:= TfqbField(AFieldList.Add);
      tmpField.FieldName := '*';
      for i := 0 to Fields.Count - 1 do
      begin
        tmpField := TfqbField(AFieldList.Add);
        tmpField.FieldName := Fields.Items[i].Name;
        tmpField.FieldType := Ord(Fields.Items[i].DataType)
      end;
    except
    end;
  finally
    TempTable.Free;
  end;
end;

procedure TfrxEngineADO.ReadTableList(ATableList: TStrings);
begin
  ATableList.Clear;
  frxADOGetTableNames(FQuery.Connection, ATableList, ShowSystemTables);
//  FQuery.Connection.GetTableNames(ATableList, ShowSystemTables);
end;

function TfrxEngineADO.ResultDataSet: TDataSet;
begin
  Result := FQuery;
end;

procedure TfrxEngineADO.SetSQL(const Value: string);
begin
  FQuery.SQL.Text := Value;
end;
{$ENDIF}


initialization
  frxObjects.RegisterCategory('ADO', nil, 'obADOComps', 35);
  frxObjects.RegisterObject1(TfrxADODataBase, nil, '', 'ADO', 0, 37);
  frxObjects.RegisterObject1(TfrxADOTable, nil, '', 'ADO', 0, 38);
  frxObjects.RegisterObject1(TfrxADOQuery, nil, '', 'ADO', 0, 39);

{$IFDEF FR_COM}
  TComponentFactory.Create(ComServer, TfrxADODatabase, Class_TfrxADODatabase, ciMultiInstance, tmApartment);
  TComponentFactory.Create(ComServer, TfrxADOTable, CLASS_TfrxADOTable, ciMultiInstance, tmApartment);
  TComponentFactory.Create(ComServer, TfrxADOQuery, CLASS_TfrxADOQuery, ciMultiInstance, tmApartment);
{$ENDIF}

finalization
  frxObjects.UnRegister(TfrxADODataBase);
  frxObjects.UnRegister(TfrxADOTable);
  frxObjects.UnRegister(TfrxADOQuery);

end.