please test my crappy owner-draw menu

Windows specific questions.
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: please test my crappy owner-draw menu

Post by Pierre Bellisle »

Hi David,

Still off topic: Agreed, it might be my imagination
but I feel there is a lot of new peoples now posting
who probably didn't wanted to get involved with him.
Life is good! :-)
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: please test my crappy owner-draw menu

Post by Pierre Bellisle »

Hola José,

Despite the note about the macro,
I based my conclusion on the result of the following code
where rgb() and bgr() do not give the same colour order.

Code: Select all

 MessageBox(HWND_DESKTOP, "rgb(&hAA, &hBB, &hCC) = 0x" & HEX(rgb(&hAA, &hBB, &hCC), 8) & CHR$(13, 10) & _  'Give 0xFFAABBCC 
                          "bgr(&hAA, &hBB, &hCC) = 0x" & HEX(bgr(&hAA, &hBB, &hCC), 8), _                  'Give 0x00CCBBAA
                          "rgb() & bgr()", MB_OK OR MB_TOPMOST)
Last edited by Pierre Bellisle on Oct 20, 2018 16:44, edited 1 time in total.
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: please test my crappy owner-draw menu

Post by Pierre Bellisle »

José,
I did a quick test in PowerBASIC,

So to be clear, in fb,
rgb() is bgr()
and bgr() is rgb().

Yep, having those letters reverse is really a counter intuitive surprise!
The kind of thing you cannot forget once you know it...

Code: Select all

 Colour    = rgb(&h11,&h22,&h33)      
 ColourRed = GetRValue(Colour) 'Will give 0x33
 
nimdays
Posts: 236
Joined: May 29, 2014 22:01
Location: West Java, Indonesia

Re: please test my crappy owner-draw menu

Post by nimdays »

From the manual,RGB function returns an unsigned integer in the format &hAARRGGBB
Josep Roca
Posts: 564
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: please test my crappy owner-draw menu

Post by Josep Roca »

Which is not compatible with Windows.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: please test my crappy owner-draw menu

Post by jj2007 »

FB's rgb() is certainly unique, but probably well documented in the help file, so that Beginners understand it immediately.

Code: Select all

00336699	C RGB(0x99, 0x66, 0x33)
00336699	Masm32 RGB 099h, 66h, 33h
00336699	MasmBasic RgbCol(99h, 66h, 33h)
00336699	PowerBasic Rgb(99h, 66h, 33h)
00336699   FreeBasic bgr(&h99, &h66, &h33)
FF996633	FreeBasic rgb(&h99, &h66, &h33)
nastasa eodor
Posts: 182
Joined: Dec 18, 2018 16:37
Location: Germany, Hessdorf
Contact:

Re: please test my crappy owner-draw menu

Post by nastasa eodor »

at quick look...you can try that

Code: Select all

''option explicit


#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 hInstance as HINSTANCE
dim shared as string prog_name
prog_name = "menu_test"
dim as MSG wMsg
hInstance = GetModuleHandle(null)


dim as WNDCLASS wcls
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(prog_name)
if (RegisterClass(@wcls) = false) then end


dim shared hWnd as HWND
dim shared as HMENU hMenu
dim shared as HMENU hMenu_File, hMenu_Help


dim shared as HBRUSH hBr_MouseOver_Bckgrnd, hBr_MouseOver_Frame, hBr_MIIBckgrnd, hBr_MBckgrnd

            hBr_MIIBckgrnd = CreateSolidBrush(&HFF)
            hBr_MBckgrnd = CreateSolidBrush(GetSysColor(COLOR_MENU))
            hBr_MouseOver_Bckgrnd = CreateSolidBrush(&HFF0000)
            hBr_MouseOver_Frame = CreateSolidBrush(&H00FF)

enum
   IDM_FILE_ = 1
   IDM_FILE_NEW
   IDM_FILE_OPEN
   IDM_FILE_SAVE
   IDM_FILE_EXIT
   IDM_HELP_
   IDM_HELP_ABOUT
end enum

'--------------------------------------------------------------------------------------------------------------------------------
'
' Create the window and show it
' 
'
'
hWnd =  CreateWindowEx( 0, prog_name, prog_name, _
                        WS_VISIBLE or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX, _
                        0 , 0 , 600, 500 , _
                        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

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

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


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

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

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

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


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


SetMenu(hWnd, hMenu)
DrawMenuBar(hWnd)











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


DeleteObject(hBr_MIIBckgrnd)
DeleteObject(hBr_MBckgrnd)
DeleteObject(hBr_MouseOver_Bckgrnd)
DeleteObject(hBr_MouseOver_Frame)

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, NotificationCode as integer, hwndFrom as HWND

   WndProc = 0
   
   select case ( message )

      case WM_MEASUREITEM
         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


      case WM_DRAWITEM
         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_SELECTED)) then
                  print "selected"
                  FillRect(hDC, @rct, hBr_MouseOver_Frame)
                  'FrameRect(hDC, @rct, hBr_MouseOver_Frame)
            elseif (state and (ODS_HOTLIGHT)) then
                  print "over"
                  FillRect(hDC, @rct, hBr_MouseOver_Bckgrnd)
                  'FrameRect(hDC, @rct, hBr_MBckgrnd)
            else
               'select case miid
                '  case IDM_FILE_, IDM_HELP_
                        FillRect(hDC, @rct, hBr_MBckgrnd)
               '   case else
                '        FillRect(hDC, @rct, hBr_MIIBckgrnd)
                '  end select
            end if

            dim as DRAWTEXTPARAMS dtp
            dim as string text
            dim as RECT textrct
            dim as uinteger options
            with dtp
               .cbSize = len(dtp)
               .iTabLength = 4
               .iLeftMargin = 4
               .iRightMargin = 4
            end with
            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

        
      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
Post Reply