システムデータ形式ではなく、CSV形式がほしい (ID:10805)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

私の場合TStringListを継承したTStringListExクラスを作成しその
プロパティとしてCommaTextExを追加し、そこで対処しています。

フォームにEdit1、Edit2とListBox1、Button1を配置してテスト
してみました。
色々なパターンはチェックし切れていませんが質問にあった文字列は
正常に分解できました。

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
	TStringListEx = class(TStringList)
	private
		{ Private 宣言 }
    function GetCommaTextExSub(const str : string): string;
    function GetCommaTextEx: string;
    procedure SetCommaTextEx(const Value: string);
	public
		{ Public 宣言 }
    property CommaTextEx : string read GetCommaTextEx write SetCommaTextEx;
	end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TStringListEx }

function TStringListEx.GetCommaTextEx: string;
var
  i : Integer;
  s,ss : string;
begin
  ss := '';
  if Count > 0 then begin
    s := Strings[0];
    ss := GetCommaTextExSub(s);
    for i := 1 to Count-1 do begin
      s := Strings[i];
      s := GetCommaTextExSub(s);
      ss := ss + ',' + s;
    end;
  end;
  result := ss;
end;

function TStringListEx.GetCommaTextExSub(const str: string): string;
var
  s : string;
begin
  s :=StringReplace(str,'"','""',[rfreplaceall]);
  if Pos(',',s) <> 0 then begin
    s := '"' + s + '"';
  end;
  result := s;
end;

procedure TStringListEx.SetCommaTextEx(const Value: string);
var
  i : Integer;
  c : Char;
  s : string;
  f,f2 : Boolean;
begin
  Clear;
  f := False;
  f2 := False;
  for i := 1 to Length(Value) do begin
    c := Value[i];
    if c = '"' then begin
      if f2 then begin
        s := s + c;
        f2 := False;
      end
      else begin
        f2 := True;
      end;
      f := not f;
    end
    else if (f = False) and (c = ',') then begin
      Add(s);
      s := '';
      f2 := False;
    end
    else begin
      s := s + c;
      f2 := False;
    end;
  end;
  //if s <> '' then Add(s);
  Add(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  t : TStringListEx;
begin
  t := TStringListEx.Create;
  try
    t.CommaTextEx := Edit1.Text;
    ListBox1.Items.Assign(t);
    Edit2.Text := t.CommaTextEx;
  finally
    t.Free;
  end;

end;

←解決時は質問者本人がここをチェックしてください。

戻る