新しく発言する EXIT インデックスへ
ソースプログラムに色をつけ印刷保存しよう...
　　ソースプログラムに色をつけ印刷保存しよう！ 山中和義 2006/12/04 16:05:25 
　　├つづき 山中和義 2006/12/04 16:06:28 
　　└次の２つ箇所を修正してください。 山中和義 2006/12/05 13:56:16 

　　ソースプログラムに色をつけ印刷保存しよう！ 山中和義 2006/12/04 16:05:25  ツリーへ

ソースプログラムに色をつけ印刷保存しよう！ 返事を書く
山中和義 2006/12/04 16:05:25

!プログラムソースの可視性を向上させる　2006.12.4
!・行数を表示する
!・キーワードに色をつける - 注釈、文字列定数、文、組み込み関数
!
!使用方法
!　実行して、リスト表示させるソースプログラムを指定する。
!　テキスト画面のメニュー「ファイル」-「印刷」から用紙に印刷する。

FILE GETNAME FileName$ !リスト表示させるソースプログラムを指定する
!!LET Drive$="C:" !ドライブ名
!!LET Path$="\My Documents" !パス名
!!LET Source$="ソースプログラムに色をつける.BAS" !ファイル名
!!LET FileName$=Drive$&Path$&"\"&Source$

WHEN EXCEPTION IN
OPEN #1: NAME FileName$, ACCESS INPUT
USE
PRINT "該当するファイルがありません。"
STOP
END WHEN

CALL SetColor(0,0,0)
PRINT FileName$ !ファイル名を表示する
PRINT

LET LineNo=1
DO
LINE INPUT #1, IF MISSING THEN EXIT DO: r$ !１行読み込む

CALL SetColor(0,0,0)
PRINT USING "####: ":LineNo; !行番号をつける

CALL Parse(r$) !'構文解析


LET LineNo=LineNo+1 !次へ
LOOP
CLOSE #1

END

EXTERNAL SUB Parse(rr$) !構文を解析する
LET buf$=""
LET r$=rr$&" " !番兵
LET L=LEN(r$) !文字数を得る
LET i=1
DO WHILE i=<L !終端まで
LET c$=r$(i:i) !１文字を得る
IF c$="!" THEN !注釈
CALL FlushBuffer(buf$) !前を表示する
CALL SetColor(0,180,0) !以降を表示する
PRINT r$(i:L);
LET i=L
ELSE
IF c$=CHR$(34) THEN !文字列定数
CALL FlushBuffer(buf$) !前を表示する
LET t=POS(r$,CHR$(34),i+1)
CALL SetColor(180,0,80) !終了の引用符までを表示する
PRINT r$(i:t);
LET i=t
ELSE
IF isSepalate(c$)<0 THEN !分離文字なら
IF keyword$<>"" THEN !候補があれば
!!!!!CALL DebugPrint(keyword$)
LET Lk=LEN(keyword$) !キーワードの文字数を得る
IF isKeyword(keyword$)<0 THEN !機能語なら
LET buf$=buf$(1:LEN(buf$)-Lk) !キーワード部分を除いて表示する
CALL FlushBuffer(buf$)
CALL SetColor(0,0,255) !キーワードを表示する
PRINT keyword$;
END IF
IF isFunction(keyword$)<0 THEN !組み込み関数なら
LET buf$=buf$(1:LEN(buf$)-Lk)
CALL FlushBuffer(buf$)
CALL SetColor(200,0,200)
PRINT keyword$;
END IF
LET keyword$=""
END IF
ELSE
LET keyword$=keyword$&c$ !候補を確保する
END IF
LET buf$=buf$&c$
END IF
END IF
LET i=i+1 !次へ
LOOP

CALL FlushBuffer(buf$) !残りを表示する
PRINT

END SUB
 

　　├つづき 山中和義 2006/12/04 16:06:28  ツリーへ

Re: ソースプログラムに色をつけ印刷保存しよう！ 返事を書く
山中和義 2006/12/04 16:06:28
つづき

EXTERNAL FUNCTION isSepalate(c$) !分離文字か確認する
DATA " ","(",")","+","-","*","/","=","<",">",",","&",":",";"
LET isSepalate=0
DO
READ IF MISSING THEN EXIT DO: ky$
IF UCASE$(c$)=UCASE$(ky$) THEN !一致したら
LET isSepalate=-1
EXIT FUNCTION
END IF
LOOP
END FUNCTION

EXTERNAL FUNCTION isKeyword(c$) !機能語か確認する
DATA "LET","PRINT","USING","END","STOP","REM","GOTO" !文
DATA "IF","THEN","ELSE","ELSEIF","SELECT","CASE"
DATA "FOR","TO","STEP","NEXT","DO","WHILE","LOOP","UNTIL"
DATA "DIM","DATA","RESTORE","READ","DEF"
DATA "CALL","SUB","FUNCTION","PICTURE","EXTERNAL"
DATA "PROGRAM","MODULE","DECLARE","NUMERIC","STRING","PUBLIC","SHARE"
DATA "EXIT","WHEN","EXCEPTION","IN","USE","MISSING","CONTINUE","RETRY"
DATA "OPEN","NAME","ACCESS","INPUT","OUTPUT","CLOSE","WRITE","ERASE","RECTYPE","INTERNAL"
DATA "MAT","RANDOMIZE","OPTION","BASE","CHARACTER","DEGREES","DADIANS"
DATA "PLOT","AREA","LINES","POINTS","TEXT","SET","POINT","COLOR","LINE","STYLE","AT","JUSTIFY"
DATA "DRAW","WITH","SCALE","ROTATE","SHIFT"
DATA "WINDOW","VIEWPORT","DEVICE","CELLS"
DATA "WAIT","DELAY","ASK","PIXEL","SIZE","CLEAR","ECHO","PROMPT"

LET isKeyword=0
DO
READ IF MISSING THEN EXIT DO: ky$
IF UCASE$(c$)=UCASE$(ky$) THEN !一致したら
LET isKeyword=-1
EXIT FUNCTION
END IF
LOOP
END FUNCTION

EXTERNAL FUNCTION isFunction(c$) !組み込み関数か確認する
DATA "PI","RND","SIN","COS","TAN","ATN","ANGLE"
DATA "SQR","ABS","INT","MOD","ROUND","SGN","MIN","MAX","RND"
DATA "AND","OR","NOT"
DATA "LEN","POS","VAL","ORD"
DATA "REPEAT$","STR$","CHR$","LCASE$","UCASE$","LTRIM$","RTRIM$"
DATA "DATE","TIME","DATE$","TIME$"
DATA "BVAL","BSTR$"
DATA "CON","IDN","ZER","TRN","UBOUND"
DATA "TRANSFORM","NUL$"
DATA "EXLINE","EXTYPE","MAXNUM"

LET isFunction=0
DO
READ IF MISSING THEN EXIT DO: ky$
IF UCASE$(c$)=UCASE$(ky$) THEN !一致したら
LET isFunction=-1
EXIT FUNCTION
END IF
LOOP
END FUNCTION

EXTERNAL SUB FlushBuffer(s$) !バッファの文字を出力する
CALL SetColor(0,0,0) !元に戻す
PRINT s$;
LET s$=""
END SUB

EXTERNAL SUB SetColor(R,G,B) !RichEditコントロール
OPTION CHARACTER Byte
SUB SendMessage(hwnd,msg,wparam,lparam$)
assign "USER32.DLL","SendMessageA"
END SUB
LET EM_SETCHARFORMAT=BVAL("0444",16)
LET CHARFORMAT$=CHR$(60) & REPEAT$(CHR$(0),59)
LET CHARFORMAT$(8:8)=CHR$(64)
LET CHARFORMAT$(21:24)=CHR$(R) & CHR$(G) & CHR$(B) & CHR$(0)
CALL SendMessage(WinHandle("RICHEDIT"),EM_SETCHARFORMAT,1, CHARFORMAT$)
END SUB

EXTERNAL SUB DebugPrint(s$)
PRINT "---->";s$
END SUB
 

　　└次の２つ箇所を修正してください。 山中和義 2006/12/05 13:56:16  ツリーへ

Re: ソースプログラムに色をつけ印刷保存しよう！ 返事を書く
山中和義 2006/12/05 13:56:16
次の２つ箇所を修正してください。

EXTERNAL SUB Parse(rr$) !構文を解析する
LET r$=rr$&" " !番兵

LET buf$="" !クリアする
LET keyword$=""

LET L=LEN(r$) !文字数を得る
LET i=1 !最初から
DO WHILE i=<L !終端まで
LET c$=r$(i:i) !１文字を得る

IF isSepalate(c$)<0 THEN !分離文字なら
IF keyword$<>"" THEN !候補があれば
!!!!!CALL DebugPrint(keyword$)
LET Lk=LEN(keyword$) !キーワードの文字数を得る
IF isKeyword(keyword$)<0 THEN !機能語なら
LET buf$=buf$(1:LEN(buf$)-Lk) !キーワード部分を除いて表示する
CALL FlushBuffer(buf$)
CALL SetColor(0,0,255) !キーワードを表示する
PRINT keyword$;
END IF
IF isFunction(keyword$)<0 THEN !組み込み関数なら
LET buf$=buf$(1:LEN(buf$)-Lk)
CALL FlushBuffer(buf$)
CALL SetColor(200,0,200)
PRINT keyword$;
END IF
LET keyword$="" !クリアする
END IF
IF c$="!" THEN !注釈
CALL FlushBuffer(buf$) !前を表示する
CALL SetColor(0,180,0) !以降を表示する
PRINT r$(i:L);
LET i=L !ポインタを進める
LET c$="" !eat it
END IF
IF c$=CHR$(34) THEN !文字列定数
CALL FlushBuffer(buf$) !前を表示する
LET t=POS(r$,CHR$(34),i+1) !終了の引用符までを表示する
CALL SetColor(180,0,80)
PRINT r$(i:t);
LET i=t !ポインタを進める
LET c$="" !eat it
END IF
ELSE
LET keyword$=keyword$&c$ !候補を確保する
END IF
LET buf$=buf$&c$

LET i=i+1 !次へ
LOOP

CALL FlushBuffer(buf$) !残りを表示する
PRINT

END SUB

EXTERNAL FUNCTION isSepalate(c$) !分離文字か確認する
DATA " ","(",")","!","+","-","*","/","=","<",">","^",",",":",";","&"
!※除く　#$%'~|.?_\[]{}
LET isSepalate=0
IF UCASE$(c$)=CHR$(34) THEN !クォーテーションなら
LET isSepalate=-1
EXIT FUNCTION
END IF
DO
READ IF MISSING THEN EXIT DO: ky$
IF UCASE$(c$)=UCASE$(ky$) THEN !一致したら
LET isSepalate=-1
EXIT FUNCTION
END IF
LOOP
END FUNCTION

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。