VB.NET-TIPS などプログラミングについて

2025/05/14

ハンディターミナルを使用する最大の要因は、バーコードの読込みを行うことです。商品に貼られたバーコードや、商品棚に印刷されたバーコードを読み取り、いろいろな作業を行います。

BHTシリーズで読込み可能なバーコードには EAN-13（JAN-13）、EAN-8 （JAN-8）、NW-7、Code39、Code93、Code128等があります。

バーコードを読込む処理は以下の一連の命令の実行で行います。

・OPEN命令によりバーコードデバイスをオープンする。
・バーコードが読込まれるのを待つ。
・バーコードバッファから読込まれた文字列を取得する。
・CLOSE命令によりバーコードデバイスをクローズする。

■バーコードデバイスのオープン

バーコードデバイスのオープンの OPEN命令 について説明します。

[書式1:パラメタを直接指定]
　OPEN "BAR：［読取モード］［ブザー制御］［LED制御］" AS ［#］ファイル番号 CODE 読取コード［,読取コード...］

[書式2:パラメタをシステム設定値から指定]
　OPEN "BAR：SP" AS ［#］ファイル番号

＜引き数＞
・［読取モード］：
　■モメンタリスイッチモード（M）：
　　トリガスイッチを押している間だけ照明LEDが点灯し、
　　バーコードを読み取ることができる。

　■オートオフモード（F）
　　トリガスイッチを押すと照明LEDが点灯し、トリガスイッチを放すか、
　　またはバーコードを読み取ると、照明LED は消える。

　■オルタネートスイッチモード（A）
　　トリガスイッチを押すと照明LEDが点灯し、トリガスイッチを放しても、
　　照明LED は点灯している。バーコードデバイスファイルがクローズされるか、
　　またはトリガスイッチを再度押すと照明LED は消える。

　■連続読み取りモード（C）
　　トリガスイッチに関係なく照明LEDはバーコードデバイスファイルが
　　クローズされるまで点灯しています。

　※４モードとも照明LEDが点灯している間は、
　　バーコードを読み取ることができます。

・［ブザー制御］："B"
　バーコードの読み取り成功時にブザー（バイブレータ）を作動

・［LED制御］："L"
　バーコードの読み取り成功時に青LED が点灯しないようにする

・ファイル番号：（OPEN命令で指定したファイル番号を指定）

・読取コード：
　■共通商品コード（"A","B","C"）
　　　先頭文字（国フラグ）やアドオンの指定ができますが
　　　"A"のみ指定でEAN-13(JAN-13),EAN-8(JAN-8),UPC-E全てが
　　　読込める

　■NW-7（"N"）：
　　　書式：N［:［最小桁数［-最大桁数］］［スタート ストップ］［CD］
　　　　　　 ［,［最小桁数［-最大桁数］］［スタート ストップ］［CD］］
　　　　　　 ［,［最小桁数［-最大桁数］］［スタート ストップ］［CD］］］

　■Code39（"M"）：
　　　書式：M［:［最小桁数［-最大桁数］］［CD］
　　　　　　 ［,［最小桁数［-最大桁数］］［CD］］
　　　　　　 ［,［最小桁数［-最大桁数］］［CD］］］

　■Code93（"L"）：
　　　書式：L［:［最小桁数［-最大桁数］
　　　　　　 ［,［最小桁数［-最大桁数］］
　　　　　　 ［,［最小桁数［-最大桁数］］］

　■Code128（"K"）：
　　　書式：K［:［最小桁数［-最大桁数］
　　　　　　 ［,［最小桁数［-最大桁数］］
　　　　　　 ［,［最小桁数［-最大桁数］］］

上記のほかにいろんな指定がありますが、それは各BHTの取説を見てください。

■オープン指定の例

OPEN "BAR:M" AS #1 CODE "A", "M:4-25",  "K:4-25"

この例では読取モードとしてはモメンタリスイッチモードで、読取コードは共通商品コード、Code39の4桁～25桁、Code128の4桁～25桁を可能としています。

このオープン例を使った簡単なテストプログラムを以下に示します。

  PRIVATE intLen%, pstrBarCode$
  'バーコードデバイスオープン
  OPEN "BAR:M" AS #1 CODE "A", "M:4-25",  "K:4-25"
  'バーコードスキャニング待ち
  WAIT 0, &h02
  'バーコードバッファ内の文字数取得
  intLen% = LOC(#1)
  'バーコード読込
  pstrBarCode$ = INPUT$(intLen%, #1)
  'バーコードデバイスクローズ
  CLOSE #1
  PRINT "BARCODE=" + pstrBarCode$
  WAIT 0, &H1	'キー待ち
  END

実際の処理としては、上記のテストプログラムでは不十分です。商品などのバーコードコードをスキャンする場合、そのバーコードが準備されていればいいのですが、準備できていないことがあります。
そんな時には、バーコードスキャンでもキー入力でもコード入力が可能な様に組んでおくことが必要です。

■バーコード・キー入力の両方を行える関数例

以下のソースはバーコードスキャンを途中でやめて、キー入力出来る様にしたバーコード入力関数の例です。

この関数の処理は以下の様な仕様になっています。
(1)最初にカーソル位置を退避する。
(2)バーコードデバイスオープンを行い、キー入力とバーコードスキャンを待つ。
(3)バーコードスキャンがあれば、コードを変数に戻し、関数を終わる。
(4)[F4]キーが押下された場合は、戻り値にそのフラグを持って関数を終わる。
(5)[F1]キーが押下された場合は、キー入力処理になる。
(6)数字キーであれば入力文字列に追加する。
(7)[F2]キーが押下された場合は、バーコードスキャン(2)に戻る。
(8)[F4]キーが押下された場合は、戻り値にそのフラグを持って関数を終わる。

'この変数はどこかで宣言する
	Global GcKeyF1$ : GcKeyF1$ = "A"
	Global GcKeyF2$ : GcKeyF2$ = "B"
	Global GcKeyF3$ : GcKeyF3$ = "C"
	Global GcKeyF4$ : GcKeyF4$ = "D"
	Global GcGetRetNormal% : GcGetRetNormal% = 0  '[ENT]キーでの終了
	Global GcGetRetF1%     : GcGetRetF1% = 1      '[F1]キーでの終了
	Global GcGetRetF2%     : GcGetRetF2% = 2      '[F2]キーでの終了
	Global GcGetRetF3%     : GcGetRetF3% = 3      '[F3]キーでの終了
	Global GcGetRetF4%     : GcGetRetF4% = 4      '[F4]キーでの終了

'---------------------------------------
'バーコード入力
'---------------------------------------
'Function GfGetBar%(Byref pstrBarCode$)
'引　数：
'	pstrBarCode$:入力されたバーコード文字列
'戻り値:
'	GfGetBar%	:どのキーで終了したかを示す以下のフラグを返す
'				:	GcGetRetNormal% = 0  '[ENT]キーでの終了
'				:	GcGetRetF4% = 4      '[F4]キーでの終了
'---------------------------------------
	Function GfGetBar%(Byref pstrBarCode$)
		Private intX%, intY%, intLoop%, intLen%, strKey$, intRet%, strInp$
		'エラー処理宣言
		On Error Goto GfGetBar.ErrProc
		'結果格納領域の初期化
		pstrBarCode$ = ""
		'カーソル位置退避
		intY% = CSRLIN
		intX% = POS(0)
GfGetBar.ReStart	'バーコード再スタート
		Locate intX%, intY%, 2
		Cursor ON
		'バーコードデバイスオープン
		OPEN "BAR:M" AS #1 CODE "A", "M:4-25",  "K:4-25"

		intLoop% = GcTrue%
		While intLoop% = GcTrue%
			'キー入力とバーコードスキャニング待ち
			Wait 0, &h03
			'バーコードバッファ内の文字数取得
			intLen% = Loc(#1)
			If intLen% <> 0 Then 
				'バーコードスキャニングがあった場合
				pstrBarCode$ = Input$(intLen%, #1) 'バーコードをセット
				intRet% = GcGetRetNormal%
				intLoop% = GcFalse%
			Else
				'キー入力があった場合
				strKey$ = Input$(1) '入力されたキーの文字を取得
				SELECT strKey$
					CASE "A" 
						'[F1]キー文字の場合
						intLoop% = GcFalse%
						intRet% = GcGetRetF1%	'下のキー入力をさせる
					CASE "D" 
						'[F4]キー文字の場合
						intLoop% = GcFalse%
						intRet% = GcGetRetF4%	'関数を抜ける
				END SELECT
			End If
		WEnd
		'バーコードデバイスクローズ
		Close #1

		if intRet% = GcGetRetF1% Then
			'キー入力ループ
			intLoop% = GcTrue%
			While intLoop% = GcTrue%
				'表示
				Cursor OFF
				Locate intX%, intY%
				Print "               ";
				Locate intX%, intY%
				Print strInp$;
				Cursor ON
				'キーを1文字取得
				strKey$ = GfGetKey$
				'数字のみしか受け付けない!!
				IF "0" <= strKey$ And strKey$ <= "9" THEN
					strInp$ =strInp$ + strKey$
				ELSE
					'数字以外の場合
					SELECT strKey$
						CASE CHR$(13)
							'[ENT]キー文字の場合
							If strInp$ <> "" Then
								pstrBarCode$ = strInp$	'コード戻す
								intLoop% = GcFalse%		'ループ脱出
								intRet% = GcGetRetNormal%
							Endif
						CASE CHR$(8)
							'[BS]キーの場合
							If  LEN(strInp$) > 0 Then
								strInp$ = LEFT$(strInp$, LEN(strInp$) - 1)
							Endif
						CASE CHR$(24)
							'[クリア]キーの場合
							strInp$ = ""
						CASE "B" 
							'[F2]キー文字の場合
							intLoop% = GcFalse%
							intRet% = GcGetRetF2%	'バーコード再入力へ
						CASE "D" 
							'[F4]キー文字の場合
							intLoop% = GcFalse%
							intRet% = GcGetRetF4%	'関数を抜ける
					END SELECT
				ENDIF
			WEnd
		Endif
		If intRet% = GcGetRetF2% Then
			'バーコード再入力へ
			Goto GfGetBar.ReStart
		Endif
		GfGetBar% = intRet%
GfGetBar.Return	'関数戻り
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfGetBar.ErrProc
		GfGetBar% = GcGetRetNormal%
		pstrBarCode$ = ""
		Resume GfGetBar.Return
	End Function

'-----
'この関数の実行例
'-----
	SCREEN 1				'漢字モード
	LOCATE , , 2			'カーソルをブロック表示
	PRIVATE intRet%, intLen%, pstrBarCode$
	WHILE 1
		LOCATE 1, 2
		PRINT "                   ";
		LOCATE 1, 2
		PRINT "CODE=";
		intRet% = GfGetBar%(pstrBarCode$)
		LOCATE 1, 4
		PRINT "                   ";
		LOCATE 1, 4
		If intRet% = GcGetRetF4% Then
			PRINT "**コード無しでの戻り"
		Else
			PRINT "INP=" + pstrBarCode$
		Endif
	WEND

この関数はまだまだ足りない点があると思いますので、改造をして下さい。

=====
2016/04/02：の時の情報

閉鎖した昔のブログの記事復活
0CM

2025/05/14

BHT-BASIC4.0：ファイル伝送におけるXFILE命令の使い方

ハンディターミナルはそれ自身単体で使用するわけではなく、データファイルの送受信処理をパソコンと行い、そのデータファイルのデータを使用して処理を進めることはよくあります。

それで今回は、ファイルの送受信を行う XFILE命令 について説明します。

[書式]
　XFILE "[ドライブ名:]ファイル名"［, "プロトコル指定"］

＜引き数＞
　ドライブ名：ドライブ指定("A" OR "D")
　　　　　　　<各ドライブに対応する通信プロトコル>
　　　　　　　　"A":Ymodem, BHT-Ir, BHT
　　　　　　　　"D":Ymodemのみ
　ファイル名：ファイル指定

　プロトコル指定：以下の各指定を文字列で行う。
　　■伝送方向：
　　　・省略時(デフォルト)：BHTからファイル送信
　　　・"R"または"r"　　　：パソコンまたは他BHTからファイル受信

　　■シリアル番号：
　　　・省略時(デフォルト)：シリアル番号の付加無し
　　　・"S"または"s"　　　：伝送ブロックにシリアル番号を付加

　　■水平パリティチェック（BCC）：
　　　・省略時(デフォルト)：水平パリティの付加無し
　　　・"P"または"p"　　　：伝送ブロックに水平パリティを付加

　　■伝送モニタ：
　　　・省略時(デフォルト)：シリアル番号の表示無し
　　　・"M"または"m"　　　：伝送ブロックのシリアル番号を表示

　　■ファイル受信時のフィールド末尾の空白の扱い：
　　　・省略時(デフォルト)：空白をデータとして扱わない
　　　・"T"または"t"　　　：空白をデータとして扱う

　　■リンク確立時のタイムアウト時間：
　　　・"1"～"8"：30秒～240秒で30秒間隔
　　　・"9" 　　：タイムアウトなし

　　■ファイル名同一チェック：
　　　・省略時(デフォルト)：同一チェックを行う
　　　　　　　　　　　　　　（ファイル名で指定した名前と同じ
　　　　　　　　　　　　　　　名前で送られてきたファイルのみ受信）
　　　・"N"または"n"　　　：同一チェックを行わない
　　　　　　　　　　　　　　（送信側と異なるファイル名にて受信可能）

■プロトコル指定の例

XFILE "TEST.DAT", "RSPMT1"

この例はほぼ全てのプロトコル指定を行っています。つまり、ファイル「TEST.DAT」の受信でシリアル番号の付加、水平パリティの付加、シリアル番号の表示、フィールド末尾の空白をデータ、リンク確立時のタイムアウト時間30秒の指定です。

私があるシステムで XFILE命令 を使った受信時は以下のコマンドでした。フィールド末尾の空白ですが、データとしないと FIELD命令 で指定した分の桁数が確保されない気がしました。でもファイルを読込んだ時には、文字列の右側の空白を取除く（トリム）必要があります。

XFILE "TEST.DAT", "RPMT"

■XFILE命令をラップした関数について

受信と送信に分けて関数を作ってみました。

'---------------------------------------
'ファイル送信
'---------------------------------------
'Function GfSndFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$)
'引　数：
'	pintFp%		：ファイル番号
'	pstrSpeed$	：送信スピード
'	pstrFile$	：送信ファイル名
'	pstrOption$	：送信オプション
'戻り値:
'	GfSndFile%	:送信OK(GcTrue%)NG(GcFalse%)
'---------------------------------------
	Function GfSndFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$)
		On Error Goto GfSndFile.ErrProc
		OPEN "COM1:" + pstrSpeed$ AS pintFp%
		XFILE pstrFile$, pstrOption$
		GfSndFile% = GcTrue%
GfSndFile.Return		'終了処理
		CLOSE pintFp%
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfSndFile.ErrProc
		GfSndFile% = GcFalse%
		Resume GfSndFile.Return
	End Function

'---------------------------------------
'ファイル受信
'---------------------------------------
'Function GfRcvFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$)
'引　数：
'	pintFp%		：ファイル番号
'	pstrSpeed$	：受信スピード
'	pstrFile$	：受信ファイル名
'	pstrOption$	：受信オプション（"R"）以外のオプション
'戻り値:
'	GfRcvFile%	:受信OK(GcTrue%)NG(GcFalse%)
'---------------------------------------
	Function GfRcvFile%(pintFp%, pstrSpeed$, pstrFile$, pstrOption$)
		On Error Goto GfRcvFile.ErrProc
		OPEN "COM1:" + pstrSpeed$ AS pintFp%
		XFILE pstrFile$, "R" + pstrOption$
		GfRcvFile% = GcTrue%
GfRcvFile.Return		'終了処理
		CLOSE pintFp%
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfRcvFile.ErrProc
		GfRcvFile% = GcFalse%
		Resume GfRcvFile.Return
	End Function

=====
2016/04/02：の時の情報

閉鎖した昔のブログの記事復活
0CM

2025/05/14

BHT-BASIC4.0：簡単なメニュー表示・選択を行うユーザ関数について

簡単なメニュー表示・選択を行うユーザ関数を作ってみました。
この関数はメニュー表示データを文字列の配列で渡して、ハンディの「△」「▽」キーで選択行を移動させて、「ENT」キーの押下でメニュー選択を行います。
実際の表示は以下の様な感じです。

各数字キーを押下することで、メニューの選択が直接その行に移動します。但し、この関数なのですが問題が在りまして、各数字キーで直接移動するのはいいのですが、１～９までにしか対応していません。そのため、９個までのメニューは良いのですが、それ以上のメニューの場合は問題が在ります。
この辺りは、参考にされた場合は改造等をして下さい。
では以下にこの関数のソースを示します。

'---------------------------------------
'メニュー表示・選択
'---------------------------------------
'Function MfGetMenu$(Byval pnY%, Byval pColorBack&, Byref parrMenu$(), Byval pnMenuMax%, Byval pnMenu%)
'引　数：
'	pnY%		:画面行位置
'	pColorBack&	:背景色：指定色
'	parrMenu$()	:メニュー文字列配列
'	pnMenuMax%	:メニュー行のMAX値
'	pnMenu%		:最初のメニューの位置
'戻り値:
'	MfGetMenu$	:選択されたメニューの番号文字列
'---------------------------------------
	Function MfGetMenu$(Byval pnY%, Byval pColorBack&, Byref parrMenu$(), Byval pnMenuMax%, Byval pnMenu%)
		Private nMenu% : nMenu% = pnMenu%
		Private strMenu$: strMenu$ = ""
		Private strBuf$: strBuf$ =""
		Private strMenuMax$: strMenuMax$ = MID$(STR$(pnMenuMax%), 2)
		private color&            ' 文字色の変数を定義
		private bkcolor&          ' 背景色の変数を定義
		
		'エラー処理宣言
		On Error Goto MfGetMenu.ErrProc
		While strMenu$ = ""
			Locate 1, (pnY% - 1) * 2 + 1, 0
			Private i%
			For i% = 1 to pnMenuMax%
				If i% = nMenu% Then
					color& = .grColor.Black		' 文字色：黒色
					bkcolor& = pColorBack&		' 背景色：指定色
				Else
					color& = .grColor.Black		' 文字色：黒色
					bkcolor& = .grColor.White	' 背景色：白色
				Endif
				Call GsSetTextColor(color&, bkcolor&)
				Call GsPrintFull(MID$(STR$(i%), 2) + ":" + parrMenu$(i%))
			Next
			strBuf$ = GfGetKey$ 'キーを1文字取得
			IF "1" <= strBuf$ And strBuf$ <= strMenuMax$ THEN
				'メニューの番号文字の場合
				nMenu% = VAL(strBuf$)
			ELSE
				'メニューの番号文字以外の場合
				SELECT strBuf$
					CASE CHR$(13)
						'[ENT]キー文字の場合
						strMenu$ = MID$(STR$(nMenu%), 2)
					CASE "E"
						'[↑]キーの場合
						If nMenu% > 1 Then
							nMenu% = nMenu% - 1
						Else
							'先頭の場合、最下行へ移動
							nMenu% = pnMenuMax%
						Endif
					CASE "M"
						'SHIFT+[↑]キーの場合
						If nMenu% > 1 Then
							nMenu% = nMenu% - 1
						Else
							'先頭の場合、最下行へ移動
							nMenu% = pnMenuMax%
						Endif
					CASE "F"
						'[↓]キーの場合
						If nMenu% < pnMenuMax% Then
							nMenu% = nMenu% + 1
						Else
							'最下行の場合、先頭へ移動
							nMenu% = 1
						Endif
					CASE "N"
						'SHIFT+[↓]キーの場合
						If nMenu% < pnMenuMax% Then
							nMenu% = nMenu% + 1
						Else
							'最下行の場合、先頭へ移動
							nMenu% = 1
						Endif
				END SELECT
			ENDIF
		WEND
		'メニュー番号を返す
		MfGetMenu$ = strMenu$
MfGetMenu.Return	'関数戻り
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfGetMenu.ErrProc
		Resume MfGetMenu.Return
	End Function

尚、この関数を実行する例のメインのソースは以下になります。

	SCREEN 1				'漢字モード
	LOCATE , , 2			'カーソルをブロック表示
	'メニュー
	Const MENU.CNT% = 9
	PRIVATE strArrTxMenu$(MENU.CNT%), strRet$, intLoop%, intMenu%
	strArrTxMenu$(1) = "メニュー１　　　　"
	strArrTxMenu$(2) = "メニュー２　　　　"
	strArrTxMenu$(3) = "メニュー３　　　　"
	strArrTxMenu$(4) = "メニュー４　　　　"
	strArrTxMenu$(5) = "メニュー５　　　　"
	strArrTxMenu$(6) = "メニュー６　　　　"
	strArrTxMenu$(7) = "メニュー７　　　　"
	strArrTxMenu$(8) = "メニュー８　　　　"
	strArrTxMenu$(9) = "終了　　　　　　　"
	intMenu% = 1	'最初の選択メニュー番号
	intLoop% = GcTrue%
	WHILE intLoop%
		strRet$ = MfGetMenu$(1, .grColor.Yellow, strArrTxMenu$, MENU.CNT%, intMenu%)
		If strRet$ = "9" Then
			intLoop% = GcFalse%
		Else
			LOCATE 1, 21
			PRINT "SEL=" + strRet$;
			intMenu% = VAL(strRet$)	'前回の選択番号
		Endif
	WEND
	END

=====
2016/04/02：の時の情報

閉鎖した昔のブログの記事復活
0CM

2025/05/14

BHT-BASIC4.0：文字列を扱うユーザ定義関数についてその３

さらに、文字列を扱うユーザ定義関数として使えそうなものを作成してみました。

関数定義	引数	戻り値
指定バイト数内に収まる文字列を戻す `Function GfCut$(pstrValue$, pintMax%)[255]`	pstrValue$:対象文字列 pintMax%:指定バイト	GfCut$:結果文字列
横幅一杯でのテキスト表示 `Sub GsPrintFull(Byval pstrSrc$)`	pstrSrc$:対象文字列

'---------------------------------------
'指定バイト数内に収まる文字列を戻す関数
'---------------------------------------
'Function GfCut$(pstrValue$, pintMax%)[255]
'引　数：
'	pstrValue$：対象文字列
'	pintMax%：指定バイト数
'戻り値:
'	GfCut$	:結果文字列
'---------------------------------------
	Function GfCut$(pstrValue$, pintMax%)[255]
		'エラー処理宣言
		On Error Goto GfCut.ErrProc

		Private intPos%, intErr%, intLoop%, intChr%, strRet$[255]
		intPos% = 0
		intErr% = GcFalse%
		intLoop% = GcTrue%
		While intLoop% = GcTrue%
			'ASCIIコード取得
			intChr% = Asc(Mid$(pstrValue$, intPos% + 1, 1))
			'2バイト文字(先頭バイトがSJISコード??)
			If &H80 <= intChr% And intChr% <= &H9F Then
				intPos% = intPos% + 2
				If intPos% > pintMax% Then
					'最大バイト長を超える場合、前の状態に戻すフラグON
					intErr% = GcTrue%
				End If
				If intPos% >= pintMax% Then
					'最大バイト長に達する場合は、その場で終了
					If intErr% = GcTrue% Then
						strRet$ = Mid$(pstrValue$, 1, intPos% - 2)
					Else
						strRet$ = Mid$(pstrValue$, 1, intPos%)
					End If
					intLoop% = GcFalse%
				End If
			'1バイト文字
			Else
				intPos% = intPos% + 1
				If intPos% >= pintMax% Then 
					'最大バイト長に達する場合は、その場で終了
					strRet$ = Mid$(pstrValue$, 1, intPos%)
					intLoop% = GcFalse%
				End If
			End If
		WEnd
		GfCut$ = strRet$
GfCut.Return	'関数戻り
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
GfCut.ErrProc
		GfCut$ = ""
		Resume GfCut.Return
	End Function

	const	McMaxColumns% = 20		'画面の半角桁数MAX
'---------------------------------------
'横幅一杯でのテキスト表示
'---------------------------------------
'Sub GsPrintFull(Byval pstrSrc$)
'引　数：
'	pstrSrc$：対象文字列
'---------------------------------------
    Sub GsPrintFull(Byval pstrSrc$)
		'エラー処理宣言
		On Error Goto GsPrintFull.ErrProc

		Private strWK$[255]
		strWK$ = GfCut$(pstrSrc$ + "                      ", McMaxColumns%)
    	If Len(strWK$) < McMaxColumns% Then
			strWK$ = strWK$ + LEFT$("          ", McMaxColumns% - Len(strWK$))
		Endif
		Print strWK$;
GsPrintFull.Return	'関数戻り
		On Error Goto 0
		Exit Sub
'-----
'エラー処理
'-----
GsPrintFull.ErrProc
		Resume GsPrintFull.Return
	End Sub

尚、GfCut$関数は、以前存在した「ハンディターミナル（BHT）の部屋」というサイトからの引用です。
また、GsPrintFull関数は画面の横幅を20文字と限定しています。（フォントの設定が24ドット）

=====
2016/04/02：の時の情報

閉鎖した昔のブログの記事復活
0CM

2025/05/14

BHT-BASIC4.0：拡張関数のサーチ処理関数(SEARCH.FN3)の使い方

前回はバイナリサーチ(SEARCH.FN3)の紹介を行いましたが、この検索では1個のコードに対して処理する機能しかありません。
コードは昇順にしないとバイナリサーチは利用できないので、 1レコードの中に複数コードが存在しソートできない場合などのデータファイルの場合には利用できません。

複数コードの条件付けを行い検索できるのが、拡張関数の サーチ処理関数(SEARCH.FN3) です。今回はこの拡張関数について説明します。

■サーチ処理関数(SEARCH.FN3)について

この関数は以下の4個の機能があります。

機能番号		処理内容
.fcAndSrch	1	「AND」サーチ（レコード番号検索）
.fcOrSrch	2	「OR」サーチ（レコード番号検索）
.fcAndSrchN	11	「AND」サーチ件数（件数のみ検索）
.fcOrSrchN	12	「OR」サーチ件数（件数のみ検索）

「レコード番号検索」と「件数のみ検索」で関数に渡す引数の書式が異なります。

[書式1]
　CALL "SEARCH.FN3" .fcAndSrch FILENO%, RSTART, REND, RECORD, STRING1$, STRING2$．．．
　　RSTART, REND, RECORD は、整数型(%),長整数型(&),実数型(指定無し)が使用可能
[書式2]
　CALL "SEARCH.FN3" .fcAndSrch FILENO%, RSTART, REND, RECORD, STRING$(), STRINGN%
　　RSTART, REND, RECORD は、整数型(%),長整数型(&),実数型(指定無し)が使用可能

＜引き数＞
　　.fcAndSrch：機能番号指定
　　FILENO%   ：ファイル番号
　　RSTART    ：検索開始レコード番号
　　REND　    ：検索終了レコード番号
　　FIELDNO%  ：フィールド番号
　　STRINGn$  ：検索条件
　　STRING$() ：検索条件（配列指定時）
　　STRINGN%  ：検索条件数（配列指定時）

　　STRINGn$やSTRING$()は「検索方法」＋「フィールド番号」＋「検索文字列」で指定します。
　　「検索方法」、「フィールド番号」は数値を「CHR$関数」で文字列化

＜戻り値＞
　　RECORDNO　：検索結果（レコード番号）
　　・RECORDNO には、検索条件に一致するデータが見つかったレコード番号が返されます。
　　　見つからなかった場合、0 が返されます。
　　・RECORDNO は、整数型の最大値(32767)を超える場合あるので、
　　　変数に代入する場合、長整数型変数か実数型変数を推奨します

今回の検索関数を使用する例のために以下の様なデータファイルを想定します。これは今まで使ってきたTEST.DATに削除フラグを追加しています。ファイル名はTEST2.DATとします。

項目名	フィールド長	内容
品番	16	商品コードの文字列
数量	12	商品の数量を文字列で格納
削除フラグ	1	"1":削除済み、 "0"削除されていない

サーチ処理関数(SEARCH.FN3) を使う上で OR条件 よりも AND条件 を使う方が多いと思うので、 AND条件 を例にとります。
品番と削除フラグの AND条件 でデータファイル（ TEST2.DAT ）を検索する関数が以下の様になります。関数コールの書式は検索条件に文字列配列を使った「書式２」で行っています。

'---------------------------------------
'データ検索その２
'---------------------------------------
'Function MfSearchData2%(Byval pstrCD$, Byval pintDel%, Byref plngNum&, Byref plngRecNo&)
'引　数：
'	pstrCD$		:コード
'	pintDel%	:削除フラグ
'	pdblVal$	:数量
'	plngRecNo&	:レコードNO
'戻り値:
'	MfSearchData2%	:読込OK:GcTrue%, NG:GcFalse%
'---------------------------------------
	Function MfSearchData2%(Byval pstrCD$, Byval pintDel%, Byref plngNum&, Byref plngRecNo&)
		'エラー処理宣言
		On Error Goto MfSearchData2.ErrProc
		'フィールドサイズ(既に宣言済み)
'		Const COL.CD% = 16
'		Const COL.NUM% = 12
'		Const COL.DEL% = 1
		'戻り値の初期化
		MfSearchData2% = GcFalse%
		'FIELD関連変数
		PRIVATE FILENO%, REC.CD$, REC.NUM$, REC.DEL$
		'TEST.DAT2ファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN GcTEST2.DAT$ AS FILENO% RECORD 2147483647
		FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$, COL.DEL% AS REC.DEL$
		'検索データの整形
		PRIVATE WK.CD$, WK.DEL$
		WK.CD$ = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%)
		If pintDel% = GcTrue% Then
			WK.DEL$ = "1"
		Else
			WK.DEL$ = "0"
		EndIf
		'レコードNO検索
		PRIVATE RSTART&, REND&, RECORDNO&, STRING$(2)[64], STRINGN%
		RSTART& = 1
		REND& = LOF(FILENO%)	'ファイルの最後まで検索
		STRINGN% = 2			'検索条件配列の個数
		STRING$(0) = CHR$(0) + CHR$(1) + WK.CD$	 '検索条件(＝条件),フィールド番号(1:場所CD)
		STRING$(1) = CHR$(0) + CHR$(3) + WK.DEL$ '検索条件(＝条件),フィールド番号(3:削除フラグ)

		CALL "SEARCH.FN3" .fcAndSrch FILENO%, RSTART&, REND&, RECORDNO&, STRING$(), STRINGN%
		If RECORDNO& > 0 Then
			'レコードNOが返された場合,レコードの取得
			GET FILENO%, RECORDNO&
			'数値文字列を返す
			plngNum& = VAL(REC.NUM$)
			plngRecNo& = RECORDNO&
			'正常を返す
			MfSearchData2% = GcTrue%
		Endif
MfSearchData2.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfSearchData2.ErrProc
		MfSearchData2% = GcFalse%
		Resume MfSearchData2.Return
	End Function

■検索関数の利用

上記の検索関数の動作をテストするソースを以下に記します。

	SCREEN 1				'漢字モード
	LOCATE , , 2			'カーソルをブロック表示
	'最初は書き込み処理の連続
	PRIVATE W%
	W% = MfPutData2%("CD0001",  100, GcTrue%,  0)
	W% = MfPutData2%("CD0002",  102, GcFalse%, 0)
	W% = MfPutData2%("CD0003", 1030, GcTrue%,  0)
	W% = MfPutData2%("CD0101",  201, GcTrue%,  0)
	W% = MfPutData2%("CD0201",  202, GcFalse%, 0)
	W% = MfPutData2%("CD1001",  500, GcTrue%,  0)

	PRIVATE CD$, RNO&, NUM&
	CD$ = "CD0001"	'削除ONで検索⇒検索OK
	W% = MfSearchData2%(CD$, GcTrue%, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	CD$ = "CD0002"	'削除ONで検索⇒検索NG
	W% = MfSearchData2%(CD$, GcTrue%, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	CD$ = "CD0002" 	'削除OFFで検索⇒検索OK
	W% = MfSearchData2%(CD$, GcFalse%, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	CD$ = "CD0201" 	'削除OFFで検索⇒検索OK
	W% = MfSearchData2%(CD$, GcFalse%, NUM&, RNO&)
	IF W% = GcTrue% THEN
		PRINT CD$ + "(" + STR$(RNO&) +  "):" + STR$(NUM&)
	ELSE
		PRINT CD$ + ":Not Found"
	ENDIF
	WAIT 0, &h01 'キー入力待ち
	END

最初のテストデータの書き込みで使っている関数 MfPutData2% は、下の方にソースがありますのでそちらを参照下さい。また、これによって作成された TEST2.DAT は以下の図の様になります。（デバッガ上でのシミュレーションでのファイル参照ですが）

品番コードと削除フラグの指定を合わせて検索しています。
このソースの実行結果は以下の図の様になります。

関数 MfPutData2% のソースです。

Const GcTEST2.DAT$ = "TEST2.DAT"
'---------------------------------------
'データ書込(TEST2.DAT)
'---------------------------------------
'Function MfPutData2%(Byval pstrCD$, Byval plngNum&, Byval pintDel%, Byval plngRecNo&)
'引　数：
'	pstrCD$		:コード
'	plngNum&	:数量
'	pintDel%	:削除フラグ
'	plngRecNo&	:レコードNO(0:レコード追加)
'戻り値:
'	MfPutData2%	:書込OK:GcTrue%, NG:GcFalse%
'---------------------------------------
	Function MfPutData2%(Byval pstrCD$, Byval plngNum&, Byval pintDel%, Byval plngRecNo&)
		'エラー処理宣言
		On Error Goto MfPutData2.ErrProc
		'フィールドサイズ
		Const COL.CD% = 16
		Const COL.NUM% = 12
		Const COL.DEL% = 1
		'戻り値の初期化
		MfPutData2% = GcFalse%

		PRIVATE FILENO%, REC.CD$, REC.NUM$, REC.DEL$
		FILENO% = 0
		'TEST.DAT2ファイルを、ファイル番号#1としてオープンします
		FILENO% = 1
		OPEN GcTEST2.DAT$ AS FILENO% RECORD 2147483647
		FIELD #FILENO%, COL.CD% AS REC.CD$, COL.NUM% AS REC.NUM$, COL.DEL% AS REC.DEL$
		'フィールドへデータ設定
		REC.CD$  = LEFT$(pstrCD$ + GfSpc$(COL.CD%), COL.CD%)	'既定の桁数分スペースを付加
		REC.NUM$ = RIGHT$(GfSpc$(COL.NUM%) + STR$(plngNum&), COL.NUM%)	'既定の桁数分スペースを付加
		REC.DEL$ = "0"
		If pintDel% = GcTrue% Then
			REC.DEL$ = "1"
		Endif
		
		If plngRecNo& = 0 Then
			'レコードNOが０の場合,レコードの最後尾に追加
			PUT FILENO%
		Else
			'レコードNOが指定された場合,レコードの上書
			PUT FILENO%, plngRecNo&
		Endif
		'正常を返す
		MfPutData2% = GcTrue%
MfPutData2.Return	'関数戻り
		If FILENO% > 0 Then
			Close FILENO%
		Endif
		On Error Goto 0
		Exit Function
'-----
'エラー処理
'-----
MfPutData2.ErrProc
		Resume MfPutData2.Return
	End Function

=====
2016/04/02：の時の情報

閉鎖した昔のブログの記事復活
0CM