続き
EXTERNAL SUB BMPMONOSAVE (N$, XS, YS, XE, YE) OPTION CHARACTER BYTE IF N$="" THEN EXIT SUB LET XSIZE=XE-XS+1 LET YSIZE=YE-YS+1 LET BW=INT((INT((XSIZE+7)/8)+3)/4)*4 LET SIZE=INT(XSIZE*YSIZE/8)+62 LET BITMAPHEADER$="BM" & MKL$(SIZE) & REPEAT$(CHR$(0),4) & MKL$(62) LET BITMAPINFO$=MKL$(40) & MKL$(XSIZE) & MKL$(YSIZE) & CHR$(1) & CHR$(0) & CHR$(1) & CHR$(0) & REPEAT$(CHR$(0),24) LET PALET$=CHR$(0) & CHR$(0) & CHR$(0) & CHR$(0) & CHR$(255) & CHR$(255) & CHR$(255) & CHR$(0) OPEN #1:NAME N$,ACCESS OUTPUT PRINT #1: BITMAPHEADER$; PRINT #1: BITMAPINFO$; PRINT #1: PALET$; FOR Y = YE TO YS STEP -1 FOR X = XS TO XE STEP 8 CALL GETPOINT(X,Y,R1,G1,B1) IF X+1<=XE THEN CALL GETPOINT(X+1,Y,R2,G2,B2) IF X+2<=XE THEN CALL GETPOINT(X+2,Y,R3,G3,B3) IF X+3<=XE THEN CALL GETPOINT(X+3,Y,R4,G4,B4) IF X+4<=XE THEN CALL GETPOINT(X+4,Y,R5,G5,B5) IF X+5<=XE THEN CALL GETPOINT(X+5,Y,R6,G6,B6) IF X+6<=XE THEN CALL GETPOINT(X+6,Y,R7,G7,B7) IF X+7<=XE THEN CALL GETPOINT(X+7,Y,R8,G8,B8) IF R1=255 AND G1=255 AND B1=255 THEN LET C1=1 ELSE LET C1=0 IF R2=255 AND G2=255 AND B2=255 THEN LET C2=1 ELSE LET C2=0 IF R3=255 AND G3=255 AND B3=255 THEN LET C3=1 ELSE LET C3=0 IF R4=255 AND G4=255 AND B4=255 THEN LET C4=1 ELSE LET C4=0 IF R5=255 AND G5=255 AND B5=255 THEN LET C5=1 ELSE LET C5=0 IF R6=255 AND G6=255 AND B6=255 THEN LET C6=1 ELSE LET C6=0 IF R7=255 AND G7=255 AND B7=255 THEN LET C7=1 ELSE LET C7=0 IF R8=255 AND G8=255 AND B8=255 THEN LET C8=1 ELSE LET C8=0 LET A$ = A$ & CHR$(C1 * 128 + C2 * 64 + C3 * 32 + C4 * 16 + C5 * 8 + C6 * 4 + C7 * 2 + C8) LET R2=0 LET G2=0 LET B2=0 LET R3=0 LET G3=0 LET B3=0 LET R4=0 LET G4=0 LET B4=0 LET R5=0 LET G5=0 LET B5=0 LET R6=0 LET G6=0 LET B6=0 LET R7=0 LET G7=0 LET B7=0 LET R8=0 LET G8=0 LET B8=0 NEXT X LET A$ = LEFT$(A$ & REPEAT$(CHR$(0),10), BW) PRINT #1: A$; LET A$ = "" NEXT Y CLOSE #1 END SUB EXTERNAL SUB RGB(X,R,G,B) LET B=MOD(INT(X/65536),256) LET G=MOD(INT(X/256),256) LET R=MOD(X,256) END SUB EXTERNAL SUB GETPOINT(X,Y,R,G,B) ASK PIXEL VALUE (X,Y) C CALL RGB(C,R,G,B) END SUB
|