No announcement yet.

Have icon, need bmp

  • Filter
  • Time
  • Show
Clear All
new posts

  • Have icon, need bmp


    When You right-click Explorer's ListView You get a pop-up, select "Send To" and
    You get a list of "recipients" with a icon to the left of the name.

    I want to make some similar, but having two problems
    - get the "default" icon for a exe
    - convert a icon to a bmp to be used with the SetMenuItemBitmaps API

    Anyone got any sample code of how to accomplish this ??



  • #2
    Per --

    1. As I know, typically to extract icons is used ExtractIcon(Ex).
    Could be another way - LoadLibrary (exe-file) and LoadIcon ("PROGRAM").

    Third variant - to use Shell functions.

      #Compile Exe
      #Dim All
      #Register None
      #Include ""
      $FileNm = "G:\WinNt\NotePad.exe" ' <-------- Change
      Declare Function CoInitialize Lib "ole32.dll" Alias "CoInitialize"( ByVal pvReserved As Dword ) As Dword
      Declare Sub CoUninitialize Lib "ole32.dll" Alias "CoUninitialize"
      Declare Function ImageList_Draw Lib "comctl32.dll" Alias "ImageList_Draw" _
          (ByVal himl As Long, ByVal i As Long, _
          ByVal hDCDest As Long, ByVal x As Dword, ByVal y As Long, ByVal flags As Long) As Long
      CallBack Function DlgProc
         Select Case CbMsg
            Case %WM_PAINT
               Dim hImg1 As Long, hImg2 As Long, ShFileInfo1 As SHFILEINFO, ShFileInfo2 As SHFILEINFO, hDC As Long
               hDC = GetDC(CbHndl)
               hImg1 = SHGetFileInfo ($FileNm, 0&, ShFileInfo1, SizeOf(ShFileInfo1), _
                                     %SHGFI_TYPENAME Or %SHGFI_SHELLICONSIZE Or %SHGFI_SYSICONINDEX Or _
                                     %SHGFI_DISPLAYNAME Or %SHGFI_EXETYPE Or %SHGFI_SMALLICON)
               ImageList_Draw hImg1, ShFileInfo1.iIcon, hDC, 10, 10, %ILD_TRANSPARENT
               hImg2 = SHGetFileInfo ($FileNm, 0&, ShFileInfo2, SizeOf(ShFileInfo2), _
                                     %SHGFI_TYPENAME Or %SHGFI_SHELLICONSIZE Or %SHGFI_SYSICONINDEX Or _
                                     %SHGFI_DISPLAYNAME Or %SHGFI_EXETYPE Or %SHGFI_LARGEICON)
               ImageList_Draw hImg2, ShFileInfo2.iIcon, hDC, 50, 50, %ILD_TRANSPARENT
               ReleaseDC CbHndl, hDC
               If ShFileInfo1.hIcon Then DestroyIcon ShFileInfo1.hIcon
               If ShFileInfo2.hIcon Then DestroyIcon ShFileInfo2.hIcon
        End Select
      End Function
      Function PbMain
          Local hDlg As Long
          CoInitialize 0
          Dialog New 0, "Test", , , 100, 100, %WS_CAPTION Or %WS_SYSMENU To hDlg
          Dialog Show Modal hDlg Call DlgProc
      End Function

    2. About one month ago I posted an utility, which creates a bitmap file for Toolbar.
    Like source could be used icons too.

    Step 1. DrawIcon(Ex).
    Step 2. hDC -> hBmp or Bitmap file (I posted many variants).

    E-MAIL: [email protected]

    [This message has been edited by Semen Matusovski (edited October 29, 2000).]


    • #3
      Your "Third variant - to use Shell functions" works great

      I still have problem with displaying a small icon/bmp on a popup menu

      'This code results in icons correctly drawn on the dialog itself, but on the menu only black squares appears.
      'used FACE1..5.ico from "pbdll6\samples\Tray" as 
      'I'm on real thin ice here, not quite sure of what i'm doin'
      Sub rPop (Byval hDlg as Long)
       Dim p     AS POINTAPI
       Dim hPopup AS LONG
       Dim i&, xx&, yy&, j&
       Dim wStyle&
       Dim fName$
       Dim iHnd&
       Dim hBmp&
       Dim hdc&, hdcTarget&
      	MENU NEW POPUP to hPopup
      	wStyle = %MF_ENABLED
      	fName = DIR$("*.*")
      	While Len(fName) > 0
      		Incr i
      		MENU ADD STRING, hPopup, fName, i, wStyle ', Call popBack ' doesn't work...
      		iHnd = ExtractIcon(hDlg, BYVAL STRPTR(fName), -1)
      		If iHnd > 0 Then
      			xx = 16
      			yy = 16
      			fName = "FACE" & Trim$(Str$(j)) & ".ico"
               iHnd = LoadImage(ByVal 0&, BYVAL STRPTR(fName), %IMAGE_ICON, xx, yy, %LR_LOADFROMFILE)   
      			hdcTarget = GetDC(hDlg) 
      			' creates nothing on popUp , hdcTarget = GetDC(hPopUp)
      			' creates a Icon on dlg when  hdcTarget = GetDC(hDlg)
      			Call SaveDC (hdcTarget)										' *ReleaseDC 
      			hdc = CreateCompatibleDC(hdcTarget)						' *DeleteDC
      			Call DrawIconEx (hdcTarget, 0, (j-1) * 16, iHnd ,16, 16, 0, 0, %DI_NORMAL)
      			SelectObject hDC, hdcTarget 'hBmp
      '			hBmp = CreateCompatibleBitmap(hdcTarget, xx, yy)	' *DeleteObject
      			hBmp = CreateCompatibleBitmap(hdc, xx, yy)	' *DeleteObject
      			Call BitBlt (hBmp, 0, 0, xx, yy, hdcTarget, 0,0,%SRCCOPY)
      			SetMenuItemBitmaps hPopup, i, %MF_BYCOMMAND, hBmp, hBmp
      			'*	When the menu is destroyed, any bitmaps are not destroyed; 
      			'	it is up to the application to destroy them. - I wonder how...
      			' *This must? be done, but can't be done here, if done, nothing appears on menu
      			'DeleteObject hBmp
      		   DeleteDC hdc
      			   ' -1 restores the most recently saved DC
      		   RestoreDC hdcTarget, -1
         		ReleaseDC %NULL, hdcTarget
      			DestroyIcon iHnd
      			Incr j
      		End If
      		fName = Dir$
         SetForegroundWindow hDlg
         GetCursorPos p
         TrackPopupMenu hPopup, 0, p.x, p.y, 0, hDlg, ByVal %NULL
         DestroyMenu hPopUp
      End Sub



      • #4
        Per --
        I never used SetMenuItemBitmaps.
        But I made own-drawn menu, incl. popup. It's enough easy.

        Some days ago I posted in this forum a fragment, based on MSDN.
        It's base: you have hDC and can draw what you want.
        At the same time Borje in Source code posted more detail variant with bitmaps.

        E-MAIL: [email protected]


        • #5
          i have never used setmenuitembitmaps myself before trying now.
          as mention earlier the "sub rpop" only produces black squares in front of
          the text on the menu.
          if you care to test it, just cut'n paste it into your samle code, and add
           case %wm_rbuttondown 
              call rpop(cbhndl)
          to the "callback function dlgproc"

          maybe own-drawn menus are easy, but..., everything's easy when you know how to do it....

          is borje's code is the one in
          i have tested it (downloaded complete sample from his site) but it doesn't show up
          any graphics on my w2000.




          • #6
            Per --
            In fragment below don't forget to change file-pathes.

            [This message has been edited by Semen Matusovski (edited October 30, 2000).]


            • #7
              I assembled some fragments w/o real test.
              On my PC (Win2000) it works.

                 #Compile Exe
                 #Dim All
                 #Register None
                 #Include "Win32Api.Inc"
                 #Include "CommCtrl.Inc"
                 Declare Function CoInitialize Lib "ole32.dll" Alias "CoInitialize"( ByVal pvReserved As Dword ) As Dword
                 Declare Sub CoUninitialize Lib "ole32.dll" Alias "CoUninitialize"
                 Type MYITEM
                    hfont     As Long
                    SizeA     As SizeL
                    psz       As Asciiz * 255
                    FileName  As Asciiz * %MAX_PATH
                 End Type
                 Function GetAFont(fnFont As Long) As Long
                    Local lf As LOGFONT
                    Local sFontName As String
                    GetObject GetStockObject(%ANSI_VAR_FONT), SizeOf(lf), ByVal VarPtr(lf)
                    If (fnFont = 1) Then
                       lf.lfHeight = -14
                       lf.lfWeight = %FW_BOLD
                       lf.lfFaceName = "Times New Roman"
                       lf.lfWeight = %FW_NORMAL
                    End If
                    lf.lfItalic = (fnFont = 2)
                    lf.lfUnderline = (fnFont = 3)
                    lf.lfCharset = %RUSSIAN_CHARSET
                    Function = CreateFontIndirect(lf)
                 End Function
                 CallBack Function DlgProc
                    %IDM_TEST = 100
                    %nIDM = 3
                    Static hPopup As Long
                    Dim pMyItem As MYITEM Ptr
                    Dim MyItem(1 To %nIDM) As Static MYITEM
                    Local i As Long
                    Local lpmis As MEASUREITEMSTRUCT Ptr
                    Local lpdis As DRAWITEMSTRUCT Ptr
                    Local hdc As Long
                    Local hfontOld As Long
                    Select Case CbMsg
                       Case %WM_CONTEXTMENU
                          If IsFalse(hPopup) Then
                             Menu New Popup To hPopup
                             For i = 1 To %nIDM
                                Menu Add String, hPopup, "", %IDM_TEST + i, %MF_ENABLED
                                ModifyMenu hPopup, 100 + i, %MF_BYCOMMAND Or %MF_OWNERDRAW, 100 + i, ByVal VarPtr(myitem(i))
                                MyItem(i).hfont = GetAFont(i)
                                Select Case i
                                   Case 1: MyItem(i).psz = "Notepad"
                                           MyItem(i).FileName = "G:\WinNt\Notepad.Exe" ' <--- Change
                                   Case 2: MyItem(i).psz = "Explorer"
                                           MyItem(i).FileName = "G:\WinNt\Explorer.Exe" ' <--- Change
                                   Case 3: MyItem(i).psz = "WordPad"
                                           MyItem(i).FileName = "G:\Program Files\Windows Nt\Accessories\WordPad.Exe" ' <--- Change
                                End Select
                          End If
                          Dim pt As POINTAPI
                          GetCursorPos pt
                          TrackPopupMenu hPopup, %TPM_LEFTALIGN Or %TPM_RIGHTBUTTON, pt.x, pt.y, ByVal 0, CbHndl, ByVal 0
                       Case %WM_DESTROY
                          For i = 1 To %nIDM: DeleteObject MyItem(i).hfont: Next
                      Case %WM_MEASUREITEM
                          hdc = GetDC(CbHndl)
                          lpmis = CbLparam
                          pmyitem = @lpmis.itemData
                          hfontOld = SelectObject(hdc, @pmyitem.hfont)
                          GetTextExtentPoint32 hdc, @pmyitem.psz, Len(@pmyitem.psz), @pmyitem.SizeA
                          @lpmis.itemWidth = 4 + GetSystemMetrics(%SM_CYSMICON) +
                          @lpmis.itemHeight = Max(GetSystemMetrics(%SM_CYSMICON),
                          SelectObject hdc, hfontOld
                          ReleaseDC CbHndl, hdc
                          Function = %TRUE: Exit Function
                      Case %WM_DRAWITEM
                          lpdis = CbLparam
                          pmyitem = @lpdis.itemData
                          If (@lpdis.itemState And %ODS_SELECTED) Then
                             SetTextColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)
                             SetBkColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)
                             SetTextColor @lpdis.hDC, GetSysColor(%COLOR_MENUTEXT)
                             SetBkColor @lpdis.hDC, GetSysColor(%COLOR_MENU)
                          End If
                          hfontOld = SelectObject(@lpdis.hDC, @pmyitem.hfont)
                          ExtTextOut @lpdis.hDC, 4 + GetSystemMetrics(%SM_CYSMICON) + @lpdis.rcItem.nleft, _
                              @lpdis.rcItem.nTop + (@lpdis.rcItem.nBottom - @lpdis.rcItem.nTop - / 2, %ETO_OPAQUE, _
                              @lpdis.rcItem, @pmyitem.psz, Len(@pmyitem.psz), ByVal 0
                         Dim hImg As Long, ShFileInfo As SHFILEINFO
                         hImg = SHGetFileInfo (@pmyItem.FileName, 0&, ShFileInfo, SizeOf(ShFileInfo), _
                                               %SHGFI_TYPENAME Or %SHGFI_SHELLICONSIZE Or %SHGFI_SYSICONINDEX Or _
                                               %SHGFI_DISPLAYNAME Or %SHGFI_EXETYPE Or %SHGFI_SMALLICON)
                         ImageList_Draw hImg, ShFileInfo.iIcon, @lpdis.hDC, @lpdis.rcItem.nleft, @lpdis.rcItem.nTop, %ILD_TRANSPARENT
                         If ShFileInfo.hIcon Then DestroyIcon ShFileInfo.hIcon
                         SelectObject @lpdis.hDC, hfontOld
                         Function = %TRUE: Exit Function
                       Case %WM_COMMAND
                          Select Case CbCtl
                             Case %IDM_TEST + 1 To %IDM_TEST + %nIDM: MsgBox Str$(CbCtl)
                          End Select
                  End Select
                End Function
                Function PbMain
                    Local hDlg As Long
                    CoInitialize 0
                    Dialog New 0, "Test", , , 100, 100, %WS_CAPTION Or %WS_SYSMENU To hDlg
                    Dialog Show Modal hDlg Call DlgProc
                End Function
              E-MAIL: [email protected]


              • #8

                I've been away from my pc some days, but now I'm back and have
                tested Your sample on W2000, NT4 and W98, and it runs perfectly
                on all platforms!