Declare an .ico file

[eoredson]

Using this code produces an error when icon file does not exist.

Code: (Select All)

' set title icon
If _FileExists("sic64.ico") Then
  $ExeIcon:'sic64.ico'
  _Icon
End If
_Title "SICK64"

what am i doing wrong?

Erik.

[eoredson]

I tried this code:

Code: (Select All)

$If _FILEEXISTS("SIC64.ICO") Then
      Print "exists."
$End If

[bplus]

If .ICO file is in same folder as bas source and you Run with Output Exe to Source Folder AND you are not finding the .ICO file then try ".\MyName.ICO" instead of "MyName.ICO".

[eoredson]

If .ICO file is in same folder as bas source and you Run with Output Exe to Source Folder AND you are not finding the .ICO file then try ".\MyName.ICO" instead of "MyName.ICO".

I am not trying to find the existing icon. I am wondering about the ide error when icon file does not exist.

[dbox]

The metacommands are typically pre-compiler directives that are evaluated as a first pass over the source code.  Similar to $Include, the IDE validates the $ExeIcon metacommand interactively to ensure a valid file is specified.

I think if you want to conditionally set the icon after checking for its existence you would want to use the _ICON method instead.

[eoredson]

The metacommands are typically pre-compiler directives that are evaluated as a first pass over the source code.  Similar to $Include, the IDE validates the $ExeIcon metacommand interactively to ensure a valid file is specified.

I think if you want to conditionally set the icon after checking for its existence you would want to use the _ICON method instead.

And if it does not exist?

[eoredson]

I managed to use _icon using the following code but I had to use Paint to convent the .ico to a .bmp file:

Code: (Select All)

' set title icon
i& = _LoadImage("SIC64.BMP", 32)
If i& < -1 Then
  _Icon i&
  _FreeImage i&
End If

https://qb64phoenix.com/qb64wiki/index.php/LOADIMAGE
NOTE: Icon files are not supported with _LOADIMAGE and an error will occur.

[TempodiBasic]

Hi eoredson
sorry but I cannot find your 

Icon files are not supported with _LOADIMAGE and an error will occur.

at that linked page that you have posted. 


Yes there is no .ICO in the list of files that _LOADIMAGE can load,
however I find very good the section of the wiki about icon at this link Icon and Cursor
and at wikipedia page ICO file format.
In the same wiki there are the sections:
Create icon bitmaps
Create icons from bitmaps
Save Icon 32


about your specific question
"if does the file .ICO not exist?"

I remember that professional developing tools use to warning the user about a missed resource need for create the executable file...
pasting this code in QB64pe Ide I got this error because there is no such file in the path of QB64.exe where is the temp file of current code of ide.




and so it seems doing QB64pe...
so I miss the meaning of your message.
Please can say me it in other words?

[Petr]

Your problem solution EXISTS on my thread - here https://staging.qb64phoenix.com/showthread.php?tid=1525 - and here is example how do it.

Code: (Select All)

'Petr Preclik presents:
'LOADICO function. Use ico files as icons in your programs! Use it as:  handle = LOADICON (ico_file_name$, number of frame in this ICO file)
'                                                   For list all images in ICO file set second parameter to zero (call it in 32 bit screen)
'                                                                  For returning how much frames ICO contains, set second parameter as < 0.

_Title "ICO Loader"
Screen _NewImage(1024, 600, 32)
Cls , _RGB32(25, 0, 12)

file$ = "appicon.ico" 'firefox ico file - show 6 images,


Total = LOADICO(file$, -1) 'TOTAL now contains number all frames in ICO file



_PrintMode _KeepBackground
Print "File contains"; Total; "frames."
For all = 1 To Total
    i& = LOADICO(file$, all)
    If i& < -1 Then _PutImage (X, 100), i&, 0
    X = X + _Width(i&)
    _FreeImage i&
Next


'try use 2nd ico image in this ico file use as your program icon:
ic& = LOADICO("appicon.ico", 2)
_Icon ic& 'show to program titlebar, it works correctly.



Function LOADICO& (file As String, fram As Integer)
    'file identity header
    PD = _Dest
    Type File_Head
        reserved As Integer '0
        id_Type As Integer '1
        id_Count As Integer 'number of frames in file
    End Type

    Type ICO_Head
        bWidth As _Unsigned _Byte
        bHeight As _Unsigned _Byte
        color_count As _Unsigned _Byte '0 = >256 colors
        bReserved As _Unsigned _Byte '0
        wPlanes As _Unsigned Integer 'number of bit layers
        wBitCount As _Unsigned Integer 'bites per pixel
        dwBytesInRes As Long 'image lenght included palette
        dwImageOffset As Long 'icon begin from file begin (driving record)
    End Type



    Type Ico_Image
        ThisSize As Long '40
        width As Long
        height As Long
        biPlanes As Integer '1
        BitCount As Integer 'bites per pixel, tj 1, 4 , 8, 24
        Compression As Long '0 = BI_RGB, 1 = BI_RLE8, 2 = BI_RLE4
        SizeImage As Long 'image size
        XPelsPerMeter As Long '0
        YPelsPerMeter As Long '0
        nic As Long '0        'nothing :)
        taky_nic As Long '0   'also nothing :)  i have none informations and none sources - for what is this!
    End Type

    Type IcIm 'help array (maybe? - this is wroted long time ago... :-/ )
        W As Integer
        H As Integer
        colors As _Unsigned _Byte
        BPP As _Unsigned _Byte
        L As Long
        Offset As Long
        WP As _Unsigned Integer
    End Type

    Dim FH As File_Head, IH As ICO_Head, II As Ico_Image
    ch = FreeFile

    If _FileExists(file$) Then Open file$ For Binary As #ch Else Print "ICO loader error: file "; file$; " not exist.": Sleep 2: System
    Get #ch, , FH
    If FH.reserved = 0 And FH.id_Type = 1 Then Else Print "unknown format!": System
    frames = FH.id_Count 'frames number (total frames) in file
    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
    ' PRINT "Frames in file: "; frames
    ReDim Ico(frames) As IcIm
    For al_fr = 1 To frames
        Get #ch, , IH
        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 'bites per pixel
        Ico(al_fr).L = IH.dwBytesInRes 'image lenght included palette
        Ico(al_fr).Offset = IH.dwImageOffset + 1 'icon record byte start position from file begin
        If IH.color_count = 0 Then IHcolor_count = 256 Else IHcolor_count = IH.color_count
        Ico(al_fr).WP = IHcolor_count
    Next al_fr
    'vsechny hlavy ke vsem snimkum jsou nacteny. Tato hlava je ridici pro kazdy snimek.
    'all heads for all frames are ready. This is head for every head

    If fram = 0 Then vs = 1: ve = frames Else vs = fram: ve = fram
    For all = vs To ve
        Seek #ch, Ico(all).Offset 'posun na spravnou pozici       skip to correct position

        If Ico(all).BPP = 32 Then ' nejprve otestuju pritomnost PNG pokud je hloubka 32 bit: 'first testing, if PNG is contained in file, when bites per pixel is 32
            current_position = Seek(ch)
            Dim start_test As String * 8
            '            DIM end_test AS STRING * 12
            start$ = Chr$(137) + Chr$(80) + Chr$(78) + Chr$(71) + Chr$(13) + Chr$(10) + Chr$(26) + Chr$(10)
            Get #ch, , start_test$
            If start_test$ = start$ Then
                Ico(all).BPP = 32
                Ico(all).W = 256
                Ico(all).H = 256
                icon& = _CopyImage(extract_png&(ch), 32): GoTo ______skip
            Else
                Seek #ch, current_position
            End If
        End If
        Get #ch, , II '            nactu hlavu obrazku. Tato hlava je navic a nepouziva se, aspon mysim....  ' really i dont know for what is this, just some records

        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

        '   PRINT Ico(all).W, Ico(all).H, depth
        icon& = _NewImage(Ico(all).W, Ico(all).H, depth)
        _Dest icon&

        Select Case Ico(all).BPP '   za havou bitmapy nasleduje paleta   After bitmap header is palette
            Case 1
                PalLenght = 1
            Case 4
                PalLenght = 15 'ok pro 4 barvy  OK for 4 colors
            Case 8
                PalLenght = 255
            Case 0, 32
                GoTo _______noPalete
        End Select

        ReDim pal As _Unsigned Long 'vypoctem potvrzeno long   LONG confirmed :)
        For palete = 0 To PalLenght
            Get #ch, , pal
            _PaletteColor palete, pal, icon&
        Next palete
        _______noPalete:

        Select Case Ico(all).BPP 'podle bitove hloubky probehne vykresleni     drawing starts by bit depth

            Case 1 ' testovano na jednom jedinem pripade...      this is tested just on ONE file
                ReDim bwi As String, valuee As _Unsigned _Byte
                For draw1 = 1 To Ico(all).W * Ico(all).H
                    Get #ch, , valuee
                    bwi = bwi + DECtoBIN$(valuee)
                Next

                drawX = 0
                drawY = Ico(all).H
                For DrawXOR = 1 To Ico(all).W * Ico(all).H

                    If (Mid$(bwi$, DrawXOR, 1)) = "1" Then PSet (drawX, drawY)
                    drawX = drawX + 1: If drawX >= Ico(all).W And Ico(all).H Mod 4 = 0 Then drawX = 0: drawY = drawY - 1
                Next

            Case 4 '                                                   pro soubory o jednom snimku naprosto v poradku (neni podpora PNG ale to asi v 16ti barvach nebude potreba)
                '                                                      for files contins one frame is this all right (is not PNG support in 16 colors, i think this is not need)
                Dim R4 As _Unsigned _Byte
                binary$ = ""

                For READ_XOR_DATA = 1 To (Ico(all).W * Ico(all).H) / 2
                    Get #ch, , R4
                    binary$ = binary$ + DECtoBIN$(R4)
                Next READ_XOR_DATA

                Dim colors4(Len(binary$)) As _Byte
                calc_color = 0


                For calc_colors = 1 To Len(binary$) Step 4
                    colors4(calc_color) = BINtoDEC(Mid$(binary$, calc_colors, 4))
                    calc_color = calc_color + 1
                Next calc_colors

                binary$ = ""

                clc = 0

                drawX = -1
                drawY = Ico(all).H - 1
                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
                Next



                'Pak je AND maska (sirka * vyska) / 8 a nakonec data obrazku
                'Then is AND mask (widht * height) / 8 and in end are image data
                Erase colors4: binary$ = ""
                AndMaskLen = (Ico(all).H * Ico(all).W) / 8

                For AM = 1 To AndMaskLen
                    Get #ch, , R4
                    binary$ = binary$ + DECtoBIN$(R4)
                Next AM


                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
                    If drawX <= Ico(all).W And Mid$(binary$, clc, 1) = "1" Then
                        _Source icon&
                        cur = Point(drawX, drawY)
                        PSet (drawX, drawY), 255 And cur: clc = clc + 1
                    End If
                Next
                _Source 0

            Case 8
                ReDim colors8(Ico(all).H * Ico(all).W) As _Unsigned _Byte
                For calc_colors = 1 To Ico(all).H * Ico(all).W
                    Get #ch, , colors8(calc_colors)
                Next calc_colors

                binary$ = ""
                AndMaskLen = (Ico(all).H * Ico(all).W) / 8 'predelavano
                ReDim r5 As _Unsigned _Byte
                For AM = 1 To AndMaskLen
                    Get #ch, , r5
                    binary$ = binary$ + DECtoBIN$(r5)
                Next AM

                clc = 0
                For draw_itY = 1 To Ico(all).H
                    For draw_itX = 0 To Ico(all).W - 1
                        clc = clc + 1
                        _Source icon&
                        cur = Point(draw_itX + 1, draw_itY)
                        PSet (draw_itX, Ico(all).H - draw_itY), colors8(clc) ' XOR cur
                Next: Next

                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
                    If Mid$(binary$, clc, 1) = "1" Then PSet (drawX, drawY), 255 And clrr

                Next
                _Source 0


            Case 0, 32 'overeno, v tomto pripade se opravdu ctou 4 byty 'confirmed, in this case are really 4 bytes read
                ReDim cache(1 To Ico(all).W, 1 To Ico(all).H) As _Unsigned Long

                For draw_itY = 1 To Ico(all).H
                    For draw_itX = 1 To Ico(all).W
                        Get #ch, , cache(draw_itX, draw_itY)
                Next: Next

                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)
                Next: Next
                Erase cache
        End Select

        ______skip:
        _Dest PD
        If fram = 0 Then 'function paramter 0 as fram is for view all images in ico file (my loop muss be in 32 bit graphic mode)
            'vypis pokud bude paramter nula
            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
            ______resetview:
            If listed = 0 Then listed = 1: Cls: _PrintString (300, 20), "    Image nr.   Width   Height    BPP    Color count": row = 40
            If _Height - (row + 10) < 256 Then _PrintString (50, row + 100), "Press key for view next...": Sleep: Cls: listed = 0: GoTo ______resetview
            _PutImage (50, row), icon&, 0
            _FreeImage icon&
            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)
            _PrintString (350, row - (Ico(all).H + 10 / 2)), info$
        Else
            If all = fram Then LOADICO& = icon&: _Dest PD: Exit Function Else _FreeImage icon&
        End If
    Next all
End Function



Function DECtoBIN$ (vstup)
    For rj = 7 To 0 Step -1
        If vstup And 2 ^ rj Then DECtoBI$ = DECtoBI$ + "1" Else DECtoBI$ = DECtoBI$ + "0"
    Next rj
    DECtoBIN$ = DECtoBI$
End Function

Function BINtoDEC (b As String)
    For Si = 1 To Len(b)
        e$ = Mid$(b$, Si, 1)
        c = Val(e$) '
        Sj = Len(b) - Si
        BINtoDE = BINtoDE + (c * 2 ^ Sj)
    Next Si
    BINtoDEC = BINtoDE
End Function

Function extract_png& (ch) 'Warning. This function can be very easy used for extraction PNG files from all (also binary) files!
    'BEEP
    start$ = Chr$(137) + Chr$(80) + Chr$(78) + Chr$(71) + Chr$(13) + Chr$(10) + Chr$(26) + Chr$(10) 'PNG start ID string
    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) 'PNG end ID string
    Seek #ch, Seek(ch) - 8
    Z = Seek(ch)
    Dim scan As String * 12
    Do
        Get #ch, , scan$
        If scan$ = eend$ Then Exit Do
        Seek #ch, Seek(ch) - 11
    Loop
    K = Seek(ch)
    png$ = Space$(K - Z)
    Seek #ch, Z
    Get #ch, , png$
    swp = FreeFile
    Open "---png_extr_" For Output As #swp
    Close #swp: Open "---png_extr_" For Binary As #swp
    Put #swp, , png$
    Close #swp
    extract_png& = _LoadImage("---png_extr_", 32)
    Kill "---png_extr_"
    png$ = ""
End Function

[eoredson]

Sorry, got the wrong link:
https://qb64phoenix.com/qb64wiki/index.php/ICON
NOTE: Icon files are not supported with _LOADIMAGE and an error will occur.