こんにちは、高田浩です。

現在、xBase.pas なる xBASE言語ライク環境の開発中なのですが、
その中からの紹介です。

DBF のテキスト吐き出しを xBASE言語記述っぽくしたものです。
使用例に CSV への書き出しを紹介しています。色々なやり方が
あるかとは思いますが、そのひとつと見てやって下さい。

現在のテーブルを var で宣言した Alias 変数に代入することで汎用
にしているので、例示のように Alias := Table1 などとしてお使いく
ださい。

使用条件はそれぞれのバージョンでの xBASE に従ってください。
（多分、あまり差はないと思う）



-----------------------------------------------------------------
unit xBaseSub;

interface
uses
  BDE,DBTables,SysUtils;

  procedure xQ1 (                     {?}
    StrLine      : string
    );
    {注意：テキスト書き出しにしか対応していません}
  procedure xQ2 (                     {??}
    StrLine      : string
    );
    {注意：テキスト書き出しにしか対応していません}

  procedure xSetAlternateTo (         {SET ALTERNATE TO}
     rFile        : String              {Writte File Name}
     ); overload;
  procedure xSetAlternateTo; overload;  {CLOSE ALTERNATE}
  procedure xSetAlternateOn (         {SET ALTERNATE ON}
     rAdditive    : Boolean             {Additive}
     );
  procedure xSetAlternateOff;         {SET ALTERNATE OFF}

  function xSpace(                    {SPACE()}
     Cnt          : integer
     )            : string;
  function xTransform(                {TRANSFORM() for StringField}
     Fld          : string ;            {注意：左寄せに固定している}
     Wid          : Byte
     )            : string ;overload;
     {BooleanField,DateFieldもAsStringでこれで代役させています}
  function xTransform(                {TRANSFORM() for IntegerField}
     Fld          : string ;
     Wid          : Byte ;
     Conma        : Boolean             {３桁区切り}
     )            : string ;overload;
  function xTransform(                {TRANSFORM() for FloatField}
     Fld          : string ;
     Wid          : Byte ;
     Dec          : Byte ;
     Conma        : Boolean             {３桁区切り}
     )            : string ;overload;

var
  Alias    : TTable;           {現在処理の対象となるテーブル変数}
  fOut,fIn : TextFile;         {読み書きテキストファイル変数}

implementation

{?}{改行ありの書き出し}

procedure xQ1(StrLine: string);
begin
  Writeln(fOut,StrLine);
  Flush(fOut);
end;

{??}{改行なしの書き出し}

procedure xQ2(StrLine: string);
begin
  Write(fOut,StrLine);
  Flush(fOut);
end;

{SET ALTERNATE TO}

procedure xSetAlternateTo(rFile:String);
begin
  AssignFile(fOut,rFile)              {書出ファイルを開く}
end;
procedure xSetAlternateTo;
begin
  Writeln(fOut);
  CloseFile(fOut)                     {書出ファイルを閉じる}
end;

{SET ALTERNATE ON/OFF}

procedure xSetAlternateOn(rAdditive:Boolean);
begin
  if rAdditive then
    Append(fOut)                      {追加}
  else
    Rewrite(fOut);                    {上書}
end;
procedure xSetAlternateOff;
begin
end;

{SPACE()}

function xSpace(Cnt:integer):string;
begin
  xSpace := StringOfChar(Char(32),Cnt);  {Char(32)は半角空白文字}
end;

{TRANSFORM()}

function xTransform (Fld:string;Wid:Byte):string;
var
  val : string;
  fmt : string;
begin with Alias do begin
  val := FieldByName(Fld).AsString;
  fmt := '%-'+IntToStr(Wid)+'s';              {左寄せのn幅の文字}
  xTransform := Format(fmt,[val]);
end;end;
function xTransform (Fld:string;Wid:Byte;Conma:Boolean):string;
var
  val : Double;
  fmt : string;
begin with Alias do begin
  val := FieldByName(Fld).AsFloat;
  if Conma then fmt := '%'+IntToStr(Wid)+'.0n'
           else fmt := '%'+IntToStr(Wid)+'.0d';
  xTransform := format(fmt,[val]);
end;end;
function xTransform (Fld:string;Wid,Dec:Byte;Conma:Boolean):string;
var
  val : Double;
  fmt : string;
begin with Alias do begin
  val := FieldByName(Fld).AsFloat;
  if Conma then fmt := '%'+IntToStr(Wid)+'.'+IntToStr(Dec)+'n'
           else fmt := '%'+IntToStr(Wid)+'.'+IntToStr(Dec)+'d';
  xTransform := format(fmt,[val]);
end;end;

end.

-------------------------------------------------------------------
【実行例】
Form に TTable,TBuuton を１つづつ貼り付けてButtonのOnClick
に以下を関連付けるだけです。

procedure TForm1.Button1Click(Sender: TObject);
var
  s:string;
begin
  Alias:=Table1;
  Alias.TableName:='c:\dos\ap\dbase\samples\商品.dbf';
  Alias.Open;
  xSetAlternateTo('c:\Syouhin.Txt');
  xSetAlternateOn(false);
  s:=','; {区切り文字に","の指定}
  Alias.First;
  while not Alias.eof do begin
    xQ2(  xTransform('商品ｺｰﾄﾞ'  ,10       ));
    xQ2(s+xTransform('発注日'    ,10       ));
    xQ2(s+xTransform('商品名'    ,30       ));
    xQ2(s+xTransform('備考'      ,30       ));
    xQ2(s+xTransform('納期'      , 3  ,true));
    xQ2(s+xTransform('単価'      ,11,2,true));
    xQ2(s+xTransform('発注数'    , 3  ,true));
    xQ2(s+xTransform('在庫数'    , 3  ,true));
    xQ2(s+xTransform('発注先ｺｰﾄﾞ', 4       ));
    xQ2(s+xTransform('製造中止'  , 5       ));
    xQ2(s+xTransform('仕入価格'  ,11,2,true));
  //xQ2(s+xTransform('コメント'  ,30       ));
    xQ1('');
    Alias.Next;
  end;
  xSetAlternateOff;
  xSetAlternateTo;

end;


追伸：ソースを改良したレスを下さる方は、それが xBase.pas に
　　　組み込まれることをご了解ください。

xBase.pas 開発資料収集を SBORLAND (4)dBASE 会議室に展開中

_/dBASE3-4形式_/VdB7&Delphi4pro_/_/KFE06073_/_/高田浩_/_/
 



Original document by 高田　浩        氏 ID:(KFE06073)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。