sttxtdat.pas

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

{
Format :
  <name>,<type>,<width>,<decimals>,<offset>
}
var
  CommaPos, LastPos : Cardinal;
  TempS : AnsiString;
begin
  CommaPos := 1;
  LastPos := CommaPos;
  CommaPos := CharPosIdx(',', Source, CommaPos);
  if CommaPos = 0 then CommaPos := Length(Source) + 1;
  Name := Copy(Source, LastPos, CommaPos - LastPos);

  Inc(CommaPos);
  LastPos := CommaPos;
  CommaPos := CharPosIdx(',', Source, CommaPos);
  if CommaPos = 0 then CommaPos := Length(Source) + 1;
  TempS := Copy(Source, LastPos, CommaPos - LastPos);
  FieldType := StStrToFieldType('sft' + TempS);

  Inc(CommaPos);
  LastPos := CommaPos;
  CommaPos := CharPosIdx(',', Source, CommaPos);
  if CommaPos = 0 then CommaPos := Length(Source) + 1;
  ValLen := StrToInt(Copy(Source, LastPos, CommaPos - LastPos));

  Inc(CommaPos);
  LastPos := CommaPos;
  CommaPos := CharPosIdx(',', Source, CommaPos);
  if CommaPos = 0 then CommaPos := Length(Source) + 1;
  Decimals := StrToInt(Copy(Source, LastPos, CommaPos - LastPos));

  Inc(CommaPos);
  LastPos := CommaPos;
  CommaPos := CharPosIdx(',', Source, CommaPos);
  if CommaPos = 0 then CommaPos := Length(Source) + 1;
  Offset := StrToInt(Copy(Source, LastPos, CommaPos - LastPos));
end;

constructor TStDataFieldList.Create;
begin
  inherited Create;
  FList := TStringList.Create;
end;

destructor TStDataFieldList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TStDataFieldList.AddField(const FieldName: AnsiString;
  FieldType: TStSchemaFieldType; FieldLen, FieldDecimals, FieldOffset: Integer);
var
  Item : TStDataField;
  Idx : Integer;
begin
  { see if another field with the name exists }
  Idx := FList.IndexOf(FieldName);
  if (Idx > -1) then
    raise EStException.CreateResTP(stscTxtDatUniqueNameRequired, 0);

  { build new item }
  Item := TStDataField.Create;
  try
    Item.FieldName := FieldName;
    Item.FieldType := FieldType;
    Item.FieldLen := FieldLen;
    Item.FieldDecimals := FieldDecimals;
    Item.FieldOffset := FieldOffset;

    { add to list }
    FList.AddObject(FieldName, Item);
  except
    Item.Free;
  end;
end;

procedure TStDataFieldList.AddFieldStr(const FieldDef: AnsiString);
var
  Name: AnsiString;
  FieldType: TStSchemaFieldType;
  ValLen, Decimals, Offset: Integer;
begin
  SplitFieldStr(FieldDef, Name, FieldType, ValLen, Decimals, Offset);
  AddField(Name, FieldType, ValLen, Decimals, Offset);
end;

procedure TStDataFieldList.Clear;
var
  Idx : Integer;
begin
  for Idx := Pred(FList.Count) downto 0 do begin
    { Free associated object and then delete the StringList entry }
    FList.Objects[Idx].Free;
    FList.Delete(Idx);
  end;
end;

procedure TStDataFieldList.RemoveField(const FieldName: AnsiString);
var
  Idx : Integer;
begin
  { locate field }
  Idx := FList.IndexOf(FieldName);

  { if it exists }
  if Idx > -1 then begin
    { Free associated object and then delete the StringList entry }
    FList.Objects[Idx].Free;
    FList.Delete(Idx);
  end
  else
    { no such field, complain... }
    raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
end;

function TStDataFieldList.GetFieldByName(
  const FieldName: AnsiString): TStDataField;
var
  Idx : Integer;
begin
  { locate field }
  Idx := FList.IndexOf(FieldName);

  { if it exists }
  if Idx > -1 then begin
    { return associated object }
    Result := TStDataField(FList.Objects[Idx]);
  end
  else
    { no such field, complain... }
    raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
end;

function TStDataFieldList.GetField(Index: Integer): TStDataField;
{ return requested field if in range }
begin
  if (Index > -1) and (Index < FList.Count) then
    Result := TStDataField(FList.Objects[Index])
  else
    { no such field, complain... }
    raise EStException.CreateResTP(stscBadIndex, 0);
end;

procedure TStDataFieldList.SetFieldByName(const FieldName: AnsiString;
  const Value: TStDataField);
var
  Idx : Integer;
begin
  { see if another field with the name exists }
  Idx := FList.IndexOf(FieldName);

  { delete field at that index replace with new field }
  if (Idx > -1) then begin
    FList.Objects[Idx].Free;
    FList.Objects[Idx] := Value;
  end
  else
    { no such field, complain... }
    raise EStException.CreateResTP(stscTxtDatNoSuchField, 0);
end;

procedure TStDataFieldList.SetField(Index: Integer;
  const Value: TStDataField);
var
  Idx : Integer;
begin
  { see if another field with the name exists }
  Idx := FList.IndexOf(Value.FieldName);
  if (Idx > -1) and (Idx <> Index) then
    raise EStException.CreateResTP(stscTxtDatUniqueNameRequired, 0);

  { delete field at that index replace with new field }
  if (Index > -1) and (Index < FList.Count) then begin
    RemoveField(FList[Index]);
    FList.InsertObject(Index, Value.FieldName, Value);
  end else
    { no such field, complain... }
    raise EStException.CreateResTP(stscBadIndex, 0);
end;


function TStDataFieldList.GetCount: Integer;
{ return count of maintained Field Items }
begin
  Result := FList.Count;
end;


{ TStTextDataSchema }

constructor TStTextDataSchema.Create;
begin
  inherited Create;

  { set default values }
  FFieldDelimiter := StDefaultDelim;
  FQuoteDelimiter := StDefaultQuote;
  FCommentDelimiter := StDefaultComment;
  FFixedSeparator   := StDefaultFixedSep;                           {!!.01}
  FLineTermChar := #0;
  FLineTerminator := ltCRLF;
  FLayoutType := ltUnknown;

  { create internal instances }
  dsFieldList := TStDataFieldList.Create;
  FSchema := TStringList.Create;
end;

destructor TStTextDataSchema.Destroy;
begin
  { clean up the fields list }
  dsFieldList.Clear;

  { free internal instances }
  dsFieldList.Free;
  FSchema.Free;

  inherited Destroy;
end;

procedure TStTextDataSchema.AddField(const FieldName : AnsiString;
  FieldType : TStSchemaFieldType; FieldLen, FieldDecimals : Integer);
{ add new field with requested characteristics }
var
  Offset : Integer;
  LastField : TStDataField;
begin
  { calculate the offset based on the length and offset of previous fields }
  if dsFieldList.Count > 0 then begin
    LastField := dsFieldList.Fields[Pred(dsFieldList.Count)];
    Offset := LastField.FieldOffset + LastField.FieldLen;
  end
  else
    Offset := 0;

  dsFieldList.AddField(FieldName, FieldType, FieldLen, FieldDecimals, Offset);
end;

procedure TStTextDataSchema.Assign(ASchema: TStTextDataSchema);
{ deep copy another schema }
var
  i : Integer;
begin
  if not Assigned(ASchema) then Exit;

  { copy properties }
  FLayoutType           := ASchema.LayoutType;
  FFieldDelimiter       := ASchema.FieldDelimiter;
  FCommentDelimiter     := ASchema.CommentDelimiter;
  FQuoteDelimiter       := ASchema.QuoteDelimiter;
  FSchemaName           := ASchema.SchemaName;
  FLineTermChar         := ASchema.LineTermChar;
  FLineTerminator       := ASchema.LineTerminator;

  { copy fields }
  dsFieldList.Clear;
  for i := 0 to Pred(ASchema.FieldCount) do
    dsFieldList.AddFieldStr(ASchema.Fields[i].AsString);
end;

{!!.01 -- Added }
procedure TStTextDataSchema.BuildSchema(AList : TStrings);
var
  i : Integer;
  Field : TStDataField;
begin
  { put schema name in brackets }
  AList.Add('[' + FSchemaName + ']');

  { layout type }
  if FLayoutType = ltVarying then begin
    AList.Add('FileType=VARYING');
    AList.Add('Separator=' + StDoEscape(FFieldDelimiter));
  end
  else begin
    AList.Add('FileType=FIXED');
    AList.Add('Separator=' + StDoEscape(FFixedSeparator));
  end;

  { other parameters }
  AList.Add('Delimiter=' + StDoEscape(FQuoteDelimiter));
  AList.Add('Comment=' + StDoEscape(FCommentDelimiter));
  AList.Add('CharSet=ASCII');

  { write fields }
  for i := 0 to Pred(dsFieldList.Count) do begin
    Field := dsFieldList.Fields[i];
    AList.Add('Field' + IntToStr(i + 1) + '=' + Field.AsString);
  end;
end;
{!!.01 -- End Added }

{!!.01 -- Added }
procedure TStTextDataSchema.ClearFields;
{ remove field definitions from schema }
var
  i : Integer;
begin
  dsFieldList.Clear;
  for i := Pred(FSchema.Count) downto 0 do
    if Pos('Field', Trim(FSchema[i])) = 1 then
      FSchema.Delete(i);
end;
{!!.01 -- End Added }

function TStTextDataSchema.GetCaptions: TStrings;
begin
  Result := dsFieldList.FList;
end;

function TStTextDataSchema.GetFieldByName(const FieldName: AnsiString): TStDataField;
begin
  Result := dsFieldList.FieldByName[FieldName];
end;

function TStTextDataSchema.GetFieldCount: Integer;
begin
  Result := dsFieldList.Count;
end;

function TStTextDataSchema.GetField(Index: Integer): TStDataField;
begin
  Result := dsFieldList.Fields[Index];
end;

{!!.01 -- Added }
function TStTextDataSchema.GetSchema: TStrings;
begin
  FSchema.Clear;
  BuildSchema(FSchema);
  Result := FSchema;
end;
{!!.01 -- End Added }

function TStTextDataSchema.IndexOf(const FieldName : AnsiString): Integer;
{ return index of field with provided name, returns -1 if no such field is found }
begin
  Result := 0;
  while (Result < dsFieldList.Count) and
//    (dsFieldList.Fields[Result].FieldName <> FieldName) do     {!!.01}
    (AnsiCompareText(dsFieldList.Fields[Result].FieldName,       {!!.01}
      FieldName) <> 0)                                           {!!.01}
  do                                                             {!!.01}
    Inc(Result);
  if Result >= dsFieldList.Count then
    Result := -1;  { not found }
end;

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

function StDoEscape(Delim : AnsiChar): AnsiString;
{
Escapes non-printable characters to Borlandish Pascal "#nnn" constants
}
begin
  if Delim in [#33..#126, #128..#255] then
    Result := Delim
  else
    Result := '#' + IntToStr(Ord(Delim));
end;


function StDeEscape(const EscStr : AnsiString): AnsiChar;
{
converts "escaped" strings of the forms:
 "#nn" Borlandish Pascal numeric character constants
 ^l    Borlandish Pascal control character constants
into equivalent characters, "##" is treated as the '#' character alone

if the string doesn't constitute such an escape sequence, the first
character is returned
}
var
  S : AnsiString;
  C : AnsiChar;
  ChrVal : Byte;
begin
  S := Trim(EscStr);

  { if string doesn't start with escape or it's only one character long
    just return first character }
  if (Length(S) = 1) or ((S[1] <> '#') and (S[1] <> '^')) then begin
    Result := S[1];
    Exit;
  end;

  { treat '##' as escape for '#' and '^^' as escape for '^' }
  if ((S[1] = '#') and (S[2] = '#')) or
     ((S[1] = '^') and (S[2] = '^')) then
  begin
    Result := '#';
    Exit;
  end;

  { otherwise try to handle escaped character }
  case S[1] of
    '#':begin
      ChrVal := StrToIntDef(Copy(S, 2,Length(S)-1), Ord(StDefaultDelim));
      if Chr(ChrVal) in [#1..#126] then
        Result := Chr(ChrVal)
      else
        Result := StDefaultDelim;
    end;

    '^': begin { control character format }
      C := Chr(Ord(S[2]) - $40);
      if C in [^A..^_] then
        Result := C
      else
        Result := StDefaultDelim;
    end;

  else
    Result := S[1];
  end; {case}
end;

procedure TStTextDataSchema.LoadFromStream(AStream: TStream);
var
  TS : TStAnsiTextStream;
begin
  TS := TStAnsiTextStream.Create(AStream);
  try
    FSchema.Clear;                                                    {!!.01}
    while not TS.AtEndOfStream do
      FSchema.Add(TS.ReadLine);
    { code to extract Schema properties moved to Update routine }     {!!.01}
    Update(FSchema);                                                  {!!.01}

  finally
    TS.Free;
  end;
end;

procedure TStTextDataSchema.RemoveField(const FieldName: AnsiString);
begin
  dsFieldList.RemoveField(FieldName);
end;

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

  if FSchemaName = '' then
    FSchemaName := JustNameL(AFileName);