'===========================================================================
' Subject: SIZEABLE ICON VIEWER              Date: 09-24-98 (09:31)       
' Author:  Dieter Folger                     Code: QB, QBasic, PDS        
' Origin:  folger@bamberg.baynet.de        Packet: GRAPHICS.ABC
'===========================================================================
'-------------------------------------
' QICON.BAS for QBASIC (Public Domain)
' Shows an *.ICO file
' VGA card and color monitor required
' Icon can be enlarged with <+>
' or made smaller again with <->
' Written by Dieter Folger
'-------------------------------------
DECLARE FUNCTION Bin$ (B%)
DEFINT A-Z
DIM Pixel(1024), Byte AS STRING * 1
INPUT "Icon to show: ", File$
File$ = UCASE$(File$)
IF INSTR(File$, ".") = 0 THEN File$ = File$ + ".ICO"
IF File$ = ".ICO" THEN END
OPEN File$ FOR BINARY AS #1
IF LOF(1) = 0 THEN CLOSE : KILL File$: PRINT File$; " not found": END
' Get AND mask and analyze
FOR i = 1 TO 1024 STEP 8
    GET #1, 639 + Help, Byte
    FOR j = 1 TO 8
        IF MID$(Bin$(ASC(Byte)), j, 1) = "1" THEN Pixel(i + j - 1) = 7
        '(color for background is gray = 7)
    NEXT
    Help = Help + 1
NEXT
Help = 0
' Get XOR mask and analyze
FOR i = 1 TO 1024 STEP 2
    GET #1, 127 + Help, Byte
    IF Pixel(i) = 0 THEN Pixel(i) = (ASC(Byte) AND 240) / 16
    IF Pixel(i + 1) = 0 THEN Pixel(i + 1) = ASC(Byte) AND 15
    Help = Help + 1
NEXT
CLOSE
SCREEN 12
' set icon palette
FOR i = 1 TO 14
    READ r, g, B
    PALETTE i, r * 65536 + 256 * g + B
NEXT
Size = 1
DO
    CLS
    LOCATE 30, 1
    PRINT File$, "Change size=+/- End=Esc"
    Help = 1
    ' show icon now
    FOR y = 32 TO 1 STEP -1
        FOR x = 1 TO 32
            LINE (x * Size - Size + 1, y * Size - Size + 1)-(x * Size, y * Size), Pixel(Help), BF
            Help = Help + 1
        NEXT
    NEXT
    DO: K$ = INKEY$: LOOP WHILE K$ = ""
    ' make larger or smaller:
    IF K$ = "+" AND Size < 14 THEN Size = Size + 1
    IF K$ = "-" AND Size > 1 THEN Size = Size - 1
LOOP UNTIL K$ = CHR$(27)
' Palette data as stored in every *.ICO file
DATA 0,0,32,0,32,0,0,32,32,32,0,0,32,0,32,32,32,0,48,48,48
DATA 32,32,32,0,0,63,0,63,0,0,63,63,63,0,0,63,0,63,63,63,0
 
FUNCTION Bin$ (Byte)
'Bin$ for QBASIC
DO
    B$ = LTRIM$(STR$(Byte MOD 2)) + B$
    Byte = Byte \ 2
LOOP UNTIL Byte = 0
Bin$ = RIGHT$("00000000" + B$, 8)
END FUNCTION