home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
pbc22b.zip
/
PBC$BAS.ZIP
/
SHOWICON.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-12
|
2KB
|
58 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE FUNCTION AscM% (St$, BYVAL Posn%)
DECLARE SUB FClose1 (BYVAL FileHandle%)
DECLARE SUB FOpen1 (FileName$, BYVAL ReadWrite%, BYVAL Sharing%, FileHandle%, ErrCode%)
DECLARE SUB FSetLoc (BYVAL FileHandle%, Posn&)
DECLARE FUNCTION GetFSize& (FileName$)
DECLARE SUB SFRead (BYVAL FileHandle%, St$, BytesRead%, ErrCode%)
SUB ShowIcon (FileName$, StartX%, StartY%, ErrCode%)
DIM W2DC%(0 TO 15) ' color translation table
W2DC%(0) = 0
W2DC%(1) = 4
W2DC%(2) = 2
W2DC%(3) = 14
W2DC%(4) = 1
W2DC%(5) = 5
W2DC%(6) = 3
W2DC%(7) = 7
W2DC%(8) = 8
W2DC%(9) = 12
W2DC%(10) = 10
W2DC%(11) = 14
W2DC%(12) = 9
W2DC%(13) = 13
W2DC%(14) = 11
W2DC%(15) = 15
IF INSTR(FileName$, ".") THEN
File$ = FileName$
ELSE
File$ = FileName$ + ".ICO"
END IF
IF GetFSize&(File$) = 766& THEN
FOpen1 File$, 0, 2, IconFile%, ErrCode%
ELSE
ErrCode% = -1
END IF
FileOpen% = (ErrCode% = 0)
IF ErrCode% = 0 THEN
FSetLoc IconFile%, CLNG(22 + (32 + 8) + (4 * 16) + 1)
Icon$ = SPACE$(32 * 16)
SFRead IconFile%, Icon$, BytesRead%, ErrCode%
END IF
IF ErrCode% = 0 THEN
FOR y% = 0 TO 31
FOR x% = 0 TO 15
PSET (StartX% + x% * 2, StartY% + 31 - y%), W2DC%(AscM(Icon$, y% * 16 + x% + 1) \ 16)
PSET (StartX% + x% * 2 + 1, StartY% + 31 - y%), W2DC%(AscM(Icon$, y% * 16 + x% + 1) AND 15)
NEXT
NEXT
END IF
IF FileOpen% THEN FClose1 IconFile%
END SUB