'===========================================================================
' Subject: OPEN ICO VERSION 0.1              Date: 04-23-99 (18:32)       
' Author:  Yousuf Philips                    Code: QB, QBasic, PDS        
' Origin:  philipz@emirates.net.ae         Packet: GRAPHICS.ABC
'===========================================================================
''''''''''''''''''''''''''''''''''''''
' Program    : Views ICO Files       '
' Name       : OPENICO Version 0.1   '
' Programmer : Yousuf Philips        '
' Company    : Y P I                 '
' Updated On : 17th of April 1999    '
' Email - [philipz85@hotmail.com]    '
' [http://members.xoom.com/Philipz/] '
''''''''''''''''''''''''''''''''''''''

'/*               Do not edit this file if you distribute it.              */'
'/*  (c) Copyrighted by YPI in 1998 | All Rights Reserved | Public Domain  */'

'/* This program has been created by YPI (Basic Programming Incorporation) */'
'/* as a utility to view Windows (ICO) icon & (CUR) cursor files in QBASIC.*/'

'/* It currently can view 4 and 8-bit images in color and 24-bit icons in  */'
'/* grayscale.                                                             */'

'/* An original program created by the professional programmers at YPI.    */'
'/* If you use any of this code in your program then you must credit YPI,  */'
'/* it would be appreciated if you sent us a copy of your program also.    */'
'/* Please send your comments and suggestions to <philipz85@hotmail.com>   */'

DECLARE SUB OpenICON (FileName$)
DEFINT A-Z

CLS
FILES "*.*"
INPUT " Enter File Name - ", FileName$

IF INSTR(FileName$, ".") = 0 THEN
   FileName$ = FileName$ + ".ico"
END IF

CALL OpenICON(FileName$)

SUB OpenICON (FileName$)

'/* Icon File Main Header */'
Reserv1$ = SPACE$(2): Valid$ = SPACE$(2): NoOfIcons$ = SPACE$(2)

'/* Icon Main Header */'
PixelWidth$ = SPACE$(1): PixelHeight$ = SPACE$(1): NoOfColors$ = SPACE$(1)
Reserv2$ = SPACE$(1): Planes$ = SPACE$(2): BitCount$ = SPACE$(2)
TotalBytesOfImage$ = SPACE$(4): LocationOfImage$ = SPACE$(4)

'/* Icon Minor Header (BMP Info Header) */'
SizeOfHeader$ = SPACE$(4): Width$ = SPACE$(4): Height$ = SPACE$(4)
Plane$ = SPACE$(2): BitsPerPixel$ = SPACE$(2): Compressed$ = SPACE$(4)
SizeOfImage$ = SPACE$(4): XMeter$ = SPACE$(4): YMeter$ = SPACE$(4)
ClrUsed$ = SPACE$(4): ClrImportant$ = SPACE$(4)

OPEN FileName$ FOR BINARY AS #255
IF LOF(255) = 0 THEN
   PRINT " FILE IS EMPTY"
   CLOSE #255
   KILL FileName$
   END
END IF

GET #255, , Reserv1$
GET #255, , Valid$
GET #255, , NoOfIcons$

CLS
PRINT
PRINT " - Icon File Main Header Information - "
PRINT " Reserve (0) -"; CVI(Reserv1$)
PRINT " Valid if (1) -"; CVI(Valid$)
PRINT " Number of Icons in File -"; CVI(NoOfIcons$)

IF CVI(Reserv1$) = 19778 THEN
   Location$ = SPACE$(4)
   GET #255, 11, Location$
   PRINT
   PRINT " This Icon File is a BMP File"
   PRINT " Will attempt to display the BMP Image"
   PRINT " Press Any Key To Continue"
   Waiting$ = INPUT$(1)
   SEEK #255, 15
   GOSUB ReadIcon
ELSE
   Waiting$ = INPUT$(1)
   FOR IconNumber = 1 TO CVI(NoOfIcons$)
      '/* Extract Icon File Minor Header */'
      GET #255, , PixelWidth$
      GET #255, , PixelHeight$
      GET #255, , NoOfColors$
      GET #255, , Reserv2$
      GET #255, , Planes$
      GET #255, , BitCount$
      GET #255, , TotalBytesOfImage$
      GET #255, , LocationOfImage$
      Location& = LOC(255) + 1
      SEEK #255, CVL(LocationOfImage$) + 1
      GOSUB ReadIcon
      SEEK #255, Location&
   NEXT IconNumber
END IF
SYSTEM

ReadIcon:
'/* Extract Icon Minor Header */'
   GET #255, , SizeOfHeader$
   GET #255, , Width$
   GET #255, , Height$
   GET #255, , Plane$
   GET #255, , BitsPerPixel$
   GET #255, , Compressed$
   GET #255, , SizeOfImage$
   GET #255, , XMeter$
   GET #255, , YMeter$
   GET #255, , ClrUsed$
   GET #255, , ClrImportant$
 
   IF CVI(BitsPerPixel$) = 1 THEN
      SCREEN 2: SCREEN 0: PRINT
      PRINT " Can not Load 1-bit Images "
      RETURN
   ELSEIF CVI(Compressed$) <> 0 THEN
      SCREEN 2: SCREEN 0: PRINT
      PRINT " Can not Load Compressed Images"
      RETURN
   END IF

   PixelWidth = CVL(Width$): PixelHeight = CVL(Height$)
   NumberOfColors& = 2 ^ CVI(BitsPerPixel$): PaletteBlue$ = SPACE$(1)
   PaletteGreen$ = SPACE$(1): PaletteRed$ = SPACE$(1): Empty$ = SPACE$(1)

   SCREEN 13: CLS
 
   IF CVI(BitsPerPixel$) < 9 THEN
      FOR Loops = 0 TO NumberOfColors& - 1
         '/* Extract the palette of each of the colors and change the palette */'
         GET #255, , PaletteBlue$
         GET #255, , PaletteGreen$
         GET #255, , PaletteRed$
         GET #255, , Empty$
         OUT &H3C8, Loops
         OUT &H3C9, ASC(PaletteRed$) \ 4
         OUT &H3C9, ASC(PaletteGreen$) \ 4
         OUT &H3C9, ASC(PaletteBlue$) \ 4
      NEXT Loops
   END IF

   IF CVI(Reserv1$) = 0 THEN PixelHeight = PixelHeight \ 2

   IF CVI(BitsPerPixel$) = 4 THEN
      LineExtract$ = SPACE$(PixelWidth \ 2)
      IF (4 - CINT((PixelWidth MOD 8) / 2)) <> 4 THEN
         LineExtract$ = LineExtract$ + SPACE$(4 - CINT((PixelWidth MOD 8) / 2))
      END IF
      FOR Y = PixelHeight - 1 TO 0 STEP -1
         GET #255, , LineExtract$
         FOR X = 0 TO PixelWidth - 1 STEP 2
            PSET (X, Y), ASC(MID$(LineExtract$, INT(X / 2) + 1, 1)) \ 16
            PSET (X + 1, Y), ASC(MID$(LineExtract$, INT(X / 2) + 1, 1)) AND 15
         NEXT X
      NEXT Y
   ELSEIF CVI(BitsPerPixel$) = 8 THEN
      LineExtract$ = SPACE$(PixelWidth)
      IF CVI(Reserv1$) <> 0 THEN SEEK #255, CVL(Location$) + 1
      IF (4 - (PixelWidth MOD 4)) <> 4 THEN Extra$ = SPACE$(4 - (PixelWidth MOD 4))
      FOR Y = PixelHeight - 1 TO 0 STEP -1
         GET #255, , LineExtract$
         GET #255, , Extra$
         FOR X = 0 TO PixelWidth - 1
            PSET (X, Y), ASC(MID$(LineExtract$, X + 1, 1))
         NEXT X
      NEXT Y
   ELSEIF CVI(BitsPerPixel$) = 24 THEN
      IF CVI(Reserv1$) <> 0 THEN SEEK #255, CVL(Location$) + 1
      FOR Loops = 0 TO 255
         OUT &H3C8, Loops
         OUT &H3C9, Loops \ 4
         OUT &H3C9, Loops \ 4
         OUT &H3C9, Loops \ 4
      NEXT Loops
      LineExtract$ = SPACE$(PixelWidth * 3)
      IF (4 - ((PixelWidth * 3) MOD 4)) <> 4 THEN
         LineExtract$ = SPACE$((PixelWidth * 3) + (4 - ((PixelWidth * 3) MOD 4)))
      END IF
      FOR Y = PixelHeight - 1 TO 0 STEP -1
         GET #255, , LineExtract$
         FOR X = 0 TO PixelWidth - 1
            PaletteBlue$ = MID$(LineExtract$, X * 3 + 1, 1)
            PSET (X, Y), ASC(PaletteBlue$)
         NEXT X
      NEXT Y
   END IF
   Waiting$ = INPUT$(1)
RETURN

END SUB