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! :-)
please test my crappy owner-draw menu
-
- Posts: 56
- Joined: Dec 11, 2016 17:22
-
- Posts: 56
- Joined: Dec 11, 2016 17:22
Re: please test my crappy owner-draw menu
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.
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.
-
- Posts: 56
- Joined: Dec 11, 2016 17:22
Re: please test my crappy owner-draw menu
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...
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
Re: please test my crappy owner-draw menu
From the manual,RGB function returns an unsigned integer in the format &hAARRGGBB
-
- Posts: 564
- Joined: Sep 27, 2016 18:20
- Location: Valencia, Spain
Re: please test my crappy owner-draw menu
Which is not compatible with Windows.
Re: please test my crappy owner-draw menu
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)
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: please test my crappy owner-draw menu
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