daabsolutedb.pas

This is End User Control Program

{------------------------------------------------------------------------------}
{ TdaABSDataSet.GetActive }

function TdaABSDataSet.GetActive: Boolean;
begin
  Result := GetDataSet.Active
end; {function, GetActive}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.SetActive }

procedure TdaABSDataSet.SetActive(Value: Boolean);
begin
  GetDataSet.Active := Value;
end; {procedure, SetActive}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.GetDataSet }

function TdaABSDataSet.GetDataSet: TDataSet;
begin
  if (FDataSet = nil) then
    FDataSet := TABSTable.Create(Self);
  Result := FDataSet;
end; {procedure, GetDataSet}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.SetDatabase }

procedure TdaABSDataSet.SetDatabase(aDatabase: TComponent);
begin
  inherited SetDatabase(aDatabase);
  {table cannot be active to set database property}
  if GetDataSet.Active then
    FDataSet.Active := False;
  FDatabase := TABSDatabase(aDatabase);
  if (FDatabase <> nil) then
    begin
      FDataSet.DatabaseName := FDatabase.DatabaseName;
      FDataSet.SessionName  := FDatabase.SessionName;
    end;
end; {procedure, SetDatabase}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.SetDataName }

procedure TdaABSDataSet.SetDataName(const aDataName: String);
const
  lcDoubleQuote = #34;
var
  lsTableName: String;
begin
  inherited SetDataName(aDataName);
  {dataset cannot be active to set table name property}
  if GetDataset.Active then
    FDataSet.Active := False;
  {strip off any double quotes which may be added by the DataDictionary Builder}
  lsTableName := StringReplace(aDataName, lcDoubleQuote, '', [rfReplaceAll]);
  FDataSet.TableName := lsTableName;
end; {procedure, SetDataName}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.BuildFieldList }

procedure TdaABSDataSet.BuildFieldList;
var
  liIndex: Integer;
  lABSField: TField;
  lField: TppField;
begin
  inherited BuildFieldList;

  {set dataset to active}
  if not(GetDataSet.Active) then
    try
      FDataSet.Active := True;
    except
      on E:Exception do
        Exit;
    end;

  {create TppField objects for each field in the table}
  for liIndex := 0 to FDataSet.FieldCount - 1 do
    begin
      lABSField := FDataSet.Fields[liIndex];
      lField := TppField.Create(nil);
      lField.TableName := FDataSet.TableName;
      lField.FieldName := lABSField.FieldName;
      lField.FieldAlias := lABSField.DisplayLabel;
      lField.FieldLength := lABSField.Size;
      lField.DataType := ppConvertFieldType(lABSField.DataType);
      lField.DisplayWidth := lABSField.DisplayWidth;
      AddField(lField);
    end;
end; {function, BuildFieldList}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.GetFieldNamesForSQL }

procedure TdaABSDataSet.GetFieldNamesForSQL(aList: TStrings; aSQL: TStrings);
var lQuery: TABSQuery;
begin

  if (FDatabase = nil) then
    raise EDataError.Create('TdaABSDataSet.GetFieldNamesForSQL: Database property is nil');

  aList.Clear;

  {create a temporary ABS query}
  lQuery := TABSQuery.Create(Self);

  {set the database and SQL properties}
  lQuery.DatabaseName := FDatabase.DatabaseName;
  lQuery.SessionName := FDatabase.SessionName;
  lQuery.SQL := aSQL;
  lQuery.RequestLive := false;  //Added by GDW to improve query speed.

  {get the field names}
  lQuery.GetFieldNames(aList);

  lQuery.Free;
end; {procedure, GetFieldNamesForSQL}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.GetFieldsForSQL }

procedure TdaABSDataSet.GetFieldsForSQL(aList: TList; aSQL: TStrings);
var
  lQuery: TABSQuery;
  lABSField: TField;
  lField: TppField;
  liIndex: Integer;
begin

  if (FDatabase = nil) then
    raise EDataError.Create('TdaABSDataSet.GetFieldsForSQL: Database property is nil');

  aList.Clear;

  {create a temporary ABS query}
  lQuery := TABSQuery.Create(Self);

  try

    {assign database and SQL properties}
    lQuery.DatabaseName := FDatabase.DatabaseName;
    lQuery.SessionName := FDatabase.SessionName;
    lQuery.SQL := aSQL;
    lQuery.RequestLive := True; //Added by GDW to improve query speed.

    lQuery.Active := True;

    {create a TppField object for each field in the query}
    for liIndex := 0 to lQuery.FieldCount - 1 do
      begin
        lABSField := lQuery.Fields[liIndex];

        lField := TppField.Create(nil);

        lField.FieldName := lABSField.FieldName;
        lField.FieldAlias := lABSField.DisplayLabel;
        lField.FieldLength := lABSField.Size;
        lField.DataType := ppConvertFieldType(lABSField.DataType);
        lField.DisplayWidth := lABSField.DisplayWidth;

        aList.Add(lField);
      end;

  finally
    lQuery.Free;
  end;

end; {procedure, GetFieldsForSQL}


{******************************************************************************
 *
 **  A B S   Q U E R Y   D A T A V I E W
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TdaABsQueryDataView.Create }

constructor TdaABSQueryDataView.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  {notes: 1. must use ChildQuery, ChildDataSource, ChildPipeline etc.
          2. use Self as owner for Query, DataSource etc.
          3. do NOT assign a Name }

  FQuery := TdaChildABSQuery.Create(Self);

  FDataSource := TppChildDataSource.Create(Self);
  FDataSource.DataSet := FQuery;
end; {constructor, Create}

{------------------------------------------------------------------------------}
{ TdaABSQueryDataView.Destroy }

destructor TdaABSQueryDataView.Destroy;
begin
  FDataSource.Free;
  FQuery.Free;
  inherited Destroy;
end; {destructor, Destroy}

{------------------------------------------------------------------------------}
{ TdaABSQueryDataView.SessionClass }

class function TdaABSQueryDataView.SessionClass: TClass;
begin
  Result := TdaABSSession;
end; {class function, SessionClass}

{------------------------------------------------------------------------------}
{ TdaABSQueryDataView.PreviewFormClass }

class function TdaABSQueryDataView.PreviewFormClass: TFormClass;
begin
  Result := TFormClass(GetClass('TdaPreviewDataDialog'));
end; {class function, PreviewFormClass}

{------------------------------------------------------------------------------}
{ TdaABSQueryDataView.ConnectPipelinesToData }

procedure TdaABSQueryDataView.ConnectPipelinesToData;
begin
  if DataPipelineCount = 0 then Exit;
  {need to reconnect here}
  TppDBPipeline(DataPipelines[0]).DataSource := FDataSource;
end; {procedure, ConnectPipelinesToData}

{------------------------------------------------------------------------------}
{ TdaABSQueryDataView.Init }

procedure TdaABSQueryDataView.Init;
var lDataPipeline: TppChildDBPipeline;
begin
  inherited Init;
  if DataPipelineCount > 0 then Exit;
  {note: DataView's owner must own the DataPipeline }
  lDataPipeline := TppChildDBPipeline(ppComponentCreate(Self, TppChildDBPipeline));
  lDataPipeline.DataSource := FDataSource;
  lDataPipeline.AutoCreateFields := False;
  {add DataPipeline to the dataview }
  lDataPipeline.DataView := Self;
end; {procedure, Init}

{------------------------------------------------------------------------------}
{ TdaABSQueryDataView.SQLChanged }

procedure TdaABSQueryDataView.SQLChanged;
var
  lDatabase: TComponent;
begin

  if FQuery.Active then
    FQuery.Close;

  lDatabase := Session.GetDatabaseForName(SQL.DatabaseName);

  if (lDatabase = nil) then
    raise EDataError('TdaABSQueryDataView.SQLChanged: No ABSDatabase object found, ' + SQL.DatabaseName);

  FQuery.DatabaseName := TABSDatabase(lDatabase).DatabaseName;
  FQuery.SessionName := TABSDatabase(lDatabase).SessionName;

  FQuery.SQL := SQL.MagicSQLText;

end; {procedure, SQLChanged}

{******************************************************************************
 *
 ** R E G I S T E R
 *
{******************************************************************************}

procedure Register;
begin

  {ABS data access components}
  RegisterNoIcon([TdaChildABSQuery, TdaChildABSTable]);

  {ABS dataviews}
  RegisterNoIcon([TdaABSQueryDataView]);

end;

{------------------------------------------------------------------------------}

initialization

  FABSDatabase := nil;

  {register the ABS descendant classes}
  RegisterClasses([TdaChildABSQuery, TdaChildABSTable]);

  {register DADE descendant classes}
  daRegisterSession(TdaABSSession);
  daRegisterDataSet(TdaABSDataSet);
  daRegisterDataView(TdaABSQueryDataView);

finalization

  FABSDatabase.Free;
  FABSDatabase := nil;

  {unregister the ABS descendant classes}
  UnRegisterClasses([TdaChildABSQuery, TdaChildABSTable]);

  {unregister DADE descendant the classes}
  daUnRegisterSession(TdaABSSession);
  daUnRegisterDataSet(TdaABSDataSet);
  daUnRegisterDataView(TdaABSQueryDataView);

end.