⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tmsutextdelim.pas

📁 TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  Range.Left:=1;
  Range.Top:=1;
  Range.Right:=Workbook.MaxCol;
  Range.Bottom:=Workbook.MaxRow;
{$IFDEF DELPHI2008UP}
  SaveRangeAsTextDelim(OutStream, Workbook, Delim, Range, Encoding);
{$ELSE}
  SaveRangeAsTextDelim(OutStream, Workbook, Delim, Range);
{$ENDIF}
end;


{$IFDEF DELPHI2008UP}
procedure ReadQString(const InStream: TStreamReader; var S: TStringBuilder; var ch: integer);
var
  InQuote: boolean;
begin
  InQuote:=false;
  S.Length := 0;
  while ch >= 0 do
  begin
    ch := InStream.Read;
    if (ch<> Ord('"')) and InQuote then
    begin
      exit;
    end;
    if InQuote or (ch<> Ord('"')) then s.Append(char(ch));
    InQuote:=(ch= Ord('"')) and not InQuote;
  end;
end;

procedure ReadNString(const InStream: TStreamReader; const Delim: Integer; var S: TStringBuilder; var ch: integer);
begin
  s.Length := 0;
  s.Append(char(ch));
  while Ch >= 0 do
  begin
    ch := InStream.Read;
    if (ch=Delim)or (ch=13)or (ch=10) or (ch < 0)  then exit;
    s.Append(char(ch));
  end; //while
end;

procedure LoadFromTextDelim(const InStream: TStream; const Workbook: TExcelFile; const Delim: Char; const FirstRow, FirstCol: integer; const ColumnFormats: array of XLSColumnImportTypes;
                          const Encoding: TEncoding; const DetectBOM: Boolean = false);
var
  Sr: TStreamReader;
  Enc: TEncoding;
begin
  Enc := Encoding;
  if Enc = nil then Enc := TEncoding.ASCII;

  Sr := TStreamReader.Create(InStream, Enc, DetectBOM); //OwnsStream is false, so if won't free the stream.
  try
    LoadFromTextDelim(Sr, Workbook, Delim, FirstRow, FirstCol, ColumnFormats);
  finally
    FreeAndNil(Sr);
  end;
end;

procedure LoadFromTextDelim(const Sr: TStreamReader; const Workbook: TExcelFile; const Delim: Char; const FirstRow, FirstCol: integer; const ColumnFormats: array of XLSColumnImportTypes);

var
  r,c: integer;
  s: TStringBuilder;
  ch: integer;
  bDelim : integer;
begin
  bDelim := ord(Delim);
  r:=FirstRow;
  c:=FirstCol;

  s := TStringBuilder.Create;
  try
    ch := Sr.Read;
    while ch >= 0 do
    begin
      if (ch= Ord('"')) then ReadQString(Sr, s, ch)
      else if (ch=bDelim) then
      begin
        inc(c);
        Ch := Sr.Read;
        continue;
      end
      else if (ch=10) then
      begin
        c:=FirstCol;
        inc(r);
        ch := Sr.Read;
        continue;
      end else if (ch=13) then
      begin
        ch := Sr.Read;
        continue;
      end
      else ReadNString(Sr, bDelim, s, ch);

      if c-FirstCol< Length(ColumnFormats) then
        case ColumnFormats[c-FirstCol] of
          xct_text: Workbook.CellValue[r, c]:=s.ToString;
          xct_skip: begin end;
          else WorkBook.SetCellString(r,c,s.ToString);
        end //case
      else WorkBook.SetCellString(r,c,s.ToString);
    end;
  finally
    FreeAndNil(s);
  end;
end;

{$ELSE}
procedure ReadQString(const InStream: TStream; out S: String; var ch: Char);
var
  InQuote: boolean;
begin
  InQuote:=false;
  s:='';
  while InStream.Position<InStream.Size do
  begin
    InStream.ReadBuffer(ch, SizeOf(ch));
    if (ch<>'"') and InQuote then
    begin
      exit;
    end;
    if InQuote or (ch<>'"') then s:=s+ch;
    InQuote:=(ch='"') and not InQuote;
  end;
end;

procedure ReadNString(const InStream: TStream; const Delim: Char; var S: String; var ch: Char);
begin
  s:=ch;
  while InStream.Position<InStream.Size do
  begin
    InStream.ReadBuffer(ch, SizeOf(ch));
    if (ch=Delim)or (ch=#13)or (ch=#10)  then exit;
    s:=s+ch;
  end; //while
end;

procedure LoadFromTextDelim(const InStream: TStream; const Workbook: TExcelFile; const aDelim: Char; const FirstRow, FirstCol: integer; const ColumnFormats: array of XLSColumnImportTypes);
var
  r,c: integer;
  s: String;
  ch: Char;
  Delim: Char;
begin
  Delim := Char(aDelim);
  r:=FirstRow;
  c:=FirstCol;
  if InStream.Position<InStream.Size then InStream.ReadBuffer(ch, SizeOf(ch));
  while InStream.Position<InStream.Size do
  begin
    if (ch='"') then ReadQString(InStream, s, ch)
    else if (ch=Delim) then
    begin
      inc(c);
      InStream.ReadBuffer(ch, SizeOf(ch));
      continue;
    end
    else if (ch=#10) then
    begin
      c:=FirstCol;
      inc(r);
      InStream.ReadBuffer(ch, SizeOf(ch));
      continue;
    end else if (ch=#13) then
    begin
      InStream.ReadBuffer(ch, SizeOf(ch));
      continue;
    end
    else ReadNString(InStream, Delim, s, ch);

    if c-FirstCol< Length(ColumnFormats) then
      case ColumnFormats[c-FirstCol] of
        xct_text: Workbook.CellValue[r, c]:=s;
        xct_skip: begin end;
        else WorkBook.SetCellString(r,c,s);
      end //case
    else WorkBook.SetCellString(r,c,s);
  end;
end;

{$ENDIF}

{$IFDEF DELPHI2008UP}
procedure SaveAsTextDelim(const OutStream: TStream; const Workbook: TExcelFile; const Delim: Char);
begin
  SaveAsTextDelim(OutStream, Workbook, Delim, TEncoding.ASCII);
end;

procedure SaveRangeAsTextDelim(const OutStream: TStream; const Workbook: TExcelFile; const Delim: Char; const Range: TXlsCellRange);
begin
  SaveRangeAsTextDelim(OutStream, Workbook, Delim, Range, TEncoding.ASCII);
end;

procedure LoadFromTextDelim(const InStream: TStream; const Workbook: TExcelFile; const aDelim: Char; const FirstRow, FirstCol: integer; const ColumnFormats: array of XLSColumnImportTypes);
begin
  LoadFromTextDelim(InStream, Workbook, aDelim, FirstRow, FirstCol, ColumnFormats, nil);
end;
{$ENDIF}


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -