JCL_lst_Export_pgs2 – JCL4Dマニュアル

リストボックスの内容をテキストファイルに書き出す。第２引数がデフォルトの書き出すファイル名。表示されるファイル保存ダイアログに入力して確定したファイル名が戻り値（$0）に返される。第３引数のインターバルにはファイル書き出し中に表示されるプログレスバーのインターバルを指定する。件数が100件程度なら１を、1000件ならたとえば10を与える。件数が多い場合に１を与えるとバーは滑らかに動くが遅くなる。10,000件なら100以上でもよい。

使い方
$name:=JCL_lst_Export_pgs2(->vKO01_lstKO;$inName;$interval)

引数
$1: リストボックスのポインタ
$2: デフォルトファイル名
$3: インターバルカウント

プログレスバーを表示するため、別途JCL_DLG.4dbaseコンポーネントが必要。

  //JCL_lst_Export_pgs2
  //JCL_lst_Export_pgs
  //20200310 wat
  // 汎用のリストボックス　書き出し  //JCL_lst_Exportの集大成
  //20140921 wat yabe
  //20180522 wat ファイル書き出し方法を変更,  改行をストリップ
  //20181030 wat 戻り値にファイル名を返す
  //20190107 wat ike 改行はＬＦ、BLOB経由しない
  //20200310 wat text to Documentはバッファが大きくなると遅い、send packetに戻したら早い。
  //20200310 wat プログレスバー表示

C_POINTER($1;$lstbxPtr)
$lstbxPtr:=$1
C_TEXT($2;$name)
$name:=$2
C_LONGINT($3;$pgs_interval)
$pgs_interval:=$3
C_TEXT($0)  //20181030 wat
C_TEXT($buf;$str)
C_TEXT($tabChar;$crlf;$cr;$lf)
$buf:=" "  // 20140923 「ID」という文字がファイルの先頭にあるとエクセルがSYLKファイルと勘違いするため先頭に空白を出力
$tabChar:=Char(Tab)
$crlf:=Char(Carriage return)+Char(Line feed)
$cr:=Char(Carriage return)
$lf:=Char(Line feed)
C_TEXT($folderPath;$filePath)
C_LONGINT($numOfCols;$numOfRows;$col;$row)
C_BOOLEAN($done)
$done:=False
C_TEXT($msg)

$name:=$name+JCL_str_Datemark (Current date;Current time)+".txt"
$dlg_ok:=JCL_dlg_InputOne ("出力先のファイル名：";"フィル名を入力してください。";"OK";"Cancel";->$name)
If ($dlg_ok=1)
	  //ファイルに書き出す
	$folderPath:=System folder(Desktop)
	$filePath:=JCL_file_MakeFilePath ($folderPath;$name)
	$time:=Create document($filePath)
	
	  //プログレスバー
	JCL_pgs_DefInit 
	$msg:="テキストファイル「"+$name+"」に書き出しています..."
	JCL_pgs_Show ($msg)
	
	  // 列数を求める
	$numOfCols:=LISTBOX Get number of columns($lstbxPtr->)
	$numOfRows:=LISTBOX Get number of rows($lstbxPtr->)
	
	ARRAY TEXT($aryColNames;0)
	ARRAY TEXT($aryHeaderNames;0)
	ARRAY POINTER($aryColVars;0)
	ARRAY POINTER($aryHeaderVers;0)
	ARRAY BOOLEAN($aryColsVisible;0)
	ARRAY POINTER($aryStyles;0)
	
	LISTBOX GET ARRAYS($lstbxPtr->;$aryColNames;$aryHeaderNames;$aryColVars;$aryHeaderVers;$aryColsVisible;$aryStyles)
	
	$msg:="タイトル行を書き出しています..."
	JCL_pgs_SetValue (1;$msg;1;1)
	  // ヘッダを出力
	For ($col;1;$numOfCols)
		If ($col<$numOfCols)
			$str:=OBJECT Get title(*;$aryHeaderNames{$col})
			$buf:=$buf+$str+$tabChar
			
		Else 
			$str:=OBJECT Get title(*;$aryHeaderNames{$col})
			$buf:=$buf+$str+$tabChar+$crlf
			
		End if 
	End for 
	SEND PACKET($time;$buf)
	$buf:=""
	
	  // ボディを出力
	For ($row;1;$numOfRows)
		  //プログレスバー
		If (Mod($row;$pgs_interval)=0)
			$msg:="行を書き出しています..."
			JCL_pgs_SetValue (($row/$numOfRows)*100;$msg+String($row);$row;$numOfRows)
			DELAY PROCESS(Current process;1)
		End if 
		
		For ($col;1;$numOfCols)
			  //途中はタブ区切り、最後の列のあとに改行
			If ($col<$numOfCols)
				$str:=String($aryColVars{$col}->{$row})  // データ型によってはエラーになる可能性がある、pictとか？
				  //改行をストリップ
				$str:=Replace string($str;$crlf;" ")
				$str:=Replace string($str;$cr;" ")
				$str:=Replace string($str;$lf;" ")
				
				$buf:=$buf+$str+$tabChar
				
			Else 
				$str:=String($aryColVars{$col}->{$row})  // データ型によってはエラーになる可能性がある
				$buf:=$buf+$str+$crlf
				
			End if 
		End for 
		SEND PACKET($time;$buf)
		$buf:=""
		
		$done:=JCL_pgs_IsCancel 
		If ($done=True)
			$row:=$numOfRows
		End if 
	End for 
	JCL_pgs_Close 
	
	  //ファイルを閉じる
	CLOSE DOCUMENT($time)
	
End if 

$0:=$name

少し前のバージョンでは、全部の文字ブロックを作成してから一気にファイルに書き出していたが、データ量が多くなると指数関数的に遅くなることがわかった。$bufのメモリ領域を広げるのに時間がかかるためだろう。上記コードのようにループごとにSEND PACKETで書き出して$bufをクリアして、$buf領域がほぼ一定の大きさになるようにしたら劇的に速度アップした。