sttxtdat.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

  Temp, FieldVal : AnsiString;
  Fields : TStringList;
  Idx : Integer;
  DataField : TStDataField;
begin
  if (Index < -1) or (Index > Pred(FSchema.FieldCount)) then
    raise EStException.CreateResTP(stscBadIndex, 0);

  { get characteristics of the field of interest }
  DataField := FSchema.Fields[Index];
  Len := DataField.FieldLen;
  Offset := DataField.FFieldOffset;

  Temp := '';

  case FSchema.LayoutType of
    ltFixed   : begin
      for Idx := 0 to Pred(FSchema.FieldCount) do begin
        if Idx = Index then begin
          { replace field with Value right buffered or trimmed to to fit field length }
          if Length(NewValue) < Len then
            FieldVal := PadChL(NewValue, FSchema.FFixedSeparator, Len)   {!!.01}
          else
            FieldVal := Copy(NewValue, 1, Len);

          { note: Offset is zero based, strings are 1 based }
          Move(FieldVal[1], FValue[Offset + 1], Len);
        end;
      end;
    end;

    ltVarying : begin
      Fields := TStringList.Create;
      try
        { parse out the field values }
        ExtractTokensL(FValue, FSchema.FFieldDelimiter,                  {!!.01}
          FSchema.QuoteDelimiter, True, Fields);                         {!!.01}


{!!.02 - rewritten }
//        { find field of interest }
//        for Idx := 0 to Pred(FSchema.FieldCount) do begin
//          if Idx = Index then
//            { set the new value }
//            Fields[Idx] := NewValue;

          { set field of interest }
          Fields[Index] := NewValue;

          { reconstruct the record }
          BuildRecord(Fields, FValue);
//        end;
{!!.02 - rewritten end }

      finally
        Fields.Free;
      end;
    end;

    ltUnknown : begin
      raise EStException.CreateResTP(stscTxtDatInvalidSchema, 0);
    end;
  end; {case}
end;

procedure TStTextDataRecord.SetQuoteAlways(const Value: Boolean);
begin
  FQuoteAlways := Value;
end;

procedure TStTextDataRecord.SetQuoteIfSpaces(const Value: Boolean);
begin
  FQuoteIfSpaces := Value;
end;

procedure TStTextDataRecord.SetSchema(const Value: TStTextDataSchema);
begin
  FSchema := Value;
end;

{!!.02 - Added }
function TStTextDataRecord.GetRecord: AnsiString;
var
  Idx : Integer;
  Field : AnsiString;
begin
  Result := '';
  for Idx := 0 to (FSchema.FieldCount - 2) do begin
    Field := self.Fields[Idx];
    DoQuote(Field);
    Result := Result + Field + FSchema.FFieldDelimiter;
  end;
  Field := self.Fields[FSchema.FieldCount-1];
  DoQuote(Field);
  Result := Result + Field;
end;
{!!.02 - End Added }

{ TStTextDataRecordSet }

(*
TStLineTerminator = ( {possible line terminators...}
   ltNone,            {..no terminator, ie fixed length lines}
   ltCR,              {..carriage return (#13)}
   ltLF,              {..line feed (#10)}
   ltCRLF,            {..carriage return/line feed (#13/#10)}
   ltOther);          {..another character}
*)

constructor TStTextDataRecordSet.Create;
begin
  inherited Create;
  FCurrentIndex := 0;
  FRecords := TList.Create;
  FIsDirty := False;
  FAtEndOfFile := False;                    {!!.01}
  FIgnoreStartingLines := 0;                                           {!!.02}
end;

destructor TStTextDataRecordSet.Destroy;
begin
  FRecords.Free;
  inherited Destroy;
end;

procedure TStTextDataRecordSet.Append;
{ append new empty record to dataset }
var
  Rec : TStTextDataRecord;
begin
  Rec := TStTextDataRecord.Create;
  Rec.Schema := Schema;
  Rec.MakeEmpty;
  FRecords.Add(Rec);
  FIsDirty := True;
  Last;
end;

procedure TStTextDataRecordSet.AppendArray(Values : array of const);
{ append new record to dataset, set field values from a variant open array }
begin
  Append;
  CurrentRecord.FillRecordFromArray(Values);
end;

procedure TStTextDataRecordSet.AppendList(Items: TStrings);
{ append new record to dataset, set field values from <NAME>=<VALUE> pairs}
begin
  Append;
  CurrentRecord.FillRecordFromList(Items);
end;

procedure TStTextDataRecordSet.AppendValues(Values: TStrings);
{ append new record to dataset, set field values from TStrings}
begin
  Append;
  CurrentRecord.FillRecordFromValues(Values);
end;

function TStTextDataRecordSet.BOF: Boolean;
{ test if at beginning of record set }
begin
  Result := (FCurrentIndex = 0);
end;

procedure TStTextDataRecordSet.Clear;
{ empty record set }
var
  i : Integer;
begin
  for i := 0 to Pred(FRecords.Count) do
    TStTextDataRecord(FRecords[i]).Free;
  FRecords.Clear;
  FIsDirty := False;
end;

procedure TStTextDataRecordSet.Delete;
{ delete record at current position }
begin
  TStTextDataRecord(FRecords[FCurrentIndex]).Free;
  FRecords.Delete(FCurrentIndex);
  FIsDirty := True;
  Next;
end;

function TStTextDataRecordSet.EOF: Boolean;
{ test if at end of record set }
begin
  if FAtEndOfFile then                                          {!!.01}
    FAtEndOfFile := FCurrentIndex = Pred(FRecords.Count);       {!!.01}
  Result := FAtEndOfFile                                        {!!.01}
end;

procedure TStTextDataRecordSet.First;
{ make first record in set current }
begin
  FCurrentIndex := 0;
end;

function TStTextDataRecordSet.GetCount: Integer;
{ return count of records in set }
begin
  Result := FRecords.Count;
end;

function TStTextDataRecordSet.GetRecord(Index: Integer): TStTextDataRecord;
{ return particular record by index }
begin
  if (Index > -1) and (Index < FRecords.Count) then
    Result := FRecords[Index]
  else
    raise EStException.CreateResTP(stscBadIndex, 0);
end;

function TStTextDataRecordSet.GetCurrentRecord: TStTextDataRecord;
{ return current record }
begin
  Result := FRecords[FCurrentIndex];
end;

function TStTextDataRecordSet.GetSchema: TStTextDataSchema;
{ return reference to associated schema, create default one if needed }
begin
  if not Assigned(FSchema) then
    FSchema := TStTextDataSchema.Create;
  Result := FSchema;
end;

procedure TStTextDataRecordSet.Insert(Index: Integer);
{ insert new empty record into dataset at specified location,
  shifts the record set down one }
var
  Rec : TStTextDataRecord;
begin
  Rec := TStTextDataRecord.Create;
  Rec.Schema := Schema;
  Rec.MakeEmpty;
  FRecords.Insert(Index, Rec);
  FIsDirty := True;
  FCurrentIndex := Index;
end;

procedure TStTextDataRecordSet.InsertArray(Index: Integer; Values : array of const);
{ insert new record into dataset dataset at specified location,
  shifts the record set down one,
  set field values from a variant open array }
begin
  Insert(Index);
  CurrentRecord.FillRecordFromArray(Values);
end;

procedure TStTextDataRecordSet.InsertList(Index: Integer;
  Items: TStrings);
{ insert new record into dataset dataset at specified location,
  shifts the record set down one,
  set field values from <NAME>=<VALUE> pairs}
begin
  Insert(Index);
  CurrentRecord.FillRecordFromList(Items);
end;

procedure TStTextDataRecordSet.InsertValues(Index: Integer;
  Values: TStrings);
{ insert new record into dataset dataset at specified location,
  shifts the record set down one,
  set field values from TStrings}
begin
  Insert(Index);
  CurrentRecord.FillRecordFromValues(Values);
end;

procedure TStTextDataRecordSet.Last;
{ make final record in set current }
begin
  FCurrentIndex := Pred(FRecords.Count);
end;

procedure TStTextDataRecordSet.LoadFromFile(const AFile: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFile, fmOpenRead or fmShareDenyNone);
  try
    LoadFromStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStTextDataRecordSet.LoadFromStream(AStream: TStream);
var
  TS : TStAnsiTextStream;
  NewRec : TStTextDataRecord;
  i, Len : Integer;                                                   {!!.02}
begin
  if FActive then
    raise EStException.CreateResTP(stscTxtDatRecordSetOpen, 0);

  Clear;

  TS := TStAnsiTextStream.Create(AStream);

  { match Ansi Stream terminator to schema's }
  TS.LineTermChar   := Schema.LineTermChar;
  TS.LineTerminator := Schema.LineTerminator;

{!!.02 - added }
  { calculate length of fixed record }
  if Schema.LayoutType = ltFixed then begin
    Len := 0;
    for i := 0 to Pred(Schema.FieldCount) do
     Len := Len + Schema.Fields[i].FieldLen;
    TS.FixedLineLength := Len;
  end;
{!!.02 - added end }

  try
{!!.02 - added }
    { ignore starting lines }
    for i := 1 to FIgnoreStartingLines do
      TS.ReadLine;
{!!.02 - added end }

    while not TS.AtEndOfStream do begin
      { new record }
      NewRec := TStTextDataRecord.Create;

      { set record data }
      NewRec.FValue := TS.ReadLine;

{!!.01 - Rewritten }
      if TrimCharsL(NewRec.FValue, St_WhiteSpace) <> '' then begin
        { set the schema to match }
        NewRec.Schema := Schema;

        { append new record }
        FRecords.Add(NewRec);

      end
      else {ignore blank lines}
        NewRec.Free;
{!!.01 - End Rewritten }
    end;


    FActive := True;
    FIsDirty := False;
  finally
    TS.Free;
  end;
end;

function TStTextDataRecordSet.Next : Boolean;
{ make next record in set current }
begin
  Result := True;

  { if already on last record, stay there }
  if FCurrentIndex = Pred(FRecords.Count) then begin          {!!.01}
    FAtEndOfFile := True; { yep, we're at the end }           {!!.01}
    Result := False;                                          {!!.01}
  end                                                         {!!.01}
  else                                                        {!!.01}
    Inc(FCurrentIndex);                                       {!!.01}
end;

function TStTextDataRecordSet.Prior : Boolean;
{ make previous record in set current }
begin
  Result := True;
  Dec(FCurrentIndex);

  { if already on first record, stay there }
  if FCurrentIndex < 0 then begin
    FCurrentIndex := 0;
    Result := False;
  end;
end;

procedure TStTextDataRecordSet.SaveToFile(const AFile: TFileName);
var
  FS : TFileStream;
begin
  if not FileExists(AFile) then begin
    FS := TFileStream.Create(AFile, fmCreate);
    FS.Free;
  end;

  FS := TFileStream.Create(AFile, fmOpenWrite or fmShareDenyNone);

  try
    SaveToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStTextDataRecordSet.SaveToStream(AStream: TStream);
var
  TS : TStAnsiTextStream;
  i : Integer;
begin
  TS := TStAnsiTextStream.Create(AStream);

  { match Ansi Stream terminator to schema's }
  TS.LineTermChar   := Schema.LineTermChar;
  TS.LineTerminator := Schema.LineTerminator;

  { write the records }
  try
    for i := 0 to Pred(FRecords.Count) do
      TS.WriteLine(TStTextDataRecord(FRecords[i]).AsString);

    FIsDirty := False;
  finally
    TS.Free;
  end;
end;

procedure TStTextDataRecordSet.SetActive(const Value: Boolean);
{ activate or close record set }
begin
  FActive := Value;
  if not FActive then begin
    Clear;
    FSchema := nil;
  end;
end;

procedure TStTextDataRecordSet.SetCurrentRecord(
  const Value: TStTextDataRecord);
begin
  TStTextDataRecord(FRecords[FCurrentIndex]).Free;
  FRecords.Insert(FCurrentIndex, Value);
  FIsDirty := True;
end;

procedure TStTextDataRecordSet.SetRecord(Index: Integer;
  const Value: TStTextDataRecord);
begin
  TStTextDataRecord(FRecords[Index]).Free;
  FRecords.Insert(Index, Value);
  FIsDirty := True;
end;

procedure TStTextDataRecordSet.SetSchema(const Value: TStTextDataSchema);
{ assign new schema, only works on inactive record set }
begin
  if not FActive then begin
    if Assigned(FSchema) then
      FSchema.Free;
      FSchema := Value;
  end
  else
    raise EStException.CreateResTP(stscTxtDatRecordSetOpen, 0);
end;



end.