'===========================================================================
' Subject: BMP TO ICO CONVERTER (32X32X16)   Date: 01-01-00 (14:41)       
' Author:  Bernt Figaro                      Code: QB, QBasic, PDS        
' Origin:  bernt.figaro@swipnet.se         Packet: GRAPHICS.ABC
'===========================================================================
REM ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
REM ³ An simple .BMP to .ICO Converter                          ³
REM ³ bernt.figaro@swipnet.se                                   ³
REM ³ Here is an 16 colors converter                            ³
REM ³ Supporting only .ICO format 32x32                         ³
REM ³ An Icon are index in three parts: Head, Body and tail     ³
REM ³ The Head has 126 byte (including header and colortable)   ³
REM ³ The Body has 512 byte                                     ³
REM ³ The Tail has 128 byte of null                             ³
REM ³ An Bmp are index in two parts: Head and body              ³
REM ³ The Header is 118 bytes (including header and colortable) ³
REM ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
REM 2000-01-07

TYPE IconDirEntry
   idWide AS STRING * 1          'In pixels (16, 32, 64)
   idHigh AS STRING * 1          'In pixels (16, 32, 64)
   idColorCount AS STRING * 1    'Number of colors (2, 8, 16)
   idReserved AS STRING * 1
   idPlanes AS INTEGER           'Number of color planes
   idBitCount AS INTEGER         'Number of bits in icon
   idBytesInRes AS LONG          'Size of Icon in bytes
   idImageOffset AS LONG         'Offset to image data
END TYPE

TYPE IconDir
   idReserved AS INTEGER         'Always Zero
   idType AS INTEGER             'Usually set to 1
   idCount AS INTEGER            'Number of entries in directory
   idEntries  AS IconDirEntry
END TYPE

DECLARE SUB Showicon (File$, Xloc%, Yloc%, Scrmode%)
DECLARE SUB SplitVision (InLine AS STRING)
DECLARE FUNCTION ExtractCommand$ (Srce$)
REM
REM
REM
REM ----------------------------------
REM
DIM SHARED Array$(1 TO 128)
DIM SHARED icID AS IconDir
DIM head$, Body$, Tail$
CONST Scrmode% = 12
SCREEN Scrmode%
CLS
COLOR 14

head$ = ""
head$ = head$ + "00/00/01/00/01/00/20/20/10/00/00/00/00/00/E8/02/00/00/16/00/00/"
head$ = head$ + "00/28/00/00/00/20/00/00/00/40/00/00/00/01/00/04/00/00/00/00/00/"
head$ = head$ + "80/02/00/00/00/00/00/00/00/00/00/00/00/00/00/00/00/00/00/00/00/"
head$ = head$ + "00/00/00/00/00/80/00/00/80/00/00/00/80/80/00/80/00/00/00/80/00/"
head$ = head$ + "80/00/80/80/00/00/80/80/80/00/C0/C0/C0/00/00/00/FF/00/00/FF/00/"
head$ = head$ + "00/00/FF/FF/00/FF/00/00/00/FF/00/FF/00/FF/FF/00/00/FF/FF/FF/00/"

SplitVision head$

Body$ = SPACE$(512)
Tail$ = STRING$(128, 0)
head$ = STRING$(126, 0)

FOR I% = 1 TO 126
A% = VAL("&H" + Array$(I%))
MID$(head$, I%, 1) = CHR$(A%)
NEXT I%



OPEN "Quit.Bmp" FOR BINARY AS #1
SEEK #1, 119
GET #1, , Body$
CLOSE #1

FOR I% = 31 TO 0 STEP -1
FOR J% = 0 TO 31 STEP 2
P% = P% + 1
A% = ASC(MID$(Body$, P%, 1))
PSET (J% + 1, I%), A% AND 15
PSET (J%, I%), A% / 16
NEXT
NEXT

OPEN "QUIT.ICO" FOR BINARY AS #1
PUT #1, , head$
PUT #1, , Body$
PUT #1, , Tail$
CLOSE #1

Showicon "Quit.ico", 40, 0, Scrmode%
LOCATE 21, 1
PRINT "That's All, folks !"
SLEEP
END

REM $DYNAMIC
FUNCTION ExtractCommand$ (Srce$)
Delim$ = "/"
STATIC Start%, SaveStr$

' If first call, make a copy of the string.
IF Srce$ <> "" THEN
Start% = 1
SaveStr$ = Srce$
END IF

BegPos% = Start%
ln% = LEN(SaveStr$)
' Look for start of a token (character that isn't delimiter).
WHILE BegPos% <= ln% AND INSTR(Delim$, MID$(SaveStr$, BegPos%, 1)) <> 0
BegPos% = BegPos% + 1
WEND
' Test for token start found.
IF BegPos% > ln% THEN
ExtractCommand$ = "": EXIT FUNCTION
END IF
' Find the end of the token.
EndPos% = BegPos%
WHILE EndPos% <= ln% AND INSTR(Delim$, MID$(SaveStr$, EndPos%, 1)) = 0
EndPos% = EndPos% + 1
WEND
ExtractCommand$ = MID$(SaveStr$, BegPos%, EndPos% - BegPos%)
' Set starting point for search for next token.
Start% = EndPos%
END FUNCTION

SUB Showicon (File$, Xloc%, Yloc%, Scrmode%)

IF Scrmode% <> 12 THEN ErrCode% = -255: EXIT SUB

REDIM Ct%(0 TO 15) 'Uses if translates from screen

Ct%(0) = 0: Ct%(4) = 1: Ct%(2) = 2: Ct%(6) = 3
Ct%(1) = 4: Ct%(5) = 5: Ct%(3) = 6: Ct%(7) = 7
Ct%(8) = 8: Ct%(12) = 9: Ct%(10) = 10: Ct%(14) = 11
Ct%(9) = 12: Ct%(13) = 13: Ct%(11) = 14: Ct%(15) = 15


REM ÚÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
REM ³³ File Handle ³³
REM ÀÁÄÄÄÄÄÄÄÄÄÄÄÄÄÁÙ

Iconfile% = 7
OPEN File$ FOR BINARY AS Iconfile%

REM ÚÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
REM ³³ Get Icon Info  ³³
REM ÀÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÙ

GET #Iconfile%, , icID

icWide% = ASC(icID.idEntries.idWide)
IcHigh% = ASC(icID.idEntries.idHigh)
CLOSE #Iconfile%

Size% = (icWide% / 2) * IcHigh%
DIM Pico$
Pico$ = STRING$(Size%, 0)
DIM U%

Iconfile% = 10

OPEN File$ FOR BINARY AS #Iconfile%

SEEK Iconfile%, 127 ' CLNG(22 + (32 + 8) + (4 * 16) + 1)
GET Iconfile%, , Pico$
CLOSE Iconfile%


U% = 0
FOR Y% = (IcHigh% - 1) TO 0 STEP -1
FOR X% = 0 TO (icWide% - 1) STEP 2
U% = U% + 1
A% = ASC(MID$(Pico$, U%, 1)) \ 16
B% = ASC(MID$(Pico$, U%, 1)) AND 15
PSET (Xloc% + X%, Y% + Yloc%), A%
PSET (Xloc% + X% + 1, Y% + Yloc%), B%

NEXT
NEXT



Pico$ = ""
END SUB

SUB SplitVision (InLine AS STRING)
DIM Token$
MaxItem = 0
Token$ = ExtractCommand$(InLine)
REM Invoke ExtractCommand$ with the string to tokenize.
WHILE Token$ <> ""
MaxItem = MaxItem + 1
Array$(MaxItem) = Token$
REM Call ExtractCommand$ with a null string so it knows this isn't the first call.
Token$ = ExtractCommand$("")
WEND
END SUB