please test my crappy owner-draw menu

[VirusScanner]

You can use the gfxlib I guess, but I tend to not like those kinds of GUIs. You'd have to put years of work into it to make it interface with windows/linux and work like it should, with all the GUI components and everything. You'd be better off writing with wxwidgets or something, then you can compile on windows/linux, I don't know if it allows ownerdraw though.

[axipher]

Well my menu works fine now but no functions yet, and it was all owner drawn, and uses Get/Put[alpha] for the pop-up menu and it's fade in effect. It works fine, but took quite a bit of code, but I only did that because I know nothing about creating libs, resiources, dll's, etc. so I had to use the next best thing, none, except MS Paint for the .bmps, then turned them into a custom file format that turns a 16x16 .bmp into 688 bytes!!!

[sanhen]

This is a long time I find a good code. Can support up to XP update it? I tested in XP is a black menu.

[VANYA]

Window 7 :

[Pierre Bellisle]

And almost height years later...

I had a little something to check with ownerdrawn menu apis, so, while at it, here is a quick code update.

Code: Select all

#define JumpCompiler "<D:\Free\32\fbc.exe>"
#define JumpCompilerCmd "<-s gui -w pedantic>"
#Lang "fb"

#define WIN_INCLUDEALL
#include "windows.bi"

#ifndef ODS_HOTLIGHT
  #define ODS_HOTLIGHT &h0040
#endif
#ifndef ODS_INACTIVE
  #define ODS_INACTIVE &h0080
#endif

declare function WndProc(byval hWnd as HWND, byval message as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT

dim shared as HINSTANCE hInstance
dim shared as string    AppName
dim shared as HWND      hWnd
dim shared as HMENU     hMenu, hMenu_File, hMenu_Help
dim shared as HBRUSH    ColorMenuBrush
dim shared as HBRUSH    ColorHighlightBrush
dim shared as HBRUSH    ColorFrameHighlightBrush
dim shared as DWORD     ColorHighlight
dim shared as DWORD     ColorMenuText

Const IDM_FILE_       = 1
Const IDM_FILE_NEW    = 2
Const IDM_FILE_OPEN   = 3
Const IDM_FILE_SAVE   = 4
Const IDM_FILE_EXIT   = 5
Const IDM_HELP_       = 6
Const IDM_HELP_ABOUT  = 7
'_____________________________________________________________________________

dim as MSG wMsg
dim as WNDCLASS wcls

AppName = "Menu ownerdrawn"
hInstance = GetModuleHandle(null)

wcls.style         = CS_HREDRAW or CS_VREDRAW
wcls.lpfnwndproc   = @WndProc
wcls.cbClsExtra    = 0
wcls.cbWndExtra    = 0
wcls.hInstance     = hInstance
wcls.hIcon         = LoadIcon(hInstance, IDI_APPLICATION)
wcls.hCursor       = LoadCursor(null, IDC_ARROW)
wcls.hbrBackground = cptr(HGDIOBJ, 16)
wcls.lpszMenuName  = 0
wcls.lpszClassName = strptr(AppName)

if RegisterClass(@wcls) then

  ColorMenuText            = GetSysColor(COLOR_MENUTEXT)
  ColorMenuBrush           = CreateSolidBrush(GetSysColor(COLOR_MENU))
  ColorHighlight           = GetSysColor(COLOR_HIGHLIGHT)
  ColorHighlightBrush      = CreateSolidBrush(rgba(255,200,200,0))
  ColorFrameHighlightBrush = CreateSolidBrush(rgba(0,0,255,0))

  Dim WindowSize As SIZEL : WindowSize.cx = 300 : WindowSize.cy = 200
  hWnd = CreateWindowEx(0, AppName, AppName, _
                        WS_VISIBLE or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX, _
                        (GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _
                        (GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _
                        WindowSize.cx, WindowSize.cy, null, null, hInstance, null )

  ShowWindow(hWnd, SW_NORMAL)
  UpdateWindow(hWnd)

  hMenu      = CreateMenu()
  hMenu_File = CreatePopupMenu()
  hMenu_Help = CreatePopupMenu()

  dim as MENUITEMINFO mii
  dim as string text

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_FILE_
  mii.hSubMenu = hMenu_File
  InsertMenuItem(hMenu, 1, TRUE, @mii)

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_HELP_
  mii.hSubMenu = hMenu_Help
  InsertMenuItem(hMenu, 2, TRUE, @mii)

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_FILE_NEW
  mii.hSubMenu = null
  InsertMenuItem(hMenu_File, 1, TRUE, @mii)

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_FILE_OPEN
  mii.hSubMenu = null
  InsertMenuItem(hMenu_File, 2, TRUE, @mii)

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_FILE_SAVE
  mii.hSubMenu = null
  InsertMenuItem(hMenu_File, 3, TRUE, @mii)

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_FILE_EXIT
  mii.hSubMenu = null
  InsertMenuItem(hMenu_File, 4, TRUE, @mii)

  mii.cbsize   = len(mii)
  mii.fMask    = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
  mii.fType    = MFT_OWNERDRAW
  mii.fState   = MFS_ENABLED
  mii.wID      = IDM_HELP_ABOUT
  mii.hSubMenu = null
  InsertMenuItem(hMenu_Help, 1, TRUE, @mii)

  SetMenu(hWnd, hMenu)
  DrawMenuBar(hWnd)

  while GetMessage(@wMsg, null, 0, 0)
    TranslateMessage(@wMsg)
    DispatchMessage(@wMsg)
  wend

  DeleteObject(ColorMenuBrush)
  DeleteObject(ColorHighlightBrush)
end if

end wMsg.wParam
'_____________________________________________________________________________

function WndProc(byval hWnd as HWND, byval message as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
 dim rct              as RECT
 dim hDC              as HDC
 dim Id               as integer
 dim NotificationCode as integer
 dim hwndFrom         as HWND

 WndProc = 0

 select case (message)

   case WM_MEASUREITEM 'Received once on creation
     if wParam = NULL then 'It's a menu
       dim as MEASUREITEMSTRUCT ptr pmis = cptr(MEASUREITEMSTRUCT ptr, lParam)

       select case pmis->CtlType
       case ODT_MENU
         if pmis->itemID = IDM_FILE_ or pmis->itemID = IDM_HELP_ then
           pmis->itemWidth  = 30
           pmis->itemHeight = 20
         else
           pmis->itemWidth  = 100
           pmis->itemHeight = 20
         end if
       end select
     end if

   case WM_DRAWITEM
      if wParam = NULL then 'It's a menu
        dim as DRAWITEMSTRUCT ptr pdis = cptr(DRAWITEMSTRUCT ptr, lParam)

        select case pdis->CtlType
        case ODT_MENU
           hDC = pdis->hDC
           rct = pdis->rcItem

           dim as uinteger action = pdis->itemAction
           dim as uinteger state  = pdis->itemState
           dim as uinteger miid   = pdis->itemID

           if (state and (ODS_HOTLIGHT)) then
                 FillRect(hDC, @rct, ColorHighlightBrush)
                 FrameRect(hDC, @rct, ColorFrameHighlightBrush)
                 SetTextColor(hDC, ColorHighlight)
           elseif (state and (ODS_SELECTED)) then
                 FillRect(hDC, @rct, ColorHighlightBrush)
                 FrameRect(hDC, @rct, ColorFrameHighlightBrush)
                 SetTextColor(hDC, ColorHighlight)
           else
              FillRect(hDC, @rct, ColorMenuBrush)
              FrameRect(hDC, @rct, ColorMenuBrush)
              SetTextColor(hDC, ColorMenuText)
           end if

           dim as DRAWTEXTPARAMS dtp
           dim as string text
           dim as RECT textrct
           dim as uinteger options

           dtp.cbSize = len(dtp)
           dtp.iTabLength   = 4
           dtp.iLeftMargin  = 4
           dtp.iRightMargin = 4

           textrct.Left   = rct.Left   + 2
           textrct.Top    = rct.Top    + 2
           textrct.Right  = rct.Right  - 2
           textrct.Bottom = rct.Bottom - 2

           select case miid
             case IDM_FILE_      : text = "&File"  : options = DT_CENTER
             case IDM_FILE_NEW   : text = "&New"   : options = DT_LEFT
             case IDM_FILE_OPEN  : text = "&Open"  : options = DT_LEFT
             case IDM_FILE_SAVE  : text = "&Save"  : options = DT_LEFT
             case IDM_FILE_EXIT  : text = "E&xit"  : options = DT_LEFT
             case IDM_HELP_      : text = "&Help"  : options = DT_CENTER
             case IDM_HELP_ABOUT : text = "&About" : options = DT_LEFT
           end select
           SetBKMode(hDC, TRANSPARENT)
           options or= DT_EXPANDTABS or DT_VCENTER
           DrawTextEx(hDC, strptr(text), len(text), @textrct, options, @dtp)

        end select
      end if

   case WM_COMMAND
     hwndFrom         = cptr(HWND, lParam)
     NotificationCode = HIWORD(wParam)
     Id               = LOWORD(wParam)
     if hwndFrom <= 0 then
       select case NotificationCode
         case 0
           select case Id
             case IDM_FILE_EXIT
               PostQuitMessage(0)
           end select
       end select
     end if

   case WM_DESTROY
     PostQuitMessage(0)

   case else
     WndProc = DefWindowProc(hWnd, message, wParam, lParam)

 end select

end function
'_____________________________________________________________________________
'

[kcvinu]

Hi,
It worked in windows 8 x86 but same as @VANYA. Everything is in black backcolor.

[jj2007]

It worked in windows 8 x86 but same as @VANYA. Everything is in black backcolor.

Same on Win7-64.

[Josep Roca]

Change the rgb's ro bgr.

Code: Select all

            hBr_MIIBckgrnd = CreateSolidBrush(bgr(255,255,255))
            hBr_MBckgrnd = CreateSolidBrush(GetSysColor(COLOR_MENU))
            hBr_MouseOver_Bckgrnd = CreateSolidBrush(bgr(255,200,200))
            hBr_MouseOver_Frame = CreateSolidBrush(bgr(255,0,0))

[jj2007]

Change the rgb's ro bgr.

Yep, that did the trick... so FB changed the rgb() behaviour after 2005. Good to know, thanks.

[Pierre Bellisle]

kcvinu & jj2007,

"Everything is in black backcolor"
Did you have black menus with the updated code I posted?

[Pierre Bellisle]

Some quick observation...
CreateSolidBrush() ask for RGB, so BGR is to be avoided or the colours won't match.
FB's rgb() automatically set the alpha channel to &hFF for opaque.
bgr() does not, leaving it to &H00. This is the reason why it worked.

With CreateSolidBrush() the high-order byte must be zero. 0x00bbggrr
So CreateSolidBrush(rgba(r,g,b,0)) will give the colours that was probably intended by dkl.

[jj2007]

Did you have black menus with the updated code I posted?

No, your menus are grey because you avoided the rgb/bgr problem using GetSysColor().

[Pierre Bellisle]

I see,
The colors where fine on my side, this is a good thing that yours where not.
I was literraly doing a GetSysColor(GetSysColor(Colour)), plus I had many more issues.

I did updated the code.
Finally, except for the rgba() vs rgb() correction
and the "if wParam = NULL" in WM_MEASUREITEM and WM_DRAWITEM,
the program is in essence a copy of the one from dkl.

[deltarho[1859]]

Hi Pierre

Off topic: How peaceful it is now that MCM is no longer posting at PB. It is over 140 days since his last undeleted post so either he got a long suspension or got his marching orders for good.

Regards
David Roberts

[Josep Roca]

> CreateSolidBrush() ask for RGB, so BGR is to be avoided or the colours won't match.

Hi Pierre. Apparently you don't know that the FB's BGR function is, in fact, a RGB function. Because an incompatible RGB function is used by the FB's graphic library, RGB was named as BGR to avoid collisions.

From the help file:

Note for Windows API programmers: The macro named RGB in the Windows references has been renamed BGR in the FB headers for Windows to avoid collisions.

Unfortunately, reversing the letters was not a wise choice.