sctvar.pas

suite component ace report

            begin
              FDataNow.Reset;
              TBlobField(Field).SaveToStream( FDataNow.AsStream );
            end;
          ftAutoInc:
            begin
              I := Field.AsInteger;
              FDataNow.SetValue( I );
            end;
         {$endif}
          end;
        except
          FDataNow.Reset;
        end;
      end;
    end;
    UpdateMode := umNoUpdate;
  end;
end;

function TSctdbvar.GetDataType: TSctDataTypes;
begin
  Result := dtypeUnknown;
  if Field <> nil then
  begin
    case Field.DataType of
      ftString: result := dtypeString;
      ftInteger, ftSmallInt, ftWord: result := dtypeInteger;
      ftFloat,ftCurrency,ftBCD: result := dtypeFloat;
      ftDateTime, ftDate, ftTime: result := dtypeDateTime;
      ftBoolean: result := dtypeBoolean;
      ftBlob: result := dtypeBlob;
      ftMemo: result := dtypeMemo;
      ftGraphic: result := dtypeGraphic;
      {$ifdef WIN32}
        ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary: result := dtypeBlob;
        ftAutoInc: result := dtypeInteger;
      {$endif}
      {$ifdef VCL120PLUS}
         ftWideString: result := dTypeMemo;
         ftFixedChar: result := dTypeString;
         {unknown: ftLargeInt, ftADT, ftArray, ftReference, ftDataSet}
      {$endif}
      {$ifdef VCL130PLUS}
         {unknown: ftOraBlob, ftOraClob, ftVariant, ftInterface, ftIDispatch, ftGuid}
      {$endif}
    end;
  end;
end;
{$endif}


{ TSctExprvar }
constructor TSctExprvar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Id := vidExprVar;
  if csDesigning in ComponentState then Active := False
  else Active := True;
end;

destructor TSctExprvar.Destroy;
begin
  inherited Destroy;
end;

procedure TSctExprvar.UpdateData;
begin
  if UpdateMode = umUpdating Then
       raise Exception.Create(FMTLoadStr(SCT_ECircleReference, [name]));
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;
    if FDataNow = nil Then
      raise Exception.Create(FMTLoadStr(SCT_EDataTypeBad,[name]));
{    FDataNow.IsNull := False;}
    if Assigned(FOnGetData) then
    begin
      FDataNow.Reset;
      FOnGetData(self);
    end;

    UpdateMode := umNoUpdate;
  end;
end;


{ TSctDateTimeVar }
constructor TSctDateTimeVar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Id := vidDateTimeVar;
  DataType := dtypeDateTime;
  Active := True;
end;

procedure TSctDateTimeVar.Initialize;
var
  D: TDateTime;
begin
  inherited Initialize;
  D := Now;
  FDataNow.SetValue( D );
  updatelast; { copy datanow to datalast }
end;

procedure TSctDateTimeVar.Loaded;
begin
  if updatelevel = nil Then
  begin
    if parent is TSctGrouppage Then
    begin
      updatelevel := TSctGrouppage(parent).Head.Updatelevel;
    end;
  end;
  inherited Loaded;
end;

{ TSctPageVar }
constructor TSctPageVar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Id := vidPageVar;
  DataType := dtypeInteger;
  Active := True;
end;

procedure TSctPageVar.Loaded;
begin
  if updatelevel = nil Then
  begin
    if parent is TSctGrouppage Then
    begin
      updatelevel := TSctGrouppage(parent).PageHead.Updatelevel;
    end;
  end;
  inherited Loaded;
end;

procedure TSctPageVar.UpdateData;
var
  Value: LongInt;
begin
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;
    Value := FDataNow.AsInteger + 1;
    FDataNow.SetValue( Value );
    UpdateMode := umNoUpdate;
  end;
end;


{ TSctTotalvar }
constructor TSctTotalvar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataNowList := nil;
  FDataLastList := nil;
  FResetNowList := nil;
  FResetLastList := nil;
  Id := vidTotalVar;
  FIgnoreNulls := False;
end;

destructor TSctTotalvar.Destroy;
begin
  DeleteLevels;
  inherited Destroy;
end;

function TSctTotalvar.getactive: Boolean;
begin
  if Variable <> nil Then result := Variable.Active
  else result := False;
end;

procedure TSctTotalvar.Notification(AComponent: TComponent;
      Operation: TOperation);
begin
  Inherited Notification(AComponent, Operation);
  if (AComponent is TSctvar) Then
  begin
    if (Operation = opRemove) And (TSctvar(AComponent) = Variable) Then
      Variable := nil;
  end;

end;

procedure TSctTotalvar.SetVariable(v: TSctvar);
begin
  if FVariable <> v then
  begin
    FVariable := v;
    if Parent <> nil then TSctGroupPage(Parent).VarChanged;
  end;
end;

function TSctTotalvar.GetDataType: TSctDataTypes;
begin
  Result := dtypeFloat;
end;

procedure TSctTotalvar.Initialize;
var
  Pos: Integer;
begin
  AddLevels;
  for Pos := 0 to (DataNowList.Count - 1) do
  begin
    TSctFloat(DataNowList.Items[Pos]).reset;
    TSctFloat(DataLastList.Items[Pos]).reset;
    ResetNowList.items[pos] := Pointer(False);
    ResetLastList.items[pos] := Pointer(False);
  end;
  if (csDesigning in ComponentState) And Not Running Then UpdateMode := umNeedUpdate;
  Initialized := True;
end;

procedure TSctTotalvar.UpdateData;
var
  Pos: Integer;
  F: Double;
  IsNullValue: Boolean;
begin
  IsNullValue := False;
  if UpdateMode = umUpdating Then
       raise Exception.Create(FMTLoadStr(SCT_ECircleReference,[name]));
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;
    if csDesigning in ComponentState Then
    begin
      if (Variable = nil) Then F := 0
      else
      begin
        if Not Variable.Initialized then Variable.Initialize;
        if (Not Variable.Active) Then F := 0
        else
        begin
          IsNullValue := Variable.IsNull;
          if Variable.DataType in [dtypeFloat, dtypeInteger] then F := Variable.AsFloat
          else if Variable.DataType = dtypeBoolean then                {****NEW}
                      if Variable.AsBoolean then F := 1 else F:= 0     {****NEW}
               else F := 0;
        end;
      end;
    end else
    begin
      if Variable <> nil then
      begin
{        if Variable.updatelevel = updatelevel Then
        begin}
          IsNullValue := Variable.IsNull;
          if Variable.DataType in [dtypeFloat, dtypeInteger] then F := Variable.AsFloat
          else if Variable.DataType = dtypeBoolean then                {****NEW}
                      if Variable.AsBoolean then F := 1 else F:= 0     {****NEW}
               else F := 0;
{        end;}
      end else
      begin
        F := 0;
      end;
    end;
    for Pos := 0 to (DataNowList.Count - 1) do
    begin
      { reset the level if it is marked for reset }
      if Boolean(ResetNowList.items[pos]) then
      begin
        TSctFloat(DataNowList.Items[pos]).reset;
        ResetNowList.items[pos] := Pointer(False);
      end;

      { don't update any header variables }
      if Not TSctLevel( TSctPage(Parent).Levels.Items[pos] ).IsHeader Then
      begin
        if Not (FIgnoreNulls And IsNullValue) then
          TSctFloat(DataNowList.Items[Pos]).SetValue(F);
      end;
    end;
    UpdateMode := umNoUpdate;
  end;
end;

procedure TSctTotalVar.ResetMarkedLevel(Level: TSctLevel);
begin
  { reset the level if it is marked for reset }
  if Boolean(ResetNowList.items[Level.Level]) then
  begin
    TSctFloat(DataNowList.Items[Level.Level]).reset;
    ResetNowList.items[Level.Level] := Pointer(False);
  end;
end;

procedure TSctTotalVar.ResetData;
var
  pos: Integer;
begin
  if UpdateMode = umNeedUpdate Then
  begin
    UpdateMode := umUpdating;

    for Pos := 0 to (DataNowList.Count - 1) do
    begin
      { reset the level if it is marked for reset }
      if Boolean(ResetNowList.items[pos]) then
      begin
        TSctFloat(DataNowList.Items[pos]).reset;
        ResetNowList.items[pos] := Pointer(False);
      end;
    end;

    UpdateMode := umNoUpdate;
  end;
end;

procedure TSctTotalvar.resetlevel(level: TSctLevel);
begin
  ResetNowList.items[level.level] := Pointer(True);

{  TSctFloat(DataNowList.Items[level.level]).reset;
  TSctFloat(DataLastList.Items[level.level]).reset;}
end;

procedure TSctTotalvar.ResetAtlevel(level: TSctLevel);
begin
  TSctFloat(DataNowList.Items[level.level]).reset;
end;

procedure TSctTotalvar.Updatelast;
var
  Pos: Integer;
begin
  for Pos := 0 to (DataNowList.Count - 1) do
  begin
    TSctFloat(DataLastList.Items[Pos]).SetData( TSctFloat(DataNowList.Items[Pos]) );
    ResetLastList.items[pos] := ResetNowList.items[pos];
  end;
end;

procedure TSctTotalvar.ReverseUpdate;
var
  Pos: Integer;
begin
  for Pos := 0 to (DataNowList.Count - 1) do
  begin
    TSctFloat(DataNowList.Items[Pos]).SetData( TSctFloat(DataLastList.Items[Pos]) );
    ResetNowList.items[pos] := ResetLastList.items[pos];
  end;
end;

procedure TSctTotalvar.UpdateAtlevel(level: TSctLevel);
begin
  TSctFloat(DataLastList.Items[level.level]).SetData( TSctFloat(DataNowList.Items[level.level]) );
end;


function TSctTotalvar.Getlevel(level: TSctLevel; totaltype: TSctTotalType): TSctFloat;
begin
  result := getlevelnow(level, totaltype);
end;

function TSctTotalvar.GetlevelNow(level: TSctLevel; totaltype: TSctTotalType): TSctFloat;
begin

  if UpdateMode = umNeedUpdate Then UpdateData;

  { this sets the type of data that needs to be returned }
  TSctFloat(DataNowList.items[level.level]).TotalType := totaltype;
  result := DataNowList.items[level.level];
end;

function TSctTotalvar.GetDataNow: TSctData;
begin
{  result := nil;}
  raise Exception.Create(FMTLoadStr(SCT_ETotalAccess, [name]));
end;

function TSctTotalvar.getlevellast(level: TSctLevel; totaltype: TSctTotalType): TSctFloat;
begin
  { this sets the type of data that needs to be returned }
  TSctFloat(DataLastList.items[level.level]).TotalType := totaltype;
  result := DataLastList.items[level.level];
end;

procedure TSctTotalvar.AddLevels;
var
  Pos: Integer;
begin
  DeleteLevels;

  DataNowList := TList.Create;
  DataLastList := TList.Create;
  ResetNowList := TList.Create;
  ResetLastList := TList.Create;
  for Pos := 1 to TSctPage(Parent).Levels.Count do
  begin
    DataNowList.Add(TSctFloat.Create);
    DataLastList.Add(TSctFloat.Create);
    ResetNowList.Add(Pointer(False));
    ResetLastList.Add(Pointer(False));
  end;
end;

procedure TSctTotalvar.DeleteLevels;
var
  Pos: Integer;
begin
  if DataNowList <> nil Then
  begin
    for Pos := 0 to (FDataNowList.Count - 1) Do
         TSctFloat(FDataNowList.Items[Pos]).Free;
    FDataNowList.Free;
    FDataNowList := nil;
  end;
  if DataLastList <> nil Then
  begin
    for Pos := 0 to (FDataLastList.Count - 1) Do
         TSctFloat(FDataLastList.Items[Pos]).Free;
    FDataLastList.Free;
    FDataLastList := nil;
  end;
  if ResetNowList <> nil then ResetNowList.Free;
  if ResetLastList <> nil then ResetLastList.Free;
end;

procedure TSctTotalVar.Reset;
begin
end;


{$IFDEF WIN32}
  {$WARNINGS ON}
{$ENDIF}


end.