BACK

このページは見ている人も少ないと思いますので、
ほとんど日記状態に書き込んでいます。
下はやっと完成したXFCNです。検索文字列を1バイト単位で返します。
ほんとはPOKEを使って1バイトずつハンドルから読み込み処理をする予定だったのですが、
動作がなぜか不安定になったので下記のようにINSTR()関数を使いました。
XFCNで255文字以上の処理をしたい方は参考になるでしょう。
しかしFutureBASIC IIはなかなかむづかしいですねー。


'"MAIN部分

GLOBALS "ffoffset.GLBL" 'まず我々のグローバルファイルを得る
END GLOBALS

RESOURCES "", "STAKWILD", "XFCN", 6001, "ffoffset",_resPurgeable%
COMPILE 0,_pointerVars _appendRes _strResource'xcmd リソースＰ力ファイルに追加
OUTPUT FILE "SSOFFSET" 'xcmd を対象スタックに追加
: 'xcmd は（範囲 = 0-16）け取らなければならない
INCLUDE "ffoffset evnt.INCL"'あなた自身の xcmd ルーチン
'INCLUDE "ffoffset evnt.INCL"

' ････････････････････････････････････････････････････････････････････････

ENTERPROC% (xCmdPtr&) 'コードリソースを作成するので % を使う
LONG IF xcmdID% = 0
xcmdHndl& = FN RECOVERHANDLE(REGISTER(a4))'xcmd のハンドルだる
LONG IF xcmdHndl& 'ハンドルを得たか？
CALL GETRESINFO (xcmdHndl&, xcmdID%, type&, tmp$)'xcmd のリソース ID だる
END IF
% REGISTER(A4) + _drvrMenu, xcmdID%'xcmd ０NSTR# ID どむように設定
END IF
CALL GETPORT(hcPort&) 'オリジナルのポートを保存
% xCmdPtr& + _passFlag ,_false'HC がメッセージＯさないようにする

LONG IF {xCmdPtr& + _paramCount} => 0'何らかのパラメータＯすだけ
LONG IF {xCmdPtr& + _paramCount} <= _maxParams'paramcount の数字は正しいか？

LONG IF paramCount% <> 0
FOR j = 0 TO paramCount% - 1'"パラメータ分くり返す
FN ZeroToPas (xCmdPtr&,[[xCmdPtr& + _params + j*4]], str255$(j))
'全ての C-strings ０NPascal strings
NEXT 'に変換
END IF
CALL INITCURSOR '我々のカーソルをリセット

SELECT str255$(0) '最初のパラメータ値を確認
CASE "!" 'もし '!' なら、メッセージにバージョン情報を返す
FN ReplyToQuery (xCmdPtr&, _versionInfo)
'情風るのにエラーハンドラＨう

CASE "?" 'もし '?' なら、メッセージに利用情報を返す
FN ReplyToQuery (xCmdPtr&, _usageInfo)'情風るのにエラーハンドラＨう

CASE ELSE '通常の xcmd パラメータを扱う
'
' ･･････････････････････････････････
FN SssOffset (xCmdPtr&,str255$)'あなたの xcmd ハンドラここに書き込む
' ･･････････････････････････････････
END SELECT
XELSE
FN ErrorHandler (xCmdPtr&, _wrongParams)'paramcount が正しくない場合
END IF 'paramCount > 0
'
XELSE
' 外部 windoid しう（ここでは不要）
'
END IF
CALL SETPORT(hcPort&) 'オリジナルポートを復帰
EXITPROC%
RETURN


'"INCLUDE FILE"ffoffset evnt.INCL"部分
'
' HyperXcmd.incl for calling all standard
' HyperCard callback routines from FutureBASIC
'
' ---------------------------------------------

INCLUDE FILE _resIncl

GLOBALS "ffoffset.GLBL"
END GLOBALS
'COMPILE 0,_pointerVars _appendRes _strResource 'xcmd リソースＰ力ファイルに追加
INCLUDE "ffoffset.INCL" 'あなた自身の xcmd ルーチン

' ･････････････････････････････････････････････
' ここが私の部分
' ･････････････････････････････････････････････

LOCAL FN MY_ERR (xCmdPtr&)
DIM 255 tmp$
strPtr& = @tmp$
tmp$ = "error" 'change for your xcmd

xCmdPtr&.inArgs0& = strPtr&'convert error message to
xCmdPtr&.xRequest% = _xReqPasToZero'C-string format (chars + nul)
FN JumpToCallback(xCmdPtr&)'enter callback routine
xCmdPtr&.returnValue& = xCmdPtr&.outArgs&'put C-string hndl into xcmdBlock
END FN


LOCAL FN SssOffset(xCmdPtr&,str255$)
DIM 255 tmp$
strPtr& = @tmp$
FN ZeroToPas (xCmdPtr&, [[xCmdPtr& + _params + 1 * 4]], str255$(1))
BYTBYT$ = str255$(1)
BYT& = LEN(BYTBYT$)
BYT& = BYT& - 1
fileSize& = FN GETHANDLESIZE([xCmdPtr& + _params + 0*4])' "元の文字列のサイズ
byte& = fileSize& * 3
convHandle& = FN NEWHANDLE(byte&)' "それの3倍リターンする。
LONG IF convHandle& = 0
'PRINT "■メモリ不足で変換できません"
FN MY_ERR(xCmdPtr&)
XELSE
err% = FN HLOCK(convHandle&):' "メモリが移動しないようにハンドルをロック"
pointer& = [convHandle&]:' "ポインタを求める"
pointer2& = pointer&
ININ%=ASC(" ") '"英字スペースをとりあえずハンドルにいれる
FOR t& = 1 TO byte&: ' "ファイルサイズ分繰り返す"
POKE pointer2&,ININ%
pointer2&=pointer2&+1
NEXT
count& = 0
WHILE count& < fileSize&
FN ZeroToPas (xCmdPtr&, [[xCmdPtr& + _params + 0 * 4]]+count&, str255$(0))
MOTO$ = str255$(0)
startPos& = 1
DO
foundPos& = INSTR(startPos&,MOTO$,BYTBYT$)'"0は検索もと　1は検索文字"
LONG IF foundPos&<>0
startPos& = foundPos& + 1
foundPos1& = foundPos& + count&
foundPos2& = foundPos1& + BYT&
AA$ = STR$(foundPos1&)
BB$ = STR$(foundPos2&)
AA2% = LEN(AA$)
BB2% = LEN(BB$)
AA2% = AA2% - 1
BB2% = BB2% - 1
AA3$ = MID$(AA$,2,AA2%)
BB3$ = MID$(BB$,2,BB2%)
CC$ = AA3$ + "," + BB3$ + CHR$(13)
CC2% = LEN(CC$)
FOR i& = 1 TO CC2%:' "ファイルサイズ分繰り返す"
IN$=MID$(CC$,i&,1)
ININ%=ASC(IN$)
POKE pointer&,ININ%
pointer&=pointer&+1
NEXT
tmp$ = tmp$ + CC$
END IF
UNTIL foundPos& <= 0
count& = count& + 253 - BYT&
WEND
END IF
xCmdPtr&.returnValue& = convHandle&'put C-string hndl into xcmdBlock
END FN