'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'This programm is changed by REINALD NIJBOER (The Netherlands)
'E-Mail: Reinosoft@Hotmail.com
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'Here is the great sub that will open a .ICO file display it on screen.
'This Programm could only accepted files with a 766 size.

DECLARE SUB LoadIcon (IconFileName$, Tline!, Ledge!)

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

TYPE BitMapInfoHeader
   biSize AS LONG                'Number bytes in header
   biWide AS LONG                'In pixels
   biHigh AS LONG                'In pixels
   biPlanes AS INTEGER           'Set to 1
   biBitCount AS INTEGER         'Bits per pixel (1,4,8,24)
   biCompress AS LONG            'RGB or RLE4, RLE8
   biImageSize AS LONG           'In Bytes. Can be 0 if RGB
   biXpels AS LONG               'Target device
   biYpels AS LONG               'Target device
   biColrUsed AS LONG            'Used in Color table. 0=Max
   biColrImportant AS LONG       '0=All
END TYPE

TYPE RGBQuad
   rgbBlue AS STRING * 1         'Range 0 to 255
   rgbGreen AS STRING * 1
   rgbRed AS STRING * 1
   rgbReserved AS STRING * 1
END TYPE

TYPE ImageXOR
   icXOR AS STRING * 1
END TYPE

TYPE ImageAND
   icAND AS STRING * 1
END TYPE

'----- HOUSEKEEPING
DIM SHARED icID AS IconDir
DIM SHARED bmID AS BitMapInfoHeader

IconFileName$ = "C:\windows\winupd.ico": X = 100: Y = 100

SCREEN 12
CALL LoadIcon(IconFileName$, Y, X)

SUB LoadIcon (IconFileName$, Tline, Ledge)
'----- ICON FILE HANDLING              'Put your input routine here
IconFile = FREEFILE
OPEN IconFileName$ FOR BINARY AS IconFile

NewFile$ = GetNewFile$
'----- GET ICON INFORMATION
GET #IconFile, , icID
IF LOF(IconFile) = 0 THEN
  CLOSE IconFile
  KILL IconFileName$
  SCREEN 0
  PRINT "The filename is invalid."
  EXIT SUB
END IF
IF LOF(IconFile) <> 766 THEN
  CLOSE IconFile
  SCREEN 0
  PRINT "This file has a wrong size."
  EXIT SUB
END IF
'----- GET BITMAP INFORMATION
GET #IconFile, , bmID
'LOCATE 4, 1: PRINT "Bits/Pixel:"; bmID.biBitCount

'----- LOAD COLOR TABLE
REDIM ColrTbl(1 TO ASC(icID.idEntries.idColorCount)) AS RGBQuad
FOR I = LBOUND(ColrTbl) TO UBOUND(ColrTbl)
   GET #IconFile, , ColrTbl(I)
NEXT I

'----- LOAD IMAGE XOR TABLE
TblSize = (ASC(icID.idEntries.idWide) * ASC(icID.idEntries.idHigh)) \ 2
REDIM XORTbl(1 TO TblSize) AS ImageXOR
   FOR I = 1 TO UBOUND(XORTbl)
      GET #IconFile, , XORTbl(I)
   NEXT I

'----- LOAD IMAGE AND TABLE
TblSize = (ASC(icID.idEntries.idWide) * ASC(icID.idEntries.idHigh)) \ 8
REDIM ANDTbl(1 TO TblSize) AS ImageAND
   FOR I = 1 TO UBOUND(ANDTbl)
      GET #IconFile, , ANDTbl(I)
   NEXT I
CLOSE IconFile

'-----
icWide = ASC(icID.idEntries.idWide)
icHigh = ASC(icID.idEntries.idHigh)
REDIM ImageArray(1 TO icHigh, 1 TO icWide) AS INTEGER
TblPtr = UBOUND(ANDTbl)
FOR Row = 1 TO icHigh STEP 1
   FOR Col = icWide TO 1 STEP -8
      FOR I = 0 TO 7
	 BitMap = ASC(ANDTbl(TblPtr).icAND)
	 IF BitMap AND 2 ^ I THEN
	    Colr = 15
	    Colr = 7
	 ELSE
	    Colr = 0
	 END IF
	 ImageArray(Col - I, Row) = Colr
      NEXT I
      TblPtr = TblPtr - 1
   NEXT Col
NEXT Row

TblPtr = UBOUND(XORTbl)
FOR Row = 1 TO icHigh STEP 1
   FOR Col = icWide TO 1 STEP -2
	 ColrMap = ASC(XORTbl(TblPtr).icXOR)
	 Colr = (&HF0 XOR ColrMap) MOD 16
	 ImageArray(Col, Row) = ImageArray(Col, Row) XOR Colr
	 Colr = (&HF XOR ColrMap) \ 16
	 ImageArray(Col - 1, Row) = ImageArray(Col - 1, Row) XOR Colr
	 TblPtr = TblPtr - 1
      NEXT Col
NEXT Row

'----- DISPLAY ICON
BLine = Tline + ASC(icID.idEntries.idWide) - 1
REdge = Ledge + ASC(icID.idEntries.idWide) - 1

 FOR Row = 1 TO icHigh
   FOR Col = 1 TO icWide
      Kleur = ImageArray(Row, Col)
      IF Kleur = 1 THEN Kleur = 4: GOTO 1
      IF Kleur = 3 THEN Kleur = 6: GOTO 1
      IF Kleur = 4 THEN Kleur = 1: GOTO 1
      IF Kleur = 5 THEN Kleur = 5: GOTO 1
      IF Kleur = 6 THEN Kleur = 3: GOTO 1
      IF Kleur = 7 THEN Kleur = 7: GOTO 1
      IF Kleur = 8 THEN Kleur = 15: GOTO 1
      IF Kleur = 9 THEN Kleur = 12: GOTO 1
      IF Kleur = 10 THEN Kleur = 10: GOTO 1
      IF Kleur = 11 THEN Kleur = 14: GOTO 1
      IF Kleur = 12 THEN Kleur = 9: GOTO 1
      IF Kleur = 13 THEN Kleur = 13: GOTO 1
      IF Kleur = 14 THEN Kleur = 11: GOTO 1
      IF Kleur = 15 THEN Kleur = 15: GOTO 1

1 PSET ((Ledge - 1) + Row, (Tline - 1) + Col), Kleur
 NEXT Col
NEXT Row

END SUB