INPUT "input ICO file name: "; file$
Total = LOADICO(file$, -1) 'paramterer < 0 for return how much frames ICO file contains
PRINT "File contains"; Total;
"frames." nic = LOADICO(file$, 0) 'parameter zero for show all frames in ICO file
PRINT "Press key, program place icon frame 10 to 100, 100..."
'how place image 10 from file up.ico to screen:
image10 = LOADICO("up.ico", 10)
id_Count
AS INTEGER 'pocet ikon v souboru ICO
dwBytesInRes
AS LONG 'delka obrazku v bytech vcetne palety dwImageOffset
AS LONG 'zacatek ikony od zacatku souboru - tim se ridit!
BitCount
AS INTEGER 'pocet bitu na pixel, tj 1, 4 , 8, 24 Compression
AS LONG '0 = BI_RGB, 1 = BI_RLE8, 2 = BI_RLE4 SizeImage
AS LONG 'velikost obrazu
DIM FH
AS File_Head
, IH
AS ICO_Head
, II
AS Ico_Image
frames = FH.id_Count
IF fram
< 0 THEN LOADICO&
= frames:
EXIT FUNCTION ' -1 is for returning number frames in file IF fram
> frames
THEN PRINT "This file contains not so much images. File "; file$;
" contains "; frames;
"frames. Can not using frame"; fram:
SLEEP 2:
EXIT FUNCTION Ico(al_fr).W = IH.bWidth
Ico(al_fr).H = IH.bHeight
Ico(al_fr).colors = IH.color_count '0 = >256 colors
Ico(al_fr).BPP = IH.wBitCount
Ico(al_fr).L = IH.dwBytesInRes
Ico(al_fr).Offset = IH.dwImageOffset + 1
IF IH.color_count
= 0 THEN IHcolor_count
= 256 ELSE IHcolor_count
= IH.color_count
Ico(al_fr).WP = IHcolor_count
IF fram
= 0 THEN vs
= 1: ve
= frames
ELSE vs
= fram: ve
= fram
SEEK #ch
, Ico
(all
).Offset
IF Ico
(all
).BPP
= 32 OR Ico
(all
).BPP
= 24 THEN ' nejprve otestuju pritomnost PNG pokud je hloubka 32 bit: current_position
= SEEK(ch
) ' Ico(all).BPP = 32
Ico(all).W = 256
Ico(all).H = 256
SEEK #ch
, current_position
IF Ico
(all
).BPP
> 0 AND Ico
(all
).BPP
<= 8 THEN depth
= 256 ELSE depth
= 32 IF Ico
(all
).W
= 0 THEN Ico
(all
).W
= 256 IF Ico
(all
).H
= 0 THEN Ico
(all
).H
= 256
icon&
= _NEWIMAGE(Ico
(all
).W
, Ico
(all
).H
, depth
)
PalLenght = 1
PalLenght = 15
PalLenght = 255
FOR palete
= 0 TO PalLenght
_______NoPalete:
FOR draw1
= 1 TO Ico
(all
).W
* Ico
(all
).H
bwi = bwi + DECtoBIN$(valuee)
drawX = 0
drawY = Ico(all).H
FOR DrawXOR
= 1 TO Ico
(all
).W
* Ico
(all
).H
drawX
= drawX
+ 1:
IF drawX
>= Ico
(all
).W
AND Ico
(all
).H
MOD 4 = 0 THEN drawX
= 0: drawY
= drawY
- 1
FOR READ_XOR_DATA
= 1 TO (Ico
(all
).W
* Ico
(all
).H
) / 2
calc_color = 0
colors4
(calc_color
) = BINtoDEC
(MID$(binary$
, calc_colors
, 4)) calc_color = calc_color + 1
clc = 0
drawX = 0
drawY = Ico(all).H
FOR DrawXOR
= 0 TO Ico
(all
).W
* Ico
(all
).H
drawX
= drawX
+ 1:
IF drawX
>= Ico
(all
).W
AND Ico
(all
).H
MOD 8 = 0 THEN drawX
= 0: drawY
= drawY
- 1 IF drawX
< Ico
(all
).W
THEN PSET (drawX
, drawY
), colors4
(clc
): clc
= clc
+ 1
AndMaskLen = (Ico(all).H * Ico(all).W) / 8
clc = 0
FOR DrawAND
= 0 TO Ico
(all
).W
* Ico
(all
).H
drawX
= drawX
+ 1:
IF drawX
>= Ico
(all
).W
AND Ico
(all
).H
MOD 8 = 0 THEN drawX
= 0: drawY
= drawY
- 1 cur
= POINT(drawX
, drawY
) PSET (drawX
, drawY
), 255 AND cur: clc
= clc
+ 1
FOR calc_colors
= 1 TO Ico
(all
).H
* Ico
(all
).W
GET #ch
, , colors8
(calc_colors
)
AndMaskLen = (Ico(all).H * Ico(all).W) / 8
clc = 0
FOR draw_itY
= 1 TO Ico
(all
).H
FOR draw_itX
= 0 TO Ico
(all
).W
- 1 clc = clc + 1
cur
= POINT(draw_itX
+ 1, draw_itY
) PSET (draw_itX
, Ico
(all
).H
- draw_itY
), colors8
(clc
)
drawY = Ico(all).H - 1
clc = 0
FOR DrawAND
= 1 TO Ico
(all
).W
* Ico
(all
).H
drawX
= drawX
+ 1:
IF drawX
>= Ico
(all
).W
AND Ico
(all
).H
MOD 4 = 0 THEN drawX
= 0: drawY
= drawY
- 1 clrr
= POINT(drawX
, drawY
) clc = clc + 1
FOR draw_itY
= 1 TO Ico
(all
).H
FOR draw_itX
= 1 TO Ico
(all
).W
GET #ch
, , cache
(draw_itX
, draw_itY
)
FOR draw_itY
= 1 TO Ico
(all
).H
FOR draw_itX
= 1 TO Ico
(all
).W
PSET (draw_itX
- 1, Ico
(all
).H
- draw_itY
), cache
(draw_itX
, draw_itY
)
______skip:
______resetview:
IF listed
= 0 THEN listed
= 1:
CLS:
_PRINTSTRING (300, 20), " Image nr. Width Height BPP Color count": row
= 40 row = row + Ico(all).H + 10
info$
= " " + STR$(all
) + " " + STR$(Ico
(all
).W
) + " " + STR$(Ico
(all
).H
) + " " + STR$(Ico
(all
).BPP
) + " " + STR$(Ico
(all
).WP
)
IF vstup
AND 2 ^ rj
THEN DECtoBIN$
= DECtoBIN$
+ "1" ELSE DECtoBIN$
= DECtoBIN$
+ "0"
BINtoDEC = BINtoDEC + (c * 2 ^ Sj)
png$ = ""