Pop-up Menu Font

Windows specific forum
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Pop-up Menu Font

Post by IdeasVacuum »

Before I define my own instead, is there a way to apply font and fontsize to a pop-up menu? The default on a high-res tablet screen is way too tiny.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Pop-up Menu Font

Post by netmaestro »

Howzis?

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
Can't really get away from owner drawing the menu. But it's not difficult as you can see.
BERESHEIT
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Pop-up Menu Font

Post by RASHAD »

I did that long time back
You have 2 options now :)
Have fun

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
Egypt my love
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Pop-up Menu Font

Post by IdeasVacuum »

Thanks guys - I thought nobody had a solution and then two buses came along at once!

I have in the meantime tried my own solution, consisting of a borderless window and an oversized single column ListIcon (oversized to have just the one column showing and no scrollbars). This allows me to define the font and apply alternate row colours. Only one pop-up menu at a time, so I define them on-the-fly.

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
[/size]
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Post Reply