home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 2
/
FreeSoftwareCollection2pd199x-jp.img
/
ms_dos
/
label
/
lbqb.bas
< prev
next >
Wrap
BASIC Source File
|
1990-06-14
|
30KB
|
1,367 lines
DECLARE SUB Write.Data ()
DECLARE SUB Data.Kill ()
DECLARE SUB DEF.Write ()
DECLARE SUB PF12.Key ()
DECLARE SUB BELL (Bell.Time AS INTEGER, FREQ AS INTEGER)
DECLARE SUB Gamen ()
DECLARE SUB Clear.MSG ()
DECLARE SUB Heiten ()
DECLARE SUB Func.ON (PF.Number AS INTEGER)
DECLARE SUB Set.KGM11 ()
DECLARE SUB Set.KGM12 ()
DECLARE SUB Set.KGM21 ()
DECLARE SUB Set.KGM22 ()
DECLARE SUB Data.Clear ()
DECLARE SUB Write.Left ()
DECLARE SUB Write.Center ()
DECLARE SUB Write.Right ()
DECLARE SUB PF11.Key ()
DECLARE SUB Text.Write ()
DECLARE SUB NO.Data ()
DECLARE SUB Boo ()
DECLARE SUB Data.Load ()
DECLARE SUB Data.Save ()
DECLARE SUB Text.Clear ()
' ┌───────┬────────────────────────┐
' │ プログラム名 │ LBQB.BAS (LB.EXE) │
' │ タ イ ト ル │ ラベルの印刷(簡易版印刷屋さん)Ver. 1.01 │
' │ プログラマー │ Yutaka Kondo │
' ├───────┼────────────────────────┤
' │ 使 用 機種 │ 富士通 FM TOWNS モデル2H │
' │ 使 用 言語 │ Microsoft QuickBASIC Version 4.2 (B285C140) │
' ├───────┼────────────────────────┤
' │ 制 作 日 付 │ For 1990.06.10 to 1990.06.10 │
' └───────┴────────────────────────┘
' サンプルプログラムのサブルーチンを使用させていただきました。(EDIT.BAS)
'$INCLUDE: 'EDIT.BI'
'----------------------- 初期設定
CLEAR
CLS : SCREEN 0: WIDTH 80, 25: COLOR 7, 0: LOCATE , , 0
VIEW PRINT
DIM SHARED In$(12)
DIM SHARED Saizu(12) AS INTEGER
DIM SHARED Sonota(5) AS INTEGER
DIM SHARED Ins AS INTEGER
DIM SHARED N AS INTEGER
DIM SHARED CY AS INTEGER
DIM SHARED Drive$
OPEN "\LABEL.DEF" FOR RANDOM AS 2 LEN = 35
FIELD #2, 20 AS Drive.Name$, 15 AS Sonota.Data$
GET #2, 1
Drive$ = Drive.Name$: SD$ = Sonota.Data$
P = 1
FOR I = 1 TO 5
Sonota(I) = VAL(MID$(SD$, P, 3))
P = P + 3
NEXT I
CLOSE #2
Drive$ = RTRIM$(Drive$)
' Sonota(1) = 印刷開始紙送り量(行)
' Sonota(2) = 左マージン(1/180インチ)
' Sonota(3) = 改行ピッチ(1/180インチ)
' Sonota(4) = 印刷後改ページ有り?
' Sonota(5) = ラインカーソル色 ?
CONST YN.MSG$ = "○:実 行 ×:取 消"
CONST ESC.MSG$ = " ESCキーで戻ります。 "
'==============================================================================
Gamen ' 画面描画
GOSUB Home.Key ' 初期処理 (DATA)
COLOR 7, 0
CY = 5: CX = 23
START:
DO: LOOP WHILE INKEY$ <> "" ' キーバッフアークリアー
GYO$ = CDBL$(RIGHT$(" " + MID$(STR$(CY - 4), 2), 2))
LOCATE 3, 23, 0
COLOR 7
PRINT USING "& &"; GYO$;
COLOR 3: PRINT "行"
COLOR 7
LOCATE CY, CX
Ins = 1
N = CY - 4
In$(N) = EDIT$(In$(N), 36, Arrow%, 0)
Clear.MSG
SELECT CASE Arrow%
CASE 1 ' リターンキー
GOSUB Pos.Down
CASE 9 ' ESC
Heiten
CASE -1 ' ↑ UP
GOSUB Pos.Up
CASE 1 ' ↓ DOWN
GOSUB Pos.Down
CASE 47 ' HOME
GOSUB Home.Key
CASE 11 ' PF1
Func.ON (1)
Set.KGM11
CASE 12 ' PF2
Func.ON (2)
Set.KGM12
CASE 13 ' PF3
Func.ON (3)
Set.KGM21
CASE 14 ' PF4
Func.ON (4)
Set.KGM22
CASE 15 ' PF5
Func.ON (5)
Data.Clear
CASE 16 ' PF6
Func.ON (6)
GOSUB Print.OUT
CASE 17 ' PF7
Func.ON (7)
Write.Left
CASE 18 ' PF8
Func.ON (8)
Write.Center
CASE 19 ' PF9
Func.ON (9)
Write.Right
CASE 20 ' PF10
Func.ON (10)
Heiten
CASE 21 ' PF11
PF11.Key
CASE 22 ' PF12
PF12.Key
CASE ELSE
CALL BELL(600, 32)
END SELECT
GOTO START
END
'==============================================================================
Pos.Up: IF CY = 5 THEN CY = 16: RETURN ELSE CY = CY - 1: RETURN
Pos.Down: IF CY = 16 THEN CY = 5: RETURN ELSE CY = CY + 1: RETURN
'------------------------------------------------------ 初期化
Home.Key:
FOR I = 1 TO 12
LOCATE I + 4, 10, 0
COLOR 7
PRINT "○ "
LOCATE I + 4, 23
PRINT SPACE$(36);
In$(I) = SPACE$(36)
Saizu(I) = 1
NEXT I
RETURN
'------------------------------------------------------ 印 刷
Print.OUT:
FOR N = 1 TO 12
IF In$(N) <= SPACE$(36) THEN ELSE GOTO Print.OK
NEXT N
NO.Data
RETURN
Print.OK:
CALL BELL(650, 32)
CALL BELL(650, 32)
COLOR 14
LOCATE 19, 31: PRINT " 印刷を行います。 "
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
Dame:
DO
A$ = INKEY$
LOOP WHILE A$ = ""
SELECT CASE A$
CASE CHR$(13)
Clear.MSG
GOTO Lprint.OK
CASE CHR$(24)
Clear.MSG
RETURN
CASE ELSE
CALL BELL(600, 32)
GOTO Dame
END SELECT
Lprint.OK:
ON ERROR GOTO Printer.Error
LPRINT CHR$(27); "c"; ' リセット
GOSUB Print.LP ' カイギョウ ピッチ
GOSUB Print.LMRG ' レフト マ-ジン
FOR LP = 1 TO Sonota(1): LPRINT : NEXT LP ' 紙送り
COLOR 22
LOCATE 20, 30: PRINT " ** 印 刷 中 ** "
COLOR 7
FOR P = 1 TO 12
SELECT CASE Saizu(P)
CASE 1
GOSUB Print.KGM11
CASE 2
GOSUB Print.KGM12
CASE 3
GOSUB Print.KGM21
CASE 4
GOSUB Print.KGM22
END SELECT
LPRINT In$(P)
NEXT P
IF Sonota(4) = 1 THEN LPRINT CHR$(12); ' フォームフィード
LOCATE 20, 30: PRINT SPACE$(30);
Print.END: ' 印刷終了
RETURN
'------------------------------------------------------ ぷりんたーえらー
Printer.Error:
CALL BELL(800, 32)
CALL BELL(620, 40)
COLOR 13
LOCATE 20, 28: PRINT " プリンターを確認して下さい。"
COLOR 7
RESUME Print.END
'------------------------------------------------------ 改行ピッチ
Print.LP:
J = Sonota(3)
P1 = INT(J / 10)
P2 = INT(J - (P1 * 10))
LPRINT CHR$(28); "%";
LPRINT CHR$(&H20 + P1); CHR$(&H70 + P2);
RETURN
'------------------------------------------------------ 左マージン
Print.LMRG:
J = Sonota(2)
P1 = INT(J / 1000)
P2 = INT((J - P1 * 1000) / 100)
P3 = INT((J - (P1 * 1000 + P2 * 100)) / 10)
P4 = INT(J - (P1 * 1000 + P2 * 100 + P3 * 10))
LPRINT CHR$(27); "Q";
LPRINT CHR$(&H31); CHR$(&H38);
LPRINT ";";
LPRINT CHR$(&H30 + P1); CHR$(&H30 + P2);
LPRINT CHR$(&H30 + P3); CHR$(&H30 + P4);
LPRINT " Q";
RETURN
'------------------------------------------------------ 標 準
Print.KGM11:
LPRINT CHR$(28); "$"; ' 漢字文字ピッチ27/180
LPRINT CHR$(&H22); CHR$(&H77);
LPRINT CHR$(28); "'";
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H70);
RETURN
'------------------------------------------------------ 横 倍
Print.KGM12:
LPRINT CHR$(28); "$"; ' 漢字文字ピッチ24/180
LPRINT CHR$(&H22); CHR$(&H74);
LPRINT CHR$(28); "'";
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H70);
RETURN
'------------------------------------------------------ 縦 倍
Print.KGM21:
' LPRINT CHR$(28); "."; "t";
LPRINT CHR$(28); "'";
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H70);
RETURN
'------------------------------------------------------ 4 倍
Print.KGM22:
LPRINT CHR$(28); "$"; ' 漢字文字ピッチ24/180
LPRINT CHR$(&H22); CHR$(&H74);
' LPRINT CHR$(28); "."; "t";
LPRINT CHR$(28); "'";
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H70);
RETURN
'==============================================================================
DEFINT A-Z
SUB BELL (Bell.Time AS INTEGER, FREQ AS INTEGER)
DIM inreg AS RegType, outreg AS RegType
inreg.ax = &H500 ' MOV AH,05H
inreg.bx = FREQ ' MOV BX,FREQ 周波数
inreg.dx = Bell.Time ' MOV DX,TIME 時間
INTERRUPT &H9E, inreg, outreg ' INT 9EH
' MOV CX,TIMECNT
FOR I = 1 TO 10000: NEXT ' INT 0FDH ソフトタイマ
FOR I = 1 TO 20000: NEXT ' コンパイル スルト ハヤク ナルタメ ツイカ
FOR I = 1 TO 10000: NEXT
FOR I = 1 TO 20000: NEXT
END SUB
DEFSNG A-Z
'----------------------------
' ぶー
'----------------------------
SUB Boo
CALL BELL(500, 32)
CALL BELL(500, 32)
COLOR 12
LOCATE 20, 31, 0
PRINT "この行は、出来ません。"
COLOR 7
END SUB
'----------------------------
' めっせーじくりあー
'----------------------------
SUB Clear.MSG
LOCATE , , 0
LOCATE 19, 26: PRINT SPACE$(40);
LOCATE 20, 26: PRINT SPACE$(40);
LOCATE 21, 26: PRINT SPACE$(40);
LOCATE 23, 1: PRINT SPACE$(79);
END SUB
DEFINT A-Z
'----------------------------
' データ削除
'----------------------------
SUB Data.Clear
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
CALL BELL(650, 36)
CALL BELL(650, 36)
COLOR 13
LOCATE 19, 31: PRINT "削除していいですか? "
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
Input.Check:
DO
A$ = INKEY$
LOOP WHILE A$ = ""
SELECT CASE A$
CASE CHR$(13)
Clear.MSG
In$(N) = SPACE$(36)
Saizu(N) = 1
LOCATE CY, 23
PRINT SPACE$(36);
LOCATE CY, 10
PRINT "○ "
CASE CHR$(24)
Clear.MSG
CASE ELSE
CALL BELL(600, 32)
GOTO Input.Check
END SELECT
END SUB
'----------------------------
' データさくじょ
'----------------------------
SUB Data.Kill
SHARED Data.Name$
SHARED Load.Data$
SHARED Load.Saizu$
COLOR 6
LOCATE 19, 18
PRINT "前ペ-ジ:前行 次ペ-ジ:次行 入力:その他のキー"
LOCATE 21, 22
PRINT "入力で、リターンキーのみは、終了します。"
COLOR 7
Write.Data
KillNo.INPUT:
LOCATE 16, 23, 1
INPUT " 削除 番号を入れて下さい。 ", Kill.No$
LOCATE , , 0
Kill.No.Check$ = LEFT$(Kill.No$, 1)
SELECT CASE Kill.No.Check$
CASE IS <= ""
CLOSE #1: EXIT SUB
CASE IS <= CHR$(&H2F), IS >= CHR$(&H3A)
CALL BELL(600, 32)
LOCATE 16, 50: PRINT SPACE$(10);
GOTO KillNo.INPUT
END SELECT
OPEN Drive$ + "LABEL.BAK" FOR RANDOM AS 3 LEN = 454
FIELD #3, 454 AS BAK.Data$
BAK.Count = 0
FOR BAK = 1 TO LOF(1) \ 454
IF BAK = VAL(Kill.No$) THEN GOTO Save.NEXT
BAK.Dmy$ = ""
GET #1, BAK
BAK.Dmy$ = Data.Name$ + Load.Data$ + Load.Saizu$
BAK.Count = BAK.Count + 1
LSET BAK.Data$ = BAK.Dmy$
PUT #3, BAK.Count
Save.NEXT:
NEXT BAK
CLOSE
KILL Drive$ + "LABEL.DAT"
NAME Drive$ + "LABEL.BAK" AS Drive$ + "LABEL.DAT"
END SUB
'----------------------------
' データろーど
'----------------------------
SUB Data.Load
SHARED Data.Name$
SHARED Load.Data$
SHARED Load.Saizu$
COLOR 3
LOCATE 19, 18
PRINT "前ペ-ジ:前行 次ペ-ジ:次行 入力:その他のキー"
LOCATE 21, 22
PRINT "入力で、リターンキーのみは、終了します。"
COLOR 7
Write.Data
No.INPUT:
LOCATE 16, 23, 1
INPUT " 読込 番号を入れて下さい。 ", Load.No$
LOCATE , , 0
Load.No.Check$ = LEFT$(Load.No$, 1)
SELECT CASE Load.No.Check$
CASE IS <= ""
CLOSE #1: EXIT SUB
CASE IS <= CHR$(&H2F), IS >= CHR$(&H3A)
CALL BELL(600, 32)
LOCATE 16, 50: PRINT SPACE$(10);
GOTO No.INPUT
END SELECT
GET #1, VAL(Load.No$)
P = 1
FOR N = 1 TO 12
In$(N) = MID$(Load.Data$, P, 36)
Saizu(N) = VAL(MID$(Load.Saizu$, N, 1))
P = P + 36
NEXT N
CLOSE #1
END SUB
'----------------------------
' データせーぶ
'----------------------------
SUB Data.Save
FOR N = 1 TO 12
IF In$(N) <= SPACE$(36) THEN ELSE GOTO Save.OK
NEXT N
NO.Data
EXIT SUB
Save.OK:
LINE (276, 189)-(363, 210), 0, BF
OPEN Drive$ + "LABEL.DAT" FOR RANDOM AS 1 LEN = 454
FIELD #1, 10 AS Data.Name$, 432 AS Data.Fld$, 12 AS Saizu.Fld$
Recnum = LOF(1) \ 454
COLOR 19
LOCATE 5, 23: PRINT " ちょっとだけふぁいる Save "
COLOR 7
LOCATE 7, 23: PRINT " 名前は、半角文字で10文字"
LOCATE 8, 23: PRINT " 全角文字で 5文字"
LOCATE 11, 23: PRINT " セーブ名前は?"
Name.IN:
LOCATE 16, 23: PRINT ESC.MSG$
Ins = 1
LOCATE 13, 36
Save.Name$ = EDIT$(Save.Name$, 10, Arrow%, 0)
SELECT CASE Arrow%
CASE 1 ' リターンキー
CASE 9 ' ESC
CLOSE #1: EXIT SUB
CASE -1 ' ↑ UP
CALL BELL(600, 32)
GOTO Name.IN
CASE 1 ' ↓ DOWN
END SELECT
IF Save.Name$ <= "" OR Save.Name$ <= SPACE$(10) THEN CLOSE #1: EXIT SUB
LOCATE 16, 23: PRINT " "
COLOR 14
LOCATE 19, 31: PRINT " よろしいですか?"
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
INPUT.S:
DO
A$ = INKEY$
LOOP WHILE A$ = ""
IF A$ = CHR$(13) THEN
GOTO Data.Save.OK
ELSEIF A$ = CHR$(24) THEN
Clear.MSG
GOTO Name.IN
ELSE CALL BELL(600, 32)
GOTO INPUT.S
END IF
Data.Save.OK:
Save.Data$ = ""
Save.Saizu$ = ""
FOR I = 1 TO 12
Save.Data$ = Save.Data$ + LEFT$(In$(I) + SPACE$(36), 36)
Save.Saizu$ = Save.Saizu$ + RIGHT$(" " + MID$(STR$(Saizu(I)), 2), 1)
NEXT I
LSET Data.Name$ = Save.Name$
LSET Data.Fld$ = Save.Data$
LSET Saizu.Fld$ = Save.Saizu$
Recnum = Recnum + 1
PUT #1, Recnum
CLOSE #1
END SUB
SUB DEF.Write
LOCATE 7, 23: PRINT " データドライブ 設定 "
LOCATE 9, 23: PRINT " "
LOCATE 10, 23: PRINT " "
LOCATE 11, 23: PRINT " "
LINE (236, 189)-(403, 210), 0, BF
OPEN Drive$ + "LABEL.DEF" FOR RANDOM AS 2 LEN = 35
FIELD #2, 20 AS Drive.Name$, 15 AS Sonota.Data$
GET #2, 1
DN$ = Drive.Name$: SD$ = Sonota.Data$
LOCATE 11, 23: PRINT " ドライブ名を入力して下さい。"
DName.IN:
LOCATE 16, 23: PRINT ESC.MSG$
Ins = 0
LOCATE 13, 31
DN$ = EDIT$(DN$, 20, Arrow%, 0)
SELECT CASE Arrow%
CASE 1 ' リターンキー
CASE 9 ' ESC
CLOSE #2: EXIT SUB
CASE -1 ' ↑ UP
CALL BELL(600, 32)
GOTO DName.IN
CASE 1 ' ↓ DOWN
END SELECT
IF DN$ <= "" OR DN$ <= SPACE$(20) THEN CLOSE #2: EXIT SUB
LOCATE 16, 23: PRINT " "
COLOR 14
LOCATE 19, 31: PRINT " よろしいですか?"
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
INPUT.D:
DO
A$ = INKEY$
LOOP WHILE A$ = ""
IF A$ = CHR$(13) THEN
GOTO Data2.Save.OK
ELSEIF A$ = CHR$(24) THEN
Clear.MSG
GOTO DName.IN
ELSE CALL BELL(600, 32)
GOTO INPUT.D
END IF
Data2.Save.OK:
LSET Drive.Name$ = LEFT$(DN$, 20)
LSET Sonota.Data$ = SD$
PUT #2, 1
CLOSE #2
Drive$ = RTRIM$(DN$)
END SUB
'----------------------------
' サンプルからちょっとかりました
'----------------------------
FUNCTION EDIT$ (Arg$, Length, Arrow, strflag)
X0 = POS(0)
Y0 = CSRLIN: IF X0 + Length > 80 THEN ERROR 5
ChangeFlag = 1
IF Sonota(5) = 0 THEN COLOR 23 ELSE COLOR Sonota(5)
dx = 0
' Ins = 1
tmp$ = LEFT$(Arg$ + SPACE$(Length), Length)
DO
IF dx >= Length THEN dx = Length - 1 ELSE dx = dx
Keta$ = CDBL$(RIGHT$(" " + MID$(STR$(dx + 1), 2), 2))
LOCATE 3, 29, 0
COLOR 7
PRINT USING "& &"; Keta$;
COLOR 3
PRINT "桁"
IF Sonota(5) = 0 THEN COLOR 22 ELSE COLOR Sonota(5)
MaxCharNum = KLEN(tmp$)
FOR I = 1 TO MaxCharNum
IF KPOS(tmp$, I) <= Length THEN MaxByte = KPOS(tmp$, I)
NEXT
IF dx + 1 >= Length THEN dx = MaxByte - 1
LastByte = ASC(MID$(tmp$, MaxByte, 1))
IF LastByte >= &H80 AND (LastByte < &HA0 OR LastByte > &HDF) THEN
IF MaxByte = Length THEN
tmp$ = LEFT$(tmp$, MaxByte - 1) + " "
END IF
END IF
' CharNum = MaxCharNum + 1 ' 一番右で削除キーを押すとエラーになる?
CharNum = MaxCharNum
FOR I = 1 TO MaxCharNum - 1
IF KPOS(tmp$, I) = dx + 1 THEN CharNum = I
NEXT
tmp$ = LEFT$(tmp$ + SPACE$(Length), Length)
IF ChangeFlag = 1 THEN
LOCATE Y0, X0, 0
PRINT tmp$;
ChangeFlag = 0
END IF
COLOR 6
IF Ins = 0 THEN
LOCATE 3, 52: PRINT " 上 書 "
ELSE LOCATE 3, 52: PRINT " 挿 入 "
END IF
IF Sonota(5) = 0 THEN COLOR 22 ELSE COLOR Sonota(5)
LOCATE Y0, X0 + dx, 1, Ins * 13, 15
DO
A$ = INKEY$
LOOP WHILE A$ = ""
SELECT CASE A$
'上矢印
CASE CHR$(0, &H48)
Arrow = -1
EXIT DO
'下矢印
CASE CHR$(0, &H50)
Arrow = 1
EXIT DO
'リターン
CASE CHR$(13)
Arrow = 1
EXIT DO
'左矢印
CASE CHR$(0) + CHR$(&H4B)
dx = dx - 1
IF dx < 0 THEN
dx = 0
ELSE
IF SCREEN(Y0, X0 + dx) >= 256 THEN dx = dx - 1
END IF
'右矢印
CASE CHR$(0) + CHR$(&H4D)
IF SCREEN(Y0, X0 + dx) >= 256 THEN dx = dx + 1
dx = dx + 1
'インサートキー
CASE CHR$(0) + CHR$(&H52)
Ins% = -(Ins% - 1)
'デリートキー
CASE CHR$(0) + CHR$(&H53)
ChangeFlag = 1
tmp$ = KMID$(tmp$, 1, CharNum - 1) + KMID$(tmp$, CharNum + 1, LEN(tmp$) - CharNum) + " "
'バックスペース
CASE CHR$(8)
ChangeFlag = 1
dx = dx - 1
IF dx < 0 THEN
CALL BELL(600, 32)
dx = 0
GOTO NOBS
ELSE
IF SCREEN(Y0, X0 + dx) >= 256 THEN dx = dx - 1
END IF
IF CharNum >= 2 THEN tmp$ = KMID$(tmp$, 1, CharNum - 2) + KMID$(tmp$, CharNum, LEN(tmp$) - CharNum + 1) + " "
IF CharNum = 1 THEN tmp$ = KMID$(tmp$, 1, CharNum - 1) + KMID$(tmp$, CharNum + 1, LEN(tmp$) - CharNum) + " "
NOBS:
'ESCキー
CASE CHR$(&H1B)
Arrow = 9
EXIT DO
'ホーム
CASE CHR$(0, &H47)
Arrow = 47
EXIT DO
'ヘルプ
CASE CHR$(0, &H4F)
dx = LEN(RTRIM$(tmp$))
'文字入力
CASE IS >= " "
ChangeFlag = 1
IF strflag = 0 OR (strflag < 0 AND ASC(A$) < 256) OR (strflag > 0 AND ASC(A$) >= 256) THEN
IF Ins = 0 THEN
tmp$ = tmp$ + " "
KMID$(tmp$, CharNum, 1) = A$
ELSE
tmp$ = KMID$(tmp$, 1, CharNum - 1) + A$ + KMID$(tmp$, CharNum, LEN(tmp$) - CharNum + 1)
END IF
IF ASC(A$) >= 256 THEN dx = dx + 1
dx = dx + 1
END IF
CASE CHR$(0, &H3B) ' PF1
Arrow = 11
EXIT DO
CASE CHR$(0, &H3C) ' PF2
Arrow = 12
EXIT DO
CASE CHR$(0, &H3D) ' PF3
Arrow = 13
EXIT DO
CASE CHR$(0, &H3E) ' PF4
Arrow = 14
EXIT DO
CASE CHR$(0, &H3F) ' PF5
Arrow = 15
EXIT DO
CASE CHR$(0, &H40) ' PF6
Arrow = 16
EXIT DO
CASE CHR$(0, &H41) ' PF7
Arrow = 17
EXIT DO
CASE CHR$(0, &H42) ' PF8
Arrow = 18
EXIT DO
CASE CHR$(0, &H43) ' PF9
Arrow = 19
EXIT DO
CASE CHR$(0, &H44) ' PF10
Arrow = 20
EXIT DO
CASE CHR$(0, &H85) ' PF11
Arrow = 21
EXIT DO
CASE CHR$(0, &H86) ' PF12
Arrow = 22
EXIT DO
END SELECT
LOOP WHILE 1
COLOR 7
LOCATE Y0, X0, 0
PRINT tmp$;
EDIT$ = RTRIM$(tmp$)
END FUNCTION
DEFSNG A-Z
'----------------------------
' ふぁんくしょんきー インジケータ
'----------------------------
SUB Func.ON (PF.Number AS INTEGER)
SELECT CASE PF.Number
CASE IS <= 5
PFpos = (PF.Number * 6)
CASE IS > 5
PFpos = (PF.Number * 6) + 1
END SELECT
LOCATE 23, PFpos, 0
COLOR 14
PRINT "ON";
COLOR 7
END SUB
DEFINT A-Z
'----------------------------
' 画面描画
'----------------------------
SUB Gamen
LINE (0, 0)-(116, 16), 7, BF
LINE (116, 0)-(639, 16), 3, BF
COLOR 8
LOCATE 1, 2: PRINT "FM TOWNS"
LOCATE 1, 27: PRINT "** 簡易版印刷屋さん **"
LOCATE 1, 68
TUKI$ = RIGHT$(" " + STR$(VAL(MID$(DATE$, 6, 2))), 2)
HI$ = RIGHT$(" " + STR$(VAL(MID$(DATE$, 9))), 2)
PRINT USING "& &月& &日"; CDBL$(TUKI$); CDBL$(HI$)
FOR L = 4 TO 16
LINE (72, L * 16)-(160, L * 16), 8
NEXT L
LINE (402, 29)-(468, 51), 7, B
LINE (172, 60)-(468, 260), 7, B ' 全角
LINE (336, 61)-(336, 259), 8 ' 倍角
COLOR 2
LOCATE 3, 10: PRINT "標 横 縦 4"
COLOR 7
x1 = 36: y1 = 367: x2 = 75: y2 = 384
bytes = 4 + 4 * INT(((x2 - x1 + 1) * 7) / 8) * (y2 - y1 + 1)
DIM PFKey(bytes / 2 / 2) AS INTEGER
LINE (x1, y1)-(x2, y2), 3, BF
GET (x1, y1)-(x2, y2), PFKey
LINE (x1, y1)-(x2, y2), 0, BF
P = 5
FOR I = 1 TO 12
PUT (x1, y1), PFKey, PSET
x1 = (8 * (P + 6) - 4)
P = P + 6
IF P = 35 THEN P = 36: x1 = 284 ' PF6 - PF10
IF P = 66 THEN P = 67: x1 = 532 ' PF11,PF12
NEXT I
COLOR 8
LOCATE 24, 5
PRINT " 標準 横倍 縦倍 4倍 削除 ";
PRINT " 印刷 左寄 中央 右寄 終了 設定 ファイル ";
END SUB
'----------------------------
' みせじまい?
'----------------------------
SUB Heiten
CALL BELL(800, 32)
CALL BELL(620, 40)
COLOR 14
LOCATE 19, 31: PRINT "閉店してもよいですか?"
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
SAIDO:
DO
A$ = INKEY$
LOOP WHILE A$ = ""
IF A$ = CHR$(13) THEN
LOCATE , , 0
COLOR 7, 0
CLS
END
ELSEIF A$ = CHR$(24) THEN
Clear.MSG
EXIT SUB
ELSE CALL BELL(600, 32)
GOTO SAIDO
END IF
END SUB
SUB NO.Data
CALL BELL(800, 32)
CALL BELL(620, 40)
COLOR 11
LOCATE 20, 31, 0
PRINT "データが、ありません。"
COLOR 7
END SUB
'----------------------------
' ぷりんたーちょっとだけ設定
'----------------------------
SUB PF11.Key
DIM SONO$(5)
CCY = 7: CCX = 45
Text.Clear
PAINT (330, 61), 1, 7
COLOR 22
LOCATE 5, 23: PRINT " ちょっとだけ設定 "
COLOR 3
LOCATE 7, 23: PRINT "印刷開始紙送り量(行) 行"
LOCATE 8, 23: PRINT "左マージン(1/180インチ)"
LOCATE 9, 23: PRINT "改行ピッチ(1/180インチ) 1 から 60"
LOCATE 10, 23: PRINT "印刷後改ページ有り? 0:無 1:有"
LOCATE 11, 23: PRINT "ラインカーソル色 ? 1 から 31"
COLOR 7
LOCATE 13, 23: PRINT "ラインカーソル色 0 は、22 です。"
LOCATE 16, 23: PRINT ESC.MSG$
FOR I = 1 TO 5
SONO$(I) = MID$(STR$(Sonota(I)), 2)
LOCATE I + 6, 45: PRINT USING "& &"; SONO$(I)
NEXT I
' Sonota(1) = 印刷開始紙送り量(行)
' Sonota(2) = 左マージン(1/180インチ)
' Sonota(3) = 改行ピッチ(1/180インチ)
' Sonota(4) = 印刷後改ページ有り?
' Sonota(5) = ラインカーソル色 ?
F11START:
LOCATE CCY, CCX
Ins = 0
I = CCY - 6
SONO$(I) = EDIT$(SONO$(I), 3, Arrow%, 0)
Sonota(I) = VAL(SONO$(I))
LOCATE CCY, 45: PRINT USING "& &"; SONO$(I)
IF Sonota(3) = 0 OR Sonota(3) > 60 THEN CALL BELL(600, 32): Sonota(3) = 30: GOTO F11START
IF Sonota(4) > 1 THEN CALL BELL(600, 32): Sonota(4) = 0: GOTO F11START
IF Sonota(5) > 31 THEN CALL BELL(600, 32): Sonota(5) = 0: GOTO F11START
SELECT CASE Arrow%
CASE 1 ' リターンキー
GOSUB Down.Pos
CASE 9 ' ESC
Text.Clear
PAINT (330, 61), 0, 7
LINE (336, 61)-(336, 259), 8 ' 倍角
Text.Write
OPEN Drive$ + "LABEL.DEF" FOR RANDOM AS 2 LEN = 35
FIELD #2, 20 AS Drive.Name$, 15 AS Sonota.Data$
GET #2, 1
DN$ = Drive.Name$: SD$ = ""
FOR WD = 1 TO 5
SD$ = SD$ + RIGHT$(" " + SONO$(WD), 3)
NEXT WD
LSET Drive.Name$ = DN$
LSET Sonota.Data$ = SD$
PUT #2, 1
CLOSE #2
EXIT SUB
CASE -1 ' ↑ UP
GOSUB Up.Pos
CASE 1 ' ↓ DOWN
GOSUB Down.Pos
END SELECT
GOTO F11START
Up.Pos: IF CCY = 7 THEN CCY = 11: RETURN ELSE CCY = CCY - 1: RETURN
Down.Pos: IF CCY = 11 THEN CCY = 7: RETURN ELSE CCY = CCY + 1: RETURN
END SUB
'----------------------------
' ちょっとだけ ふぁいる
'----------------------------
SUB PF12.Key
CCY = 7: CCX = 45
Text.Clear
PAINT (330, 61), 1, 7
COLOR 19
LOCATE 5, 23: PRINT " ちょっとだけふぁいる "
COLOR 7
LOCATE 7, 23: PRINT " PF 1:データドライブ 設定 "
LOCATE 9, 23: PRINT " PF11:データ読込 Data Load"
LOCATE 10, 23: PRINT " PF12:データ登録 Data Save"
LOCATE 11, 23: PRINT " 削 除 :データ削除 Data Kill"
LOCATE 16, 23: PRINT ESG.MSG$
F12START:
DO
A$ = INKEY$
LOOP WHILE A$ = ""
SELECT CASE A$
CASE CHR$(&H1B) ' ESC
CASE CHR$(0, &H3B) ' PF1
DEF.Write
CASE CHR$(0, &H85) ' PF11
Text.Clear
Data.Load
CASE CHR$(0, &H86) ' PF12
Text.Clear
Data.Save
CASE CHR$(0, &H53) ' 削 除
Text.Clear
Data.Kill
CASE ELSE
CALL BELL(600, 32)
GOTO F12START
END SELECT
Text.Clear
PAINT (330, 61), 0, 7
LINE (336, 61)-(336, 259), 8 ' 倍角
LOCATE 19, 18: PRINT SPACE$(60);
LOCATE 21, 22: PRINT SPACE$(40);
Text.Write
END SUB
'----------------------------
' ひょうじゅん
'----------------------------
SUB Set.KGM11
Saizu(N) = 1
LOCATE N + 4, 10: PRINT "○ "
END SUB
'----------------------------
' よこばいかく
'----------------------------
SUB Set.KGM12
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
Saizu(N) = 2
LOCATE N + 4, 10: PRINT " ○ "
END SUB
'----------------------------
' たてばいかく
'----------------------------
SUB Set.KGM21
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
' IF N = 1 THEN GOTO S21OK
IF N = 12 THEN Boo: EXIT SUB
IF In$(N + 1) <= SPACE$(36) THEN ELSE Boo: EXIT SUB
S21OK:
Saizu(N) = 3
LOCATE N + 4, 10: PRINT " ○ "
END SUB
'----------------------------
' よんばいかく
'----------------------------
SUB Set.KGM22
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
' IF N = 1 THEN GOTO KGM22.OK
IF N = 12 THEN Boo: EXIT SUB
IF In$(N + 1) <= SPACE$(36) THEN ELSE Boo: EXIT SUB
KGM22.OK:
Saizu(N) = 4
LOCATE N + 4, 10
PRINT " ○"
END SUB
'----------------------------
' でーたがめんくりあー
'----------------------------
SUB Text.Clear
FOR I = 1 TO 12
LOCATE I + 4, 23
PRINT SPACE$(36);
NEXT I
END SUB
'----------------------------
' でーた ひょうじ
'----------------------------
SUB Text.Write
COLOR 7
FOR N = 1 TO 12
SELECT CASE Saizu(N)
CASE 1
Set.KGM11
CASE 2
Set.KGM12
CASE 3
Set.KGM21
CASE 4
Set.KGM22
END SELECT
LOCATE N + 4, 23: PRINT In$(N)
NEXT N
END SUB
'----------------------------
' せんたりんぐ
'----------------------------
SUB Write.Center
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
In$(N) = LTRIM$(In$(N)) ' 先頭空白文字の除去
Dmy$ = LEFT$(In$(N), 2)
SNSP = KLEN(In$(N))
' IF SSP < 2 THEN RETURN
IF ASC(Dmy$) <= 255 THEN ' ANK
SSP = (36 - SNSP) \ 2
In$(N) = LEFT$((SPACE$(SSP) + In$(N)), 36)
ELSE ' 漢字
SSP = (18 - SNSP) \ 2
In$(N) = LEFT$((STRING$(SSP, " ") + In$(N)), 36)
' 全角スペース
END IF
LOCATE CY, 23: PRINT SPACE$(36);
LOCATE CY, 23: PRINT In$(N);
END SUB
DEFSNG A-Z
SUB Write.Data
SHARED Data.Name$
SHARED Load.Data$
SHARED Load.Saizu$
OPEN Drive$ + "LABEL.DAT" FOR RANDOM AS 1 LEN = 454
FIELD #1, 10 AS Data.Name$, 432 AS Load.Data$, 12 AS Load.Saizu$
MaxRecnum = LOF(1) \ 454
Dmy.Name$ = ""
FOR LD = 1 TO MaxRecnum
GET #1, LD
Dmy.Name$ = Dmy.Name$ + Data.Name$
NEXT LD
Write.Start:
P = 1: PC = 1: Page = 1
Write.Data:
Page.No$ = CDBL$(RIGHT$(" " + MID$(STR$(Page), 2), 2))
COLOR 3
LOCATE 5, 30
PRINT USING "番号 名 前 ページ & &"; Page.No$;
COLOR 7
FOR I = 1 TO 10
LOCATE I + 5, 30
PRINT CDBL$(RIGHT$(" " + MID$(STR$(PC), 2), 2)); " ";
PData$ = MID$(Dmy.Name$, P, 10)
IF PData$ <= "" THEN PData$ = SPACE$(10)
PRINT PData$
P = P + 10
PC = PC + 1
NEXT I
DO
A$ = INKEY$
LOOP WHILE A$ = ""
SELECT CASE A$
CASE CHR$(0, &H51) ' 次行
Page = Page + 1
GOTO Write.Data
CASE CHR$(0, &H49) ' 前行
PC = PC - 20
Page = Page - 1
IF Page <= 1 THEN GOTO Write.Start
P = P - 10
GOTO Write.Data
CASE ELSE
EXIT SUB
END SELECT
END SUB
DEFINT A-Z
'----------------------------
' ひだりよせ
'----------------------------
SUB Write.Left
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
In$(N) = LTRIM$(In$(N)) ' 先頭空白文字の除去
LOCATE CY, 23: PRINT SPACE$(36);
LOCATE CY, 23: PRINT In$(N);
END SUB
'----------------------------
' みぎよせ
'----------------------------
SUB Write.Right
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
In$(N) = LTRIM$(In$(N)) ' 先頭空白文字の除去
Dmy$ = LEFT$(In$(N), 2)
MNSP = KLEN(In$(N))
' IF MNSP => 25 THEN RETURN
IF ASC(Dmy$) <= 255 THEN ' ANK
MSP = 36 - MNSP
In$(N) = MID$((SPACE$(MSP) + In$(N)), 1, 36)
ELSE ' 漢字
MSP = 18 - MNSP
In$(N) = MID$((STRING$(MSP, " ") + In$(N)), 1, 36)
' 全角スペース
END IF
LOCATE CY, 23: PRINT SPACE$(36);
LOCATE CY, 23: PRINT In$(N);
END SUB