研究開発

文字情報をワークシートへ(1)

第1章

このプログラムはドキュメント上のすべての文字オブジェクトを ワークシートに表示するものです。
TextCountはForEachObjectから呼ばれる手続き。 文字オブジェクトの時にカウントしている。

{
名称  文字情報をワークシートへメニュー(TextToWorksheet.vsm)
2009年 2月24日-1.0.0
著作・製作 エーアンドエー株式会社
}
PROCEDURE TextToWorksheet;
LABEL
	666, 9999;
CONST
	kWSName = 'NJAA_TextALL';
VAR
	ii : INTEGER;
	wsH : HANDLE;
	answer : INTEGER;
	wsName : STRING;

	PROCEDURE TextCount ( objH :HANDLE );
	BEGIN
		ii := ii + 1;
	END;

TextPicUpはForEachObjectから呼ばれる手続き。
文字オブジェクトの時にワークシートに収める処理をしています。
ワークシートの1列目に文字オブジェクトのレイヤ名を入ます。
ワークシートの2列目に文字オブジェクトのクラス名を入れます。
ワークシートの3列目に文字オブジェクトの文字列を入れます。

	PROCEDURE TextPicUp ( objH : HANDLE );
	VAR
		dummy : STRING;
	BEGIN
		SetWSCellFormula ( wsH, ii, 1, ii, 1, GetLName ( GetLayer ( objH ) ) );
		SetWSCellFormula ( wsH, ii, 2, ii, 2, GetClass ( objH ) );
		dummy := GetText ( objH );
		SetWSCellFormula ( wsH, ii, 3, ii, 3, dummy );
		ii := ii + 1;
	END;

新規にワークシートを作成するため、ワークシート名を訪ねます。
空白だったら終了します。
すでに存在する名前だったら、警告を出してもう一度訪ねます。

BEGIN
666:wsName := StrDialog ( 'ワークシートの名前', '名称未設定-1' );
	IF wsName = '' THEN
	BEGIN
		GOTO 9999;
	END;

	IF GetObject ( wsName ) <> NIL THEN
	BEGIN
		AlertCritical ( 'その名前は既に使われています。別の名前にしてください。', '' );
		GOTO 666;
	END;

ワークシートの行数を調べるため、予め文字オブジェクトの数を数えます。
文字図形のときのみTextCountに飛び、数を数えます。

	ii := 0;

	ForEachObject ( TextCount, T=TEXT );

ワークシートを作成します。
文字図形のときのみTextPicUpに飛び、ワークシートに情報を収めます。

	wsH := CreateWS ( wsName, ii, 3 );

	ii := 1;

	ForEachObject ( TextPicUp, T=TEXT );

9999:END;
Run ( TextToWorksheet );