ICOns images loader for use in your programs

[Petr]

This feature allows you to read / view / use all ICO file images. This is used because of the program, when has every user use other resolution. Therefore, you must use different sizes of icons for different resolutions (the digital zoom of the small icon is simply nasty). ICO format contains the same icon for different resolutions.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3.  
4.  
5. INPUT "input ICO file name: "; file$
6. IF INSTR(LCASE$(file$), ".ico") = 0 THEN file$ = file$ + ".ico"
7.  
8.  
9. Total = LOADICO(file$, -1) 'paramterer < 0 for return how much frames ICO file contains
10. PRINT "File contains"; Total; "frames."
11. SLEEP 2
12. nic = LOADICO(file$, 0) 'parameter zero for show all frames in ICO file
13.  
14. PRINT "Press key, program place icon frame 10 to 100, 100..."
15. SLEEP
16.  
17. 'how place image 10 from file up.ico to screen:
18. CLS
19. image10 = LOADICO("up.ico", 10)
20. _PUTIMAGE (100, 100), image10
21.  
22.  
23.  
24.  
25.  
26.  
27.  
28.  
29. FUNCTION LOADICO& (file AS STRING, fram AS INTEGER)
30.  
31.     TYPE File_Head
32.         reserved AS INTEGER '0
33.         id_Type AS INTEGER '1
34.         id_Count AS INTEGER 'pocet ikon v souboru ICO
35.     END TYPE
36.  
37.     TYPE ICO_Head
38.         bWidth AS _UNSIGNED _BYTE
39.         bHeight AS _UNSIGNED _BYTE
40.         color_count AS _UNSIGNED _BYTE '0 = >256 colors
41.         bReserved AS _UNSIGNED _BYTE '0
42.         wPlanes AS _UNSIGNED INTEGER 'pocet bitovych rovin
43.         wBitCount AS _UNSIGNED INTEGER 'pocet bitu na pixel
44.         dwBytesInRes AS LONG 'delka obrazku v bytech vcetne palety
45.         dwImageOffset AS LONG 'zacatek ikony od zacatku souboru - tim se ridit!
46.     END TYPE
47.  
48.  
49.  
50.     TYPE Ico_Image
51.         ThisSize AS LONG '40
52.         width AS LONG
53.         height AS LONG
54.         biPlanes AS INTEGER '1
55.         BitCount AS INTEGER 'pocet bitu na pixel, tj 1, 4 , 8, 24
56.         Compression AS LONG '0 = BI_RGB, 1 = BI_RLE8, 2 = BI_RLE4
57.         SizeImage AS LONG 'velikost obrazu
58.         XPelsPerMeter AS LONG '0
59.         YPelsPerMeter AS LONG '0
60.         nic AS LONG '0
61.         taky_nic AS LONG '0
62.     END TYPE
63.  
64.     TYPE IcIm
65.         W AS INTEGER
66.         H AS INTEGER
67.         colors AS _UNSIGNED _BYTE
68.         BPP AS _UNSIGNED _BYTE
69.         L AS LONG
70.         Offset AS LONG
71.         WP AS _UNSIGNED INTEGER
72.     END TYPE
73.  
74.     DIM FH AS File_Head, IH AS ICO_Head, II AS Ico_Image
75.     ch = FREEFILE
76.  
77.     IF _FILEEXISTS(file$) THEN OPEN file$ FOR BINARY AS #ch ELSE PRINT "ICO loader error: file "; file$; " not exist.": SLEEP 2: SYSTEM
78.     GET #ch, , FH
79.     IF FH.reserved = 0 AND FH.id_Type = 1 THEN ELSE PRINT "unknown format!": SYSTEM
80.     frames = FH.id_Count
81.     IF fram < 0 THEN LOADICO& = frames: EXIT FUNCTION '                                                                                                        -1 is for returning number frames in file
82.     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
83.     REDIM Ico(frames) AS IcIm
84.     FOR al_fr = 1 TO frames
85.         GET #ch, , IH
86.         Ico(al_fr).W = IH.bWidth
87.         Ico(al_fr).H = IH.bHeight
88.         Ico(al_fr).colors = IH.color_count '0 = >256 colors
89.         Ico(al_fr).BPP = IH.wBitCount
90.         Ico(al_fr).L = IH.dwBytesInRes
91.         Ico(al_fr).Offset = IH.dwImageOffset + 1
92.         IF IH.color_count = 0 THEN IHcolor_count = 256 ELSE IHcolor_count = IH.color_count
93.         Ico(al_fr).WP = IHcolor_count
94.     NEXT al_fr
95.  
96.  
97.  
98.     IF fram = 0 THEN vs = 1: ve = frames ELSE vs = fram: ve = fram
99.     FOR all = vs TO ve
100.         SEEK #ch, Ico(all).Offset
101.  
102.  
103.         IF Ico(all).BPP = 32 OR Ico(all).BPP = 24 THEN ' nejprve otestuju pritomnost PNG pokud je hloubka 32 bit:
104.             current_position = SEEK(ch)
105.             DIM start_test AS STRING * 8
106.             DIM end_test AS STRING * 12
107.             start$ = CHR$(137) + CHR$(80) + CHR$(78) + CHR$(71) + CHR$(13) + CHR$(10) + CHR$(26) + CHR$(10)
108.             GET #ch, , start_test$
109.             IF start_test$ = start$ THEN
110.                 '   Ico(all).BPP = 32
111.                 Ico(all).W = 256
112.                 Ico(all).H = 256
113.                 icon& = _COPYIMAGE(extract_png&(ch), 32): GOTO ______skip
114.             ELSE
115.                 SEEK #ch, current_position
116.             END IF
117.         END IF
118.  
119.  
120.         GET #ch, , II
121.  
122.         IF Ico(all).BPP > 0 AND Ico(all).BPP <= 8 THEN depth = 256 ELSE depth = 32
123.         IF Ico(all).W = 0 THEN Ico(all).W = 256
124.         IF Ico(all).H = 0 THEN Ico(all).H = 256
125.  
126.  
127.         icon& = _NEWIMAGE(Ico(all).W, Ico(all).H, depth)
128.         _DEST icon&
129.  
130.         SELECT CASE Ico(all).BPP
131.             CASE 1
132.                 PalLenght = 1
133.             CASE 4
134.                 PalLenght = 15
135.             CASE 8
136.                 PalLenght = 255
137.             CASE 0, 32, 24
138.                 GOTO _______NoPalete
139.         END SELECT
140.  
141.         REDIM pal AS _UNSIGNED LONG
142.         FOR palete = 0 TO PalLenght
143.             GET #ch, , pal
144.             _PALETTECOLOR palete, pal, icon&
145.         NEXT palete
146.         _______NoPalete:
147.  
148.         SELECT CASE Ico(all).BPP
149.  
150.             CASE 1
151.                 REDIM bwi AS STRING, valuee AS _UNSIGNED _BYTE
152.                 FOR draw1 = 1 TO Ico(all).W * Ico(all).H
153.                     GET #ch, , valuee
154.                     bwi = bwi + DECtoBIN$(valuee)
155.                 NEXT
156.  
157.                 drawX = 0
158.                 drawY = Ico(all).H
159.                 FOR DrawXOR = 1 TO Ico(all).W * Ico(all).H
160.  
161.                     IF (MID$(bwi$, DrawXOR, 1)) = "1" THEN PSET (drawX, drawY)
162.                     drawX = drawX + 1: IF drawX >= Ico(all).W AND Ico(all).H MOD 4 = 0 THEN drawX = 0: drawY = drawY - 1
163.                 NEXT
164.  
165.             CASE 4
166.                 DIM R4 AS _UNSIGNED _BYTE
167.                 binary$ = ""
168.  
169.                 FOR READ_XOR_DATA = 1 TO (Ico(all).W * Ico(all).H) / 2
170.                     GET #ch, , R4
171.                     binary$ = binary$ + DECtoBIN$(R4)
172.                 NEXT READ_XOR_DATA
173.  
174.                 DIM colors4(LEN(binary$)) AS _BYTE
175.                 calc_color = 0
176.  
177.  
178.                 FOR calc_colors = 1 TO LEN(binary$) STEP 4
179.                     colors4(calc_color) = BINtoDEC(MID$(binary$, calc_colors, 4))
180.                     calc_color = calc_color + 1
181.                 NEXT calc_colors
182.  
183.                 binary$ = ""
184.  
185.                 clc = 0
186.  
187.                 drawX = 0
188.                 drawY = Ico(all).H
189.                 FOR DrawXOR = 0 TO Ico(all).W * Ico(all).H
190.                     drawX = drawX + 1: IF drawX >= Ico(all).W AND Ico(all).H MOD 8 = 0 THEN drawX = 0: drawY = drawY - 1
191.                     IF drawX < Ico(all).W THEN PSET (drawX, drawY), colors4(clc): clc = clc + 1
192.                 NEXT
193.  
194.                 ERASE colors4: binary$ = ""
195.                 AndMaskLen = (Ico(all).H * Ico(all).W) / 8
196.  
197.                 FOR AM = 1 TO AndMaskLen
198.                     GET #ch, , R4
199.                     binary$ = binary$ + DECtoBIN$(R4)
200.                 NEXT AM
201.  
202.  
203.                 clc = 0
204.                 FOR DrawAND = 0 TO Ico(all).W * Ico(all).H
205.                     drawX = drawX + 1: IF drawX >= Ico(all).W AND Ico(all).H MOD 8 = 0 THEN drawX = 0: drawY = drawY - 1
206.                     IF drawX <= Ico(all).W AND MID$(binary$, clc, 1) = "1" THEN
207.                         _SOURCE icon&
208.                         cur = POINT(drawX, drawY)
209.                         PSET (drawX, drawY), 255 AND cur: clc = clc + 1
210.                     END IF
211.                 NEXT
212.                 _SOURCE 0
213.  
214.             CASE 8
215.                 REDIM colors8(Ico(all).H * Ico(all).W) AS _UNSIGNED _BYTE
216.                 FOR calc_colors = 1 TO Ico(all).H * Ico(all).W
217.                     GET #ch, , colors8(calc_colors)
218.                 NEXT calc_colors
219.  
220.                 binary$ = ""
221.                 AndMaskLen = (Ico(all).H * Ico(all).W) / 8
222.                 REDIM r5 AS _UNSIGNED _BYTE
223.                 FOR AM = 1 TO AndMaskLen
224.                     GET #ch, , r5
225.                     binary$ = binary$ + DECtoBIN$(r5)
226.                 NEXT AM
227.  
228.                 clc = 0
229.                 FOR draw_itY = 1 TO Ico(all).H
230.                     FOR draw_itX = 0 TO Ico(all).W - 1
231.                         clc = clc + 1
232.                         _SOURCE icon&
233.                         cur = POINT(draw_itX + 1, draw_itY)
234.                         PSET (draw_itX, Ico(all).H - draw_itY), colors8(clc)
235.                 NEXT: NEXT
236.  
237.                 drawY = Ico(all).H - 1
238.                 clc = 0
239.                 FOR DrawAND = 1 TO Ico(all).W * Ico(all).H
240.                     drawX = drawX + 1: IF drawX >= Ico(all).W AND Ico(all).H MOD 4 = 0 THEN drawX = 0: drawY = drawY - 1
241.                     clrr = POINT(drawX, drawY)
242.                     clc = clc + 1
243.                     IF MID$(binary$, clc, 1) = "1" THEN PSET (drawX, drawY), 255 AND clrr
244.  
245.                 NEXT
246.                 _SOURCE 0
247.  
248.  
249.             CASE 0, 32
250.                 REDIM cache(1 TO Ico(all).W, 1 TO Ico(all).H) AS _UNSIGNED LONG
251.  
252.                 FOR draw_itY = 1 TO Ico(all).H
253.                     FOR draw_itX = 1 TO Ico(all).W
254.                         GET #ch, , cache(draw_itX, draw_itY)
255.                 NEXT: NEXT
256.  
257.                 FOR draw_itY = 1 TO Ico(all).H
258.                     FOR draw_itX = 1 TO Ico(all).W
259.                         PSET (draw_itX - 1, Ico(all).H - draw_itY), cache(draw_itX, draw_itY)
260.                 NEXT: NEXT
261.                 ERASE cache
262.  
263.         END SELECT
264.  
265.         ______skip:
266.         _DEST 0
267.         IF fram = 0 THEN
268.             IF _PIXELSIZE(_DEST) < 4 THEN PRINT "LOADICO parameter is set as 0. This option is for view all frames in ICO and muss be used with 32 bit screen.": SLEEP 2: EXIT FUNCTION
269.             ______resetview:
270.             IF listed = 0 THEN listed = 1: CLS: _PRINTSTRING (300, 20), "    Image nr.   Width   Height    BPP    Color count": row = 40
271.             IF _HEIGHT - (row + 10) < 256 THEN _PRINTSTRING (50, row + 100), "Press key for view next...": SLEEP: CLS: listed = 0: GOTO ______resetview
272.             _PUTIMAGE (50, row), icon&, 0
273.             _FREEIMAGE icon&
274.             row = row + Ico(all).H + 10
275.             info$ = "  " + STR$(all) + "      " + STR$(Ico(all).W) + "      " + STR$(Ico(all).H) + "    " + STR$(Ico(all).BPP) + "         " + STR$(Ico(all).WP)
276.             _PRINTSTRING (350, row - (Ico(all).H + 10 / 2)), info$
277.         ELSE
278.             IF all = fram THEN LOADICO& = icon&: _DEST 0: EXIT FUNCTION ELSE _FREEIMAGE icon&
279.         END IF
280.     NEXT all
281. END FUNCTION
282.  
283.  
284. FUNCTION DECtoBIN$ (vstup)
285.     FOR rj = 7 TO 0 STEP -1
286.         IF vstup AND 2 ^ rj THEN DECtoBIN$ = DECtoBIN$ + "1" ELSE DECtoBIN$ = DECtoBIN$ + "0"
287.     NEXT rj
288. END FUNCTION
289.  
290. FUNCTION BINtoDEC (b AS STRING)
291.     FOR Si = 1 TO LEN(b)
292.         e$ = MID$(b$, Si, 1)
293.         c = VAL(e$) '
294.         Sj = LEN(b) - Si
295.         BINtoDEC = BINtoDEC + (c * 2 ^ Sj)
296.     NEXT Si
297. END FUNCTION
298.  
299. FUNCTION extract_png& (ch)
300.     start$ = CHR$(137) + CHR$(80) + CHR$(78) + CHR$(71) + CHR$(13) + CHR$(10) + CHR$(26) + CHR$(10)
301.     eend$ = CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(73) + CHR$(69) + CHR$(78) + CHR$(68) + CHR$(174) + CHR$(66) + CHR$(96) + CHR$(130)
302.     SEEK #ch, SEEK(ch) - 8
303.     Z = SEEK(ch)
304.     DIM scan AS STRING * 12
305.     DO
306.         GET #ch, , scan$
307.         IF scan$ = eend$ THEN EXIT DO
308.         SEEK #ch, SEEK(ch) - 11
309.     LOOP
310.     K = SEEK(ch)
311.     png$ = SPACE$(K - Z)
312.     SEEK #ch, Z
313.     GET #ch, , png$
314.     swp = FREEFILE
315.     OPEN "---png_extr_" FOR OUTPUT AS #swp
316.     CLOSE #swp: OPEN "---png_extr_" FOR BINARY AS #swp
317.     PUT #swp, , png$
318.     CLOSE #swp
319.     extract_png& = _LOADIMAGE("---png_extr_", 32)
320.     KILL "---png_extr_"
321.     png$ = ""
322. END FUNCTION
323.  

Attached image show, what is possible with this (and more subprograms) to do.

[FellippeHeitor]

Good job, Petr. I wrote a simple icon viewer function for InForm, but it doesn't go as far as yours goes, extracting all possible images. Kudos.

Just a suggestion:

Code: QB64: [Select]

1. 'IF NOT INSTR(file$, LCASE$(".ico")) THEN file$ = file$ + ".ico"
2. IF INSTR(LCASE$(file$), ".ico") = 0 THEN file$ = file$ + ".ico"

The original line was not going to work as you expected it to.

[Petr]

Thank you, Fellippe for warning. Fixed. ÏCO files cotains this images can be downloaded from http://www.iconarchive.com/, When I read the definition of SVG files, I remembered Steve and his library...  :-D

[FellippeHeitor]

I love iconarchive.com, it's where InForm's icon comes from.

About SVG files, here's my simple (and *very* limited) SVG reader: https://github.com/FellippeHeitor/Snippets/blob/master/svg.bas (won't likely render any of those fancy icons).

[Petr]

That's absolutely amazing, thank you for the link, Fellippe. I'll immediately look at the source to find a solution to the Bazier curves. That's very good for me.