load icon in DATA statements Binbas

[Edwin Knoppert]

No not (png) compression but it is possible.
MicroAngelo can show these icons and i believe i have seen a remark on that on internet somewhere.

Google..

(Edit: i meant for under XP where png icons are not supported)

[Chris Holbrook]

It has a program to enum all icons in a folder and prepares text for it.

Thanks Edwin, I'll have a look. I have started one to create a set of data statements for a single icon via the clipboard, messing about with compression now... have you got one of these up your sleeve, too?

[Edwin Knoppert]

BINBAS is not that handy for this purpose.
On my download page i have added a link to an already existing zip: ico2data.zip

It has a program to enum all icons in a folder and prepares text for it.
Each function returns a HICON or HCURSOR.

No need for odd structures.

[Chris Holbrook]

revised

The method of loading is changed so that small icons are correctly displayed. The data statements are created using BINBAS as above.

' icon testbed 
' Chris Holbrook Feb 2009
' with help from Edwin Knoppert
'
#compile exe
#dim all
#include "WIN32API.INC"
'---------------------------------------------------------------
' Icon stuff - from Edwin Knoppert & Semen Matusovski
'---------------------------------------------------------------
type ICONDIR
    idReserved  as word '// Reserved (must be 0)
    idType      as word '// Resource Type (1 For icons)
    idCount     as word '// How many images?
end type

type ICONDIRENTRY
    bWidth          as byte     '// Width, In Pixels, of the Image
    bHeight         as byte     '// Height, In Pixels, of the Image
    bColorCount     as byte     '// Number of colors In Image (0 If >=8bpp)
    bReserved       as byte     '// Reserved ( must be 0)
    wPlanes         as word     '// Color Planes
    wBitCount       as word     '// Bits per pixel
    dwBytesInRes    as dword    '// How many bytes In this resource?
    dwImageOffset   as dword    '// Where In the file is this image?
end type
'-------------------------------------------------------------------------------
' icon library, one icon contained
function SetSmallIconFileBits( byval pData as dword ) as long
    local pIDIR   as ICONDIR ptr
    local pIENTRY as ICONDIRENTRY ptr

    pIDIR   = pData
    pIENTRY = pdata + 6
    function = CreateIconFromResourceEx( _
                 pData + @pIENTRY.dwImageOffset, _
                 @pIENTRY.dwBytesInRes, 1, &H30000&, 0, 0, %LR_DEFAULTCOLOR )
end function
'-------------------------------------------------------------------------------
macro mBinDataStuff
    local i, j          as long
    local           t   as string
    static          t2  as string

    for i = 1 to datacount: T = T & read$( i ): next
    j = len(T)
    for i = 1 to j step 2
        T2 = T2 & chr$( val( "&H" & mid$( T, i , 2 ) ) )
    next
    function = strptr(T2)
end macro
'-------------------------------------------------------------------------------
' dbcolumn data
function BinBasTickIcon( ) as dword
    mBinDataStuff
data 0000010001001010100001000400280100001600000028000000100000002000000001
data 0004000000000000000000000000000000000000000000000000000000000000FF0000
data 00FF000000000000000000000000000000000000000000000000000000000000000000
data 0000000000000000000000000000000000000000000000000000000000000000000000
data 0000000000000000000000000011100000000000011110000000000011011100000000
data 0010001100000000000000010000000000000001100000000000000010000000000000
data 0011000000000000000110000000000000001000000000000000010000000000000000
data 000000000000000000FFFF0000FFFF0000FFFF0000FC7F0000F87F0000F23F0000F73F
data 0000FFBF0000FF9F0000FFDF0000FFCF0000FFE70000FFF70000FFFB0000FFFF0000FF
data FF0000

end function
'-------------------------------------------------------------------------------
' dbcolumn data
function BinBasCrossIcon( ) as dword
    mBinDataStuff
data 0000010001001010100001000400280100001600000028000000100000002000000001
data 000400000000000000000000000000000000000000000000000000000000000000FF00
data 0000000000000000000000000000000000000000000000000000000000000000000000
data 0000000000000000000000000000000000000000000000000000000000000000000000
data 0000000000000000000000000000000000000000100000010000000011000010000000
data 0001100100000000000011100000000000000110000000000001101100000000001100
data 0110000000001100001100000000000000000000000000000000000000000000000000
data 000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000F7EF0000F3DF0000F9BF
data 0000FC7F0000FE7F0000F93F0000F39F0000F3CF0000FFFF0000FFFF0000FFFF0000FF
data FF0000

end function
'--------------------------------------------------------------------------
callback function DDCB
    static htickicon, hCrossIcon as dword
    
    select case cb.msg
        case %wm_initdialog
            hTickIcon =  setSmallIconFileBits(byval BinbasTickIcon)
            hCrossIcon = setSmallIconFileBits(byval BinbasCrossIcon)
            control send cbhndl, 100, %STM_SETICON, hTickIcon, 0
            control send cbhndl, 101, %STM_SETICON, hCrossIcon, 0
        case %wm_destroy
            destroyicon hTickIcon
            destroyicon hCrossIcon
    end select
end function
'--------------------------------------
function pbmain () as long
    local hD as dword
    
    dialog new pixels, 0, "icons from data statements", _
           200, 200, 230, 50, _
           %ws_sysmenu or %ws_caption _
           to hD
           
    control add label, hD, 100, "",  50, 16, 16, 16, %ss_icon
    control add label, hD, 101, "", 150, 16, 16, 16, %ss_icon
    dialog show modal hD call DDCB
end function

[Chris Holbrook]

' program to demonstrate use of Edwin Knoppert's Binbas application
' used to load an icon as part of the application without requiring
' a resource file. PBWin 8.04, DDT style.
' you can get Binbas here : http://www.hellobasic.com/pwrdev
'
' example by Chris Holbrook 20-MAR-2008
#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"
%IDD_DIALOG1 =  101
%IDC_LABEL1  = 1001

DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
'---------------------------------------------------------------
'//////////////////////////////////////////////////////////////////////////
'// Icon loading
'//////////////////////////////////////////////////////////////////////////

TYPE TAGICONDIR

    idReserved  AS WORD '// Reserved (must be 0)
    idType      AS WORD '// Resource Type (1 For icons)
    idCount     AS WORD '// How many images?

END TYPE

TYPE TAGICONDIRENTRY

    bWidth          AS BYTE     '// Width, In Pixels, of the Image
    bHeight         AS BYTE     '// Height, In Pixels, of the Image
    bColorCount     AS BYTE     '// Number of colors In Image (0 If >=8bpp)
    bReserved       AS BYTE     '// Reserved ( must be 0)
    wPlanes         AS WORD     '// Color Planes
    wBitCount       AS WORD     '// Bits per pixel
    dwBytesInRes    AS DWORD    '// How many bytes In this resource?
    dwImageOffset   AS DWORD    '// Where In the file is this image?

END TYPE

'// Creates an icon using plain filedata, like the 766 Bytes .ICO files.
'// Returns a iconhandle.
FUNCTION SetIconFileBits( BYVAL lpMem AS LONG ) AS LONG

    DIM pIconDir        AS TAGICONDIR PTR
    DIM IconDirEntry    AS TAGICONDIRENTRY PTR

    pIconDir = lpMem
    IF @pIconDir.idCount < 1 THEN EXIT FUNCTION
    IconDirEntry = pIconDir + LEN( @pIconDir )

    FUNCTION = CreateIconFromResource( _
          BYVAL pIconDir + @IconDirEntry.dwImageOffset _
        , @IconDirEntry.dwBytesInRes _
        , @pIconDir.idType _
        , &H30000& _
        )

END FUNCTION


'//////////////////////////////////////////////////////////////////////////

'---------------------------------------------------------------

SUB BinBas1( T AS STRING )

DIM a&: FOR a& = 1 TO DATACOUNT: T = T & READ$( a& ): NEXT a&

DATA 0000010001001010100001000400280100001600000028000000100000002000000001
DATA 000400000000000000000000000000000000000000000000000000000000000000FF00
DATA 0000000000000000000000000000000000000000000000000000000000000000000000
DATA 0000000000000000000000000000000000000000000000000000000000010000000000
DATA 0010011000000000011000110000000011000001000000011000000110000010000000
DATA 0011000100000000000111100000000000001100000000000000110000000000000101
DATA 1100000000001100011100000001100000011000001100000000110001000000000001
DATA 100000000000000000FFFF0000BFFD00009FF90000CFF30000EFE70000E7DF0000F3BF
DATA 0000F87F0000FCFF0000FCFF0000FA3F0000F38F0000E7E70000CFF30000BFF90000FF
DATA FF0000
END SUB
'---------------------------------------------------------------

CALLBACK FUNCTION ShowDIALOG1Proc()
    DIM a       AS LONG
    DIM hDlg    AS LONG
    DIM hIcon   AS LONG
    DIM T1      AS STRING
    DIM T2      AS STRING
    LOCAL s AS STRING

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            s = "1. Choose your icon" + $CRLF + _
                "2. Run Binbas, change settings to not zip the file" + $CRLF + _
                "3. load icon into Binbas" + $CRLF + _
                "4. cut and paste the data statements to replace those in Binbaseg"+ $CRLF + _
                "5. Recompile and run Binbaseg"+ $CRLF + _
                "6. ...and relax."
            CONTROL SET TEXT CBHNDL, %idc_label1, s
            '// Retrieve the datastatements.
            BinBas1 T1
            '// Convert to actual (file)data.
            FOR a = 1 TO LEN( T1 ) STEP 2
                T2 = T2 & CHR$( VAL( "&H" & MID$( T1, a , 2 ) ) )
            NEXT a

            '// Create the icon.
            hIcon = SetIconFileBits( STRPTR( T2 ) )

            '// Set the icon to this dialogbox.
            DIALOG SEND CBHNDL, %WM_SETICON, %ICON_small, hicon ' %ICON_BIG?

        CASE %WM_DESTROY
            IF hIcon THEN DestroyIcon hIcon

        CASE %WM_COMMAND
            SELECT CASE AS LONG CBCTL
                CASE %IDC_LABEL1

            END SELECT
    END SELECT
END FUNCTION

FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "Edwin Knoppert's Binbas eg to load icon in code", 152, 160, 253, 121, %WS_POPUP OR %WS_BORDER OR _
        %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
        %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "", 5, 5, 245, 110
    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    FUNCTION = lRslt
END FUNCTION

FUNCTION PBMAIN()
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION