Announcement

Collapse
No announcement yet.

Have icon, need bmp

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

  • Per Fimmeland
    replied
    Semen,

    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!

    Thanks.

    -p


    ------------------

    Leave a comment:


  • Semen Matusovski
    replied
    I assembled some fragments w/o real test.
    On my PC (Win2000) it works.

    Code:
       #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"
          Else
             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
                   Next
                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) + @pmyitem.sizeA.cx
                @lpmis.itemHeight = Max(GetSystemMetrics(%SM_CYSMICON), @pmyitem.sizeA.cy)
                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)
                Else
                   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 - @pmyitem.sizeA.cy) / 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
          CoUninitialize
      End Function
    ------------------
    E-MAIL: [email protected]

    Leave a comment:


  • Semen Matusovski
    replied
    Per --
    In fragment below don't forget to change file-pathes.

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

    Leave a comment:


  • Per Fimmeland
    replied
    semen,
    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
    Code:
     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 http://www.powerbasic.com/support/pb...ad.php?t=23289
    i have tested it (downloaded complete sample from his site) but it doesn't show up
    any graphics on my w2000.

    -p



    ------------------

    Leave a comment:


  • Semen Matusovski
    replied
    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]

    Leave a comment:


  • Per Fimmeland
    replied
    Semen,
    Your "Third variant - to use Shell functions" works great

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

    Code:
    '
    '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$
    	Wend
    	
       SetForegroundWindow hDlg
       GetCursorPos p
       TrackPopupMenu hPopup, 0, p.x, p.y, 0, hDlg, ByVal %NULL
       
       DestroyMenu hPopUp
    
    End Sub
    -p

    ------------------

    Leave a comment:


  • Semen Matusovski
    replied
    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.

    Code:
      #Compile Exe
      #Dim All
      #Register None
      #Include "win32Api.inc"
    
      $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
    
      %ILD_TRANSPARENT = 1&
    
      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
    
          CoUninitialize
      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).]

    Leave a comment:


  • Per Fimmeland
    started a topic Have icon, need bmp

    Have icon, need bmp

    Hi,

    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 ??

    TIA
    -p


    ------------------
Working...
X