Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

load icon in DATA statements Binbas

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • load icon in DATA statements Binbas

    Code:
    ' 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

  • #2
    revised

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

    Code:
    ' 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

    Comment


    • #3
      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.
      hellobasic

      Comment


      • #4
        Originally posted by Edwin Knoppert View Post
        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?

        Comment


        • #5
          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)
          Last edited by Edwin Knoppert; 8 Feb 2009, 02:41 PM.
          hellobasic

          Comment

          Working...
          X