PureBasic Forums - English

Code: Select all

Global Dim options.s(4)
options(1) = "Open"   
options(2) = "Save"   
options(3) = "Save as"
options(4) = "Quit"

LoadFont(0, "Verdana", 16)

Procedure WinProc(hWnd, Msg, wParam, lParam)
  Static selectedbrush
  selectedbrush = CreateSolidBrush_(GetSysColor_(#COLOR_MENUHILIGHT))
  
  result = #PB_ProcessPureBasicEvents
  
  Select Msg
    Case #WM_DESTROY
      DeleteObject_(selectedbrush)
      
    Case #WM_MEASUREITEM:
      *lpmis.MEASUREITEMSTRUCT = lParam
      With *lpmis
        \itemWidth = 200
        \itemHeight = 40
      EndWith
      
    Case #WM_DRAWITEM:
      *lpdis.DRAWITEMSTRUCT = lParam
      If *lpdis\itemState & #ODS_SELECTED
        bgbrush = selectedbrush
      Else
        bgbrush = GetStockObject_(#WHITE_BRUSH)
      EndIf
      With *lpdis
        SetBkMode_(\hDC, #TRANSPARENT)
        SelectObject_(\hDC, bgbrush)
        SelectObject_(\hDC, GetStockObject_(#NULL_PEN))
        Rectangle_(\hDC, \rcItem\left, \rcItem\top, \rcItem\right, \rcItem\bottom)
        \rcItem\left + 2
        \rcItem\top + 2
        SelectObject_(\hDC, FontID(0))
        DrawText_(\hDC, options(\itemID), -1, @\rcItem, 0)
      EndWith
      
  EndSelect
  ProcedureReturn result
EndProcedure

If OpenWindow(0, 200, 200, 200, 120, "Popup-Menu Example")
  SetWindowCallback(@WinProc())
  
  hMenu = CreatePopupMenu(0)      ; creation of the pop-up menu begins...
  MenuItem(1, options(1))         ; You can use all commands for creating a menu
  MenuItem(2, options(2))         ; just like in a normal menu...
  MenuItem(3, options(3))
  MenuItem(4, options(4))
  
  For i=0 To 3
    With mii.MENUITEMINFO
      \cbSize = SizeOf (MENUITEMINFO)
      \fMask = #MIIM_TYPE
      \fType = #MFT_OWNERDRAW
      \dwTypeData = @options(i)
      SetMenuItemInfo_(hMenu, i, #True, @mii)
    EndWith
  Next
  
  Repeat
    Event = WaitWindowEvent()     ; check for window events
    
    Select Event
      Case #PB_Event_RightClick       ; right mouse button was clicked =>
        DisplayPopupMenu(0, WindowID(0))  ; now display the popup-menu
        
      Case #PB_Event_Menu        ; an item of the popup-menu was clicked
        Select EventMenu()       ; get the clicked menu item...
          Case 1 : Debug "Menu: Open"
          Case 2 : Debug "Menu: Save"
          Case 3 : Debug "Menu: Save as"
          Case 4 : End
        EndSelect
        
    EndSelect
    
  Until Event = #PB_Event_CloseWindow
EndIf

Code: Select all

Global i.ICONINFO,curHnd

i\fIcon = #True
LoadFont(0,"MS Sans Serif",16,#PB_Font_Bold)

Procedure SetImage(Menu, index, ico,Text$ ,Color)
CreateImage(10, 120, 30 ,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(10))
  Box(0,0,120,30,$FFFFFF)
  DrawingMode(#PB_2DDrawing_Transparent )
  DrawingFont(FontID(0))
  DrawText(34,2,Text$,Color)
StopDrawing()

i\hbmMask = ImageID(10)
i\hbmColor = ImageID(10)
curHnd = CreateIconIndirect_(i)

ExtractIconEx_("shell32.dll", ico, 0, @iIcon, 1)
im=CreateImage(#PB_Any, 120, 30,32, #PB_Image_Transparent )
StartDrawing(ImageOutput(im))
  DrawImage(iIcon, 6, 8)
  DrawImage(curHnd, 0, 0)
StopDrawing()
  SetMenuItemBitmaps_(Menu,index,#MF_BYPOSITION, ImageID(im),0)
  DestroyIcon_(iIcon)
EndProcedure

OpenWindow(0, 0, 0, 600, 300, "TEST",#PB_Window_SystemMenu| #PB_Window_ScreenCentered|#PB_Window_SizeGadget)

hMenu = CreatePopupMenu(1)
		MenuItem(3,"")
		MenuItem(4,"")
		sMenu = OpenSubMenu("")
		MenuItem(2,"")
		MenuItem(3,"")
		MenuItem(4,"")
		MenuItem(5,"")
CloseSubMenu()                    

SetImage(hMenu, 0, 4,"Load",$FF0000)
SetImage(hMenu, 1, 130,"Save As",$00FF00)
SetImage(hMenu, 2, 194,"Options",$0000FF)
SetImage(sMenu, 0,4,"Test #1",$EC07F4)
SetImage(sMenu, 1, 43,"Test #2",$EC07F4)
SetImage(sMenu, 2, 10,"Test #3",$EC07F4)
SetImage(sMenu, 3, 90,"Test #4",$EC07F4)

Repeat
    Select WaitWindowEvent()
 
      Case #PB_Event_RightClick
            DisplayPopupMenu(1, WindowID(0))   

       
      Case #PB_Event_CloseWindow
        Quit = 1
       
    EndSelect
Until Quit = 1

Code: Select all

Procedure.i GetColWidth(sColTxt.s, iFontID.i)
;#-------------------------------------------
;This Procedure does not draw anything, it just verifies text width in pixels
Protected iColW.i

              If StartDrawing(WindowOutput(#WinMain))

                      DrawingMode(#PB_2DDrawing_Default)
                      DrawingFont(FontID(iFontID))
                      iColW = TextWidth(sColTxt)
                      StopDrawing()
              EndIf

              ProcedureReturn(iColW)
EndProcedure

Procedure PfPop(List sItemsList.s(), iFontID.i, iColourEven.i, iColourOdd.i, iCursorPosX.i, iCursorPosY.i)
;#--------------------------------------------------------------------------------------------------------
Protected lrc.RECT
Protected iRowH.i, iItemW.i, iListW.i, iListH.i
Protected iRowTotal.i = ListSize(sItemsList())

              ;Minimum width based on menu item text width
              ForEach sItemsList()

                        iItemW = GetColWidth(sItemsList(), iFontID)
                     If(iItemW > iListW) : iListW = iItemW : EndIf
              Next

              ;Temp Window to determine ListIcon height from row height
              If OpenWindow(#WinTemp, 0, 0, 200, 100, "", #PB_Window_Invisible | #PB_Window_BorderLess)

                      ListIconGadget(#ListTemp, 0, 0, 200, 100, "", 200, #LVS_NOCOLUMNHEADER)
                       SetGadgetFont(#ListTemp, FontID(iFontID))
                       AddGadgetItem(#ListTemp, -1, "TEMP TEXT")
                       lrc\left = #LVIR_LABEL
                      SendMessage_(GadgetID(#ListTemp), #LVM_GETITEMRECT, 0, lrc)
                          iRowH = lrc\bottom - lrc\Top
                         iListH = (iRowTotal * iRowH)
                      CloseWindow(#WinTemp)
              EndIf

              ;Define the pop-up Window and display. Magic numbers (40, 2) to enhance appearance
              If OpenWindow(#WinPop, iCursorPosX, iCursorPosY, (iListW + 40), (iListH + 2), "", #PB_Window_Invisible | #PB_Window_BorderLess)

                      ;Magic numbers to oversize ListIcon, hiding scroll bars
                      ;                        x   y  w              h                  col 0
                      ListIconGadget(#ListPop, -5, 0, (iListW + 70), (iListH + 35), "", (iListW + 40), #LVS_NOCOLUMNHEADER)

                       SetGadgetFont(#ListPop, FontID(iFontID))

                       ForEach sItemsList()

                              AddGadgetItem(#ListPop, -1, sItemsList())
                       Next

                                SendMessage_(GadgetID(#ListPop), #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, #LVS_EX_ONECLICKACTIVATE)
                       ProfSetListRowColours(#ListPop, iColourEven, iColourOdd, iRowTotal)

                         HideWindow(#WinPop, #False)
                       StickyWindow(#WinPop, #True)
              EndIf
EndProcedure

Code: Select all

MenuItem(1, options(1))                ; You can use all commands for creating a menu
  MenuItem(2, options(2))                ; just like in a normal menu...
OpenSubMenu("my SubMenu")
  MenuItem(3, options(3))
  MenuItem(4, options(4))

Code: Select all

DrawText_(\hDC, options(\itemID), -1, @\rcItem, 0)