sctvar.pas

suite component ace report

      begin
        if Parent is TSctPage then TSctPage(Parent).RemoveVar(self);
      end;
      inherited SetParent(nil);
    end;
  end;
end;

procedure TSctvar.updatelast;
begin
  DataLast.SetData(DataNow);
end;

procedure TSctvar.ReverseUpdate;
begin
  DataNow.SetData(DataLast);
end;

procedure TSctvar.Initialize;
begin
  if FDataNow <> nil Then FDataNow.Free;
  if FDataLast <> nil Then FDataLast.Free;
  FDataNow := nil;
  FDataLast := nil;

  Initialized := True;

  case DataType of
    dtypeString:
      begin
        FDataNow := TSctString.Create;
        FDataLast := TSctString.Create;
      end;
    dtypeFloat:
      begin
        FDataNow := TSctFloat.Create;
        FDataLast := TSctFloat.Create;
      end;
    dtypeInteger:
      begin
        FDataNow := TSctInteger.Create;
        FDataLast := TSctInteger.Create;
      end;
    dtypeDateTime:
      begin
        FDataNow := TSctDateTime.Create;
        FDataLast := TSctDateTime.Create;
      end;
    dtypeBoolean:
      begin
        FDataNow := TSctBoolean.Create;
        FDataLast := TSctBoolean.Create;
      end;
    dtypeBlob:
      begin
        FDataNow := TSctBlob.Create;
        FDataLast := TSctBlob.Create;
      end;
    dtypeMemo:
      begin
        FDataNow := TSctMemo.Create;
        FDataLast := TSctMemo.Create;
      end;
    dtypeGraphic:
      begin
        FDataNow := TSctGraphic.Create;
        FDataLast := TSctGraphic.Create;
      end;
    dtypeUnknown:
      begin
        FDataNow := TSctUnknown.Create;
        FDataLast := TSctUnknown.Create;
        Initialized := False;
      end;
  end;
  if (csDesigning in ComponentState) And Not Running Then UpdateMode := umNeedUpdate;
end;

procedure TSctvar.UpdateData;
begin
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;
    { updating }
    UpdateMode := umNoUpdate;
  end;
end;

procedure TSctvar.ResetData;
begin
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;
    FDataNow.Reset;
    FDataNow.IsNull := True;
    UpdateMode := umNoUpdate;
  end;
end;

function TSctVar.getIsNull: Boolean;
begin
  result := DataNow.IsNull;
end;
procedure TSctVar.SetIsNull(n: Boolean);
begin
  DataNow.IsNull := n;
end;

function TSctvar.GetDataNow: TSctData;
begin
  if UpdateMode = umNeedUpdate Then UpdateData;
  result := FDataNow;
end;

function TSctvar.GetData: TSctData;
begin
  result := DataNow;
end;

function TSctvar.GetAsString: String;
begin
  result := Data.AsString;
end;

function TSctvar.GetAsInteger: Integer;
begin
  result := Data.AsInteger;
end;

function TSctvar.GetAsFloat: Double;
begin
  result := Data.AsFloat;
end;

function TSctvar.GetAsDateTime: TDateTime;
begin
  result := Data.AsDateTime;
end;

function TSctvar.GetAsBoolean: Boolean;
begin
  result := Data.AsBoolean;
end;

function TSctvar.GetAsStream: TStream;
begin
  result := Data.AsStream;
end;
function TSctvar.GetAsStrings: TStrings;
begin
  result := Data.AsStrings;
end;

procedure TSctvar.SetAsString( value: String);
begin
  DataNow.AsString := value;
end;
procedure TSctvar.SetAsInteger( value: Integer);
begin
  DataNow.AsInteger := value;
end;
procedure TSctvar.SetAsFloat( value: Double);
begin
  DataNow.AsFloat := value;
end;
procedure TSctvar.SetAsDateTime( value: TDateTime);
begin
  DataNow.AsDateTime := value;
end;
procedure TSctvar.SetAsBoolean( value: Boolean);
begin
  DataNow.AsBoolean := Value;
end;
procedure TSctvar.SetAsStream( value: TStream);
begin
  DataNow.AsStream := value;
end;
procedure TSctVar.SetAsStrings( Value: TStrings);
begin
  DataNow.AsStrings := Value;
end;

function TSctvar.GetDataType: TSctDataTypes;
begin
  Result := FDataType;
end;

procedure TSctVar.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('AutoVar', readautovar, writeautovar, True);
  Filer.DefineProperty('ID', readid, writeid, True);
end;
procedure TSctVar.ReadAutoVar(Reader: TReader);
begin
  FAutoVar := Reader.ReadBoolean;
end;
procedure TSctVar.WriteAutoVar( Writer: TWriter);
begin
  Writer.WriteBoolean(FAutoVar);
end;
procedure TSctVar.ReadID(Reader: TReader);
var
  S: String;
begin

  S := Reader.ReadIDent;
  if CompareText('vidAbstract', S) = 0 then FID := vidAbstract
  else if CompareText('vidDBVar', S) = 0 then FID := vidDBVar
  else if CompareText('vidExprVar', S) = 0 then FID := vidExprVar
  else if CompareText('vidTotalVar', S) = 0 then FID := vidTotalVar
  else if CompareText('vidAutoDataVar', S) = 0 then FID := vidAutoDataVar
  else if CompareText('vidDateTimeVar', S) = 0 then FID := vidDateTimeVar
  else if CompareText('vidPageVar', S) = 0 then FID := vidPageVar
  else raise Exception.Create('Cannot find ' + S + ' in TSctVarId');
end;
procedure TSctVar.WriteID( Writer: TWriter);
var
  S: String;
begin
  case FID of
    vidAbstract: S := 'vidAbstract';
    vidDBVar: S := 'vidDBVar';
    vidExprVar: S := 'vidExprVar';
    vidTotalVar: S := 'vidTotalVar';
    vidAutoDataVar: S := 'vidAutoDataVar';
    vidDateTimeVar: S := 'vidDateTimeVar';
    vidPageVar: S := 'vidPageVar';
  end;
  Writer.WriteIDent(S);
end;

{$ifdef AceBDE}
{ TSctdbvar }
constructor TSctdbvar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
{  FDataLink.Control := Self;} { Don't know if I need }
  FDataLink.OnActiveChange := ActiveChange;
  Id := vidDBVar;
  FActive := False;
{  FField := nil;}
  FFieldNo := -1;
end;

destructor TSctdbvar.Destroy;
begin
  if FDataLink <> nil then FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TSctdbvar.Initialize;
var
  Spot: Integer;
  MyField: TField;
begin
  Active := False;
{  FField := nil;}
  if (DataSource <> nil) And (DataSource.DataSet <> nil) Then
  begin
    try
      if Running then
      begin
        Active := TSctGroupPage(Parent).DataSourceManager.ActivateDataSource(DataSource);
      end else Active := DataSource.DataSet.Active;
      
      if Active then
      begin
        MyField := DataSource.DataSet.FindField(FDataField);
        FFieldNo := -1;
        if MyField <> nil then
        begin
          Spot := 0;
          while Spot < DataSource.DataSet.FieldCount do
          begin
            if DataSource.DataSet.Fields[Spot] = MyField then
            begin
              FFieldNo := Spot;
              Spot := DataSource.DataSet.FieldCount;
            end;
            Inc(Spot);
          end;
        end;
      end;
    except
    end;
  end;
  inherited Initialize;
end;

function TSctDbVar.GetFieldDataType: TFieldType;
var
  fd: TFieldDef;
begin
  result := ftUnknown;
  if Field = nil then
  begin
    if (FDataField <> '') And (DataSource <> nil) And (DataSource.DataSet <> nil) then
    begin
      with DataSource.Dataset do
      begin
        try
          fd := FieldDefs.Find(FDataField);
        except
          fd := nil;
        end;
        if fd <> nil then result := fd.DataType;
      end;
    end;
  end else result := Field.DataType;
end;

procedure TSctdbvar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TSctdbvar.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TSctdbvar.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

function TSctdbvar.GetDataField: string;
begin
  Result := FDataField;
end;

procedure TSctdbvar.SetDataField(const Value: string);
begin
  FDataField := Value;
  FDataLink.FieldName := Value;
end;

function TSctdbvar.GetField: TField;
begin
  if FFieldNo = -1 then Result := nil
  else Result := FDataLink.Field;
{  Result := FField;}
end;

procedure TSctdbvar.ActiveChange(Sender: TObject);
begin
  FActive := Not FActive;
  if FActive then Initialize
  else
  begin
    FFieldNo := -1;
    Reset;
  end;
end;
procedure TSctdbvar.UpdateData;
var
  S: String;
  I: LongInt;
  F: Double;
  D: TDateTime;
  B: Boolean;

  dbmemo: TDbMemo;
begin
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;
    if Field = nil then FDataNow.Reset
    else
    begin
      if Field.IsNull And
        Not ((Field.DataSet.ClassName = 'TTable')
             And (GetOrdProp(Field.DataSet,GetPropInfo(Field.DataSet.ClassInfo,'TableType')) = 4{value for ttAscii} ))
      then begin
        FDataNow.Reset;
        FDataNow.IsNull := True;
      end else
      begin
        FDataNow.IsNull := False;
        try
          case Field.DataType of
          ftString {$ifdef VCL120PLUS},ftFixedChar{$endif}:
            begin
              S := Field.AsString;
              FDataNow.SetValue( S );
            end;
          ftInteger, ftSmallInt, ftWord:
            begin
              I := Field.AsInteger;
              FDataNow.SetValue( I );
            end;
          ftFloat, ftCurrency, ftBCD:
            begin
              if Field.IsNull then F := 0.0
              else F := Field.AsFloat;
              FDataNow.AsFloat := F;
            end;
          ftDateTime, ftDate, ftTime:
            begin
              if Field.IsNull then D := 0.0
              else D := Field.AsDateTime;
              FDataNow.AsDateTime := D;
            end;
          ftBoolean:
            begin
              B := Field.AsBoolean;
              FDataNow.SetValue( B );
            end;
          ftBlob, ftMemo, ftGraphic {$ifdef VCL120PLUS},ftWideString{$endif}:
            begin
              FDataNow.Reset;
              if (Field.Datatype = ftMemo)
                {$ifdef VCL120PLUS}or (Field.Datatype = ftWideString) {$endif} then
              begin
                dbmemo := TDBMemo.Create(nil);
                dbMemo.Parent := AceMemoU.GForm;
                dbMemo.Visible := False;
                dbmemo.DataSource := DAtaSource;
                dbmemo.DataField := DataField;
                dbmemo.lines.SAveToStream(FDataNow.AsStream);
                dbmemo.Parent := nil;
                dbmemo.free;
              end else
              begin
                TBlobField(Field).SaveToStream( FDataNow.AsStream );
                end;
              end;
          ftUnknown:
            begin
              FDataNow.Reset;
            end;
        {$ifdef WIN32}

           ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary: