Author Topic: ICOns images loader for use in your programs  (Read 331 times)

Offline Petr

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


Attached image show, what is possible with this (and more subprograms) to do.
« Last Edit: October 11, 2018, 11:50:36 AM by Petr »

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: ICOns images loader for use in your programs
« Reply #1 on: October 11, 2018, 11:40:07 AM »
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.
« Last Edit: October 11, 2018, 11:55:11 AM by FellippeHeitor »

Offline Petr

  • The best code is the DNA of the hops.
Re: ICOns images loader for use in your programs
« Reply #2 on: October 11, 2018, 11:59:32 AM »
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

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: ICOns images loader for use in your programs
« Reply #3 on: October 11, 2018, 12:05:47 PM »
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).
« Last Edit: October 11, 2018, 12:09:12 PM by FellippeHeitor »

Offline Petr

  • The best code is the DNA of the hops.
Re: ICOns images loader for use in your programs
« Reply #4 on: October 11, 2018, 12:16:51 PM »
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.