home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 2
/
FreeSoftwareCollection2pd199x-jp.img
/
fbasic
/
scanner
/
gts_25.bas
< prev
next >
Wrap
BASIC Source File
|
1990-06-14
|
6KB
|
172 lines
10 '**************************
20 '* F-BASIC386 << SCANNER PROGRAM >> *
30 '* COLOR IMAGE SCANNER * 256 COLOR 9600bps * *
40 '* GT-1000(GT-1000mode GT-3000Vmode), GT-4000 *
50 '* COPYRIGHT FUJITSU LIMITED 1989 *
60 '* *
70 '* (AUTHOR) : HIDENORI-ISHIKIRIYAMA. *
80 '* (DATE.W) : 1989. 7.13 *
90 '**************************
100 '
110 CLS
120 SCREEN@ 2
130 COLOR 6 : LOCATE 31,8 : PRINT "画像処理中 !!" : COLOR 7
140 DEFLNG A-Y
150 DEFDBL Z
160 DIM CH(161),QQ(2,255)
170 FOR I=1 TO 128
180 READ QQ(0,I)
190 NEXT I
200 DATA 0,8192,8192,16384,16384,24576,24576,32768,32768,40960,40960
210 DATA 49152,49152,57344,57344,0,0,8192,8192,16384,16384,24576,24576
220 DATA 32768,32768,40960,40960,49152,49152,57344,57344,32,32,8224,8224
230 DATA 16416,16416,24608,24608,32800,32800,40992,40992,49184,49184
240 DATA 57376,57376,32,32,8224,8224,16416,16416,24608,24608,32800,32800
250 DATA 40992,40992,49184,49184,57376,57376,64,64,8256,8256,16448,16448
260 DATA 24640,24640,32832,32832,41024,41024,49216,49216,57408,57408,64
270 DATA 64,8256,8256,16448,16448,24640,24640,32832,32832,41024,41024
280 DATA 49216,49216,57408,57408,96,96,8288,8288,16480,16480,24672,24672
290 DATA 32864,32864,41056,41056,49248,49248,57440,57440,96,96,8288,8288
300 DATA 16480,16480,24672,24672,32864,32864,41056,41056,49248,49248
310 DATA 57440,57440,128
320 FOR I=1 TO 127
330 QQ(0,I+128)=128+QQ(0,I)
340 NEXT I
350 FOR J=1 TO 255
360 QQ(1,J)=QQ(0,J)/8
370 QQ(2,J)=INT(QQ(0,J)/64) AND &HFF7F
380 NEXT J
390 CC=0
400 OPEN "I",#2,"COM0:"
410 OPEN "O",#1,"COM0:"
420 ESC$=CHR$(27)
430 STX$=CHR$(2)
440 ACK$=CHR$(6)
450 CAN$=CHR$(24)
460 '
470 ' コマンドパラメータ設定
480 '
490 COL=1 : ' 色指定 Cコマンド
500 DFO=3 : ' データフォーマット Dコマンド
510 MID=0 : ' 中間調処理 Bコマンド
520 SZOMX=100 : SZOMY=100 : ' ズーム設定 Hコマンド
530 R1=100 : R2=100 : ' 解像度設定 Rコマンド
540 NOU=1 : ' 濃度補正 Zコマンド
550 '
560 ' 読み取り可能範囲
570 ' MAX=8*(INT((2.96!*R1*SZOMX/100+.1!)/8)) :'''GT-1000 mode
580 ' MAY=INT(4.2!*R2*SZOMY/100+.1!)
590 ' MAX=8*(INT((4*R1*SZOMX/100+.1!)/8)) :'''GT-3000V mode
600 ' MAY=INT(6.4!*R2*SZOMY/100+.1!)
610 MAX=8*(INT((8.56!*R1*SZOMX/100+.1!)/8)) :'''GT-4000
620 MAY=11.6!*R2*SZOMY/100
630 '
640 XST=0 : YST=0 : ' 読み取り開始位置 Aコマンド
650 XEN=MAX-1 : YEN=MAY-1 : ' 読み取り終了位置
660 IF XEN>639 THEN XEN=639 ' 最大 (0,0)-(639,479) チェック
670 IF YEN>479 THEN YEN=479
680 '
690 DIM GD$(3,YEN,4)
700 '
710 'コマンド実行
720 '
730 SCOM$=ESC$+"C"
740 PAR$=CHR$(COL) : GOSUB *SENDDATA
750 SCOM$=ESC$+"D"
760 PAR$=CHR$(DFO) : GOSUB *SENDDATA
770 SCOM$=ESC$+"B"
780 PAR$=CHR$(MID) : GOSUB *SENDDATA
790 SCOM$=ESC$+"H"
800 PAR$=CHR$(SZOMX)+CHR$(SZOMY) : GOSUB *SENDDATA
810 SCOM$=ESC$+"R"
820 PAR$=CHR$(R1 MOD 256)+CHR$(R1 \ 256)+CHR$(R2 MOD 256)+CHR$(R2 \ 256)
830 GOSUB *SENDDATA
840 SCOM$=ESC$+"A"
850 PAR$=CHR$(XST MOD 256)+CHR$(XST \ 256)+CHR$(YST MOD 256)
860 PAR$=PAR$+CHR$(YST \ 256)+CHR$((XEN+1) MOD 256)+CHR$((XEN+1) \ 256)
870 PAR$=PAR$+CHR$((YEN+1) MOD 256)+CHR$((YEN+1) \ 256)
880 GOSUB *SENDDATA
890 SCOM$=ESC$+"Z"
900 PAR$=CHR$(NOU) : GOSUB *SENDDATA
910 '
920 PRINT #1,ESC$+"G";
930 '
940 ' MAIN
950 '
960 ' データREAD
970 '
980 XXX=INT((XEN+1)/2)-1
990 FOR COL=0 TO 2
1000 FOR L=YST TO YEN
1010 *WAIT
1020 HD$=INPUT$(1,#2) : IF HD$<>STX$ THEN *WAIT
1030 ST$=INPUT$(1,#2)
1040 IF (ASC(ST$) AND &H40)<>0 THEN GOSUB *SENDA : GOTO *WAIT
1050 ST$=INPUT$(2,#2)
1060 FOR ST=1 TO ((XXX-1) \ 200)+1
1070 RED=200
1080 IF ST=((XXX-1) \ 200)+1 THEN RED=((XXX-1) MOD 200)+2
1090 GD$(COL,L,ST)=INPUT$(RED,#2)
1100 ::::::::: IF INKEY$=ESC$ THEN GOSUB *SENDC : END :::::::::: ESC
1110 NEXT ST
1120 IF L<>YEN THEN GOSUB *SENDA
1130 NEXT L
1140 NEXT COL
1150 PRINT #1,ESC$;"@";:DUMMY$=INPUT$(1,#2)
1160 CLOSE
1170 ' データ変換
1180 '
1190 CLS
1200 FOR COL=2 TO 0 STEP -1
1210 FOR L=YST TO YEN
1220 FOR ST=1 TO ((XXX-1) \ 200)+1
1230 GD$=GD$(COL,L,ST)
1240 FOR BY=1 TO LEN(GD$) STEP 2
1250 ZZ=QQ(COL,ASC(MID$(GD$,BY,1)))
1260 ZZ=ZZ+QQ(COL,(ASC(MID$(GD$,BY+1,1))))*65536
1270 IF ZZ>=2147483648# THEN ZZ=ZZ-4294967296#
1280 CH(CC)=ZZ
1290 CC=CC+1
1300 NEXT BY
1310 NEXT ST
1320 PUT@A (XST,L)-(XEN,L),CH,OR
1330 CC=0
1340 NEXT L
1350 NEXT COL
1360 END
1370 '
1380 '
1390 'SUB.
1400 '
1410 *SENDDATA
1420 PRINT #1,SCOM$;
1430 A$=INPUT$(1,#2):IF A$ <> ACK$ THEN *ERR
1440 PRINT #1,PAR$;
1450 A$=INPUT$(1,#2):IF A$ <> ACK$ THEN *ERR
1460 RETURN
1470 '
1480 *SENDA
1490 PRINT #1,ACK$;
1500 RETURN
1510 '
1520 *SENDC
1530 PRINT #1,CAN$;
1540 RETURN
1550 '
1560 *ERR
1570 CLS
1580 PRINT "ERROR !"
1590 PRINT RIGHT$(SCOM$,1);"コマンド ERROR !"
1600 END
1610 '
1620 '
1630 ' このプログラムはカラーイメージスキャナ GT-4000・GT-1000
1640 ' で使用できます。
1650 ' 570-620行の式から使用する機種・モードにあったものを選択
1660 ' して下さい。 (転送速度は9600bpsに設定して実行して下さい。)
1670 '
1680 ' 読み込みを途中で終了するときは[ESC]キーを押して下さい。
1690 '
1700 '** 読み取りサイズや、解像度などは490-650行で変更できます。
1710 '