Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' DrawMenu - a sample of how to include bitmaps in ownerdrawn menus. ' Public Domain by Borje Hagsten, October, 2000. Updated Feb, 2002. ' Free to use and modify, but as always, at own responsibility..' ' Update - February 12, 2001 ' Complete change of way to store menu item text. Now use a separate function ' for this, GetMenuTxt. Advantages - is cleaner and no more hassle with ' GetMenuItemInfo, which seems to behave differently depending on system. ' Win95/98, different versions of NT 4 and 5 - they all seem to behave ' differently. Think MS has managed to screw up real bad there.. ' ' Files: DrawMenu.exe, DrawMenu.bas, DrawMenu.pbr, DrawMenu.rc and Toolbar.bmp ' The bmp contains some 16x16 bitmaps for the menu items. Drawmenu.zip can be ' downloaded from : http://www.algonet.se/~hagsten/pb/drawmenu.zip ' ' Many thanks to Fred Oxenby, Semen Matusovski, Paul Noble and Paul Squires ' for valuable tips and help with testing. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ #COMPILE EXE #RESOURCE "DRAWMENU.PBR" #INCLUDE "WIN32API.INC" '-------------------------------------------------------------------- %ID_TEXT = 10 %IDM_FILE = 100 %IDM_NEW = 101 %IDM_OPEN = 102 %IDM_SAVE = 103 %IDM_SAVEAS = 104 %IDM_EXIT = 109 %IDM_EDIT = 120 %IDM_UNDO = 121 %IDM_CUT = 123 %IDM_COPY = 124 %IDM_PASTE = 125 %IDM_SELALL = 126 '-------------------------------------------------------------------- GLOBAL hDlg AS LONG, hEdit AS LONG, Oldproc AS LONG GLOBAL hMnu AS LONG, hmnuFile AS LONG, hmnuEdit AS LONG, hmnuLang AS LONG '-------------------------------------------------------------------- DECLARE CALLBACK FUNCTION DlgProc DECLARE FUNCTION GetMenuTxt(BYVAL ItemId AS LONG) AS STRING DECLARE FUNCTION SetMenuBitmap (BYVAL bNum AS LONG) AS LONG DECLARE FUNCTION TextWndProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG DECLARE SUB DrawMenuItem(lp AS LONG) DECLARE SUB MenuEditSet(BYVAL wParam AS LONG) '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Main entrance - create dialog, controls and menu, etc. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION PBMAIN DIALOG NEW 0, "DrawMenu Test", , , 320, 200, %WS_OVERLAPPEDWINDOW, TO hDlg CONTROL ADD TEXTBOX, hDlg, %ID_TEXT, "", 0, 0, 320, 188, %WS_CHILD OR %ES_MULTILINE OR _ %WS_VSCROLL OR %WS_HSCROLL OR %ES_AUTOVSCROLL OR %ES_NOHIDESEL OR _ %ES_WANTRETURN, %WS_EX_CLIENTEDGE CALL DlgProc CONTROL HANDLE hDlg, %ID_TEXT TO hEdit '-> Subclass the edit control for own right-click menu, etc OldProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(TextWndProc)) '-> Build menu MENU NEW BAR TO hMnu MENU NEW POPUP TO hmnuFile MENU ADD STRING, hMnuFile, GetMenuTxt(%IDM_NEW), %IDM_NEW, %MF_ENABLED MENU ADD STRING, hMnuFile, GetMenuTxt(%IDM_OPEN), %IDM_OPEN, %MF_ENABLED MENU ADD STRING, hMnuFile, "-", 0, 0 MENU ADD STRING, hMnuFile, GetMenuTxt(%IDM_SAVE), %IDM_SAVE, %MF_ENABLED MENU ADD STRING, hMnuFile, GetMenuTxt(%IDM_SAVEAS), %IDM_SAVEAS, %MF_ENABLED MENU ADD STRING, hMnuFile, "-", 0, 0 MENU ADD STRING, hMnuFile, GetMenuTxt(%IDM_EXIT), %IDM_EXIT, %MF_ENABLED MENU ADD POPUP, hMnu, GetMenuTxt(%IDM_FILE), hmnuFile, %MF_ENABLED MENU NEW POPUP TO hmnuEdit MENU ADD STRING, hmnuEdit, GetMenuTxt(%IDM_UNDO), %IDM_UNDO, %MF_ENABLED MENU ADD STRING, hMnuEdit, "-", 0, 0 MENU ADD STRING, hmnuEdit, GetMenuTxt(%IDM_CUT), %IDM_CUT, %MF_ENABLED MENU ADD STRING, hmnuEdit, GetMenuTxt(%IDM_COPY), %IDM_COPY, %MF_ENABLED MENU ADD STRING, hmnuEdit, GetMenuTxt(%IDM_PASTE), %IDM_PASTE, %MF_ENABLED MENU ADD STRING, hMnuEdit, "-", 0, 0 MENU ADD STRING, hmnuEdit, GetMenuTxt(%IDM_SELALL), %IDM_SELALL, %MF_ENABLED MENU ADD POPUP, hMnu, GetMenuTxt(%IDM_EDIT), hmnuEdit, %MF_ENABLED MENU ATTACH hMnu, hDlg ' Make all menu items ownerdrawn ModifyMenu hmnuFile, %IDM_NEW, %MF_OWNERDRAW, %IDM_NEW, BYVAL %NULL ModifyMenu hmnuFile, %IDM_OPEN, %MF_OWNERDRAW, %IDM_OPEN, BYVAL %NULL ModifyMenu hmnuFile, %IDM_SAVE, %MF_OWNERDRAW, %IDM_SAVE, BYVAL %NULL ModifyMenu hmnuFile, %IDM_SAVEAS, %MF_OWNERDRAW, %IDM_SAVEAS, BYVAL %NULL ModifyMenu hmnuFile, %IDM_EXIT, %MF_OWNERDRAW, %IDM_EXIT, BYVAL %NULL ModifyMenu hmnuEdit, %IDM_UNDO, %MF_OWNERDRAW, %IDM_UNDO, BYVAL %NULL ModifyMenu hmnuEdit, %IDM_CUT, %MF_OWNERDRAW, %IDM_CUT, BYVAL %NULL ModifyMenu hmnuEdit, %IDM_COPY, %MF_OWNERDRAW, %IDM_COPY, BYVAL %NULL ModifyMenu hmnuEdit, %IDM_PASTE, %MF_OWNERDRAW, %IDM_PASTE, BYVAL %NULL ModifyMenu hmnuEdit, %IDM_SELALL, %MF_OWNERDRAW, %IDM_SELALL, BYVAL %NULL DIALOG SHOW MODAL hDlg CALL DlgProc END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Dialog callback '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ CALLBACK FUNCTION DlgProc SELECT CASE CBMSG CASE %WM_COMMAND SELECT CASE CBCTL CASE %IDM_NEW : BEEP 'just to show it works.. CASE %IDM_OPEN : BEEP CASE %IDM_SAVE : BEEP CASE %IDM_SAVEAS : BEEP CASE %IDM_EXIT : DIALOG END CBHNDL '<- End the program CASE %IDM_UNDO, %IDM_CUT, %IDM_COPY, %IDM_PASTE, %IDM_SELALL 'Pass these on TextWndProc hEdit, CBMSG, CBWPARAM, CBLPARAM END SELECT CASE %WM_DESTROY '-> Program exit, un-subclass textbox IF OldProc THEN SetWindowLong CBHNDL, %GWL_WNDPROC, OldProc CASE %WM_INITMENUPOPUP IF CBLPARAM = 1 THEN 'main Edit menu is activated TextWndProc CBHNDL, CBMSG, CBWPARAM, CBLPARAM 'process it in TextWndProc END IF CASE %WM_MEASUREITEM, %WM_DRAWITEM 'Pass these on and TextWndProc CBHNDL, CBMSG, CBWPARAM, CBLPARAM 'process them in TextWndProc CASE %WM_SIZE 'Resize textbox to dialog IF CBWPARAM <> %SIZE_MINIMIZED THEN MoveWindow hEdit, 0, 0, LOWRD(CBLPARAM), HIWRD(CBLPARAM), %TRUE END IF END SELECT END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Called from %WM_DRAWITEM '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB DrawMenuItem(lp AS LONG) LOCAL hBmp AS LONG ' icon to draw LOCAL hBrush AS LONG ' brush used for selection draw LOCAL bHighlight AS LONG ' higlighted flag LOCAL MenuOffsetX AS LONG ' offset from bitmap edge to text LOCAL drawTxtFlags AS LONG ' how we draw the text LOCAL drawBmpFlags AS LONG ' how we draw the icon LOCAL menuBtnW AS LONG ' Width of the menubutton, in pixels LOCAL strMenu AS STRING ' string for the menu item LOCAL strMenu2 AS STRING LOCAL rcSep AS RECT ' RECT used for drawing areas LOCAL lpSize AS SIZEL ' used to calculate the text extent LOCAL lpdi AS DRAWITEMSTRUCT PTR ' we fill this from the received pointer lpdi = lp ' Get the struct info from the pointer menuBtnW = 18 'bitmaps are 16 pixels wide, add 2 for the button's frame '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Get menu item string and split up into ev. text and shortcut part '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ strMenu2 = GetMenuTxt(@lpdi.itemID) IF INSTR(strMenu2, $TAB) THEN 'if it has shortcut (Ctrl+X, etc.) strMenu = TRIM$(PARSE$(strMenu2, $TAB, 1)) strMenu2 = TRIM$(PARSE$(strMenu2, $TAB, 2)) ELSE strMenu = TRIM$(strMenu2) strMenu2 = "" END IF '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Calculate the height of the menu string '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CALL GetTextExtentPoint32(@lpdi.hDC, BYVAL STRPTR(strMenu), LEN(strMenu), lpSize) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' See what drawing actions we need to take '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (@lpdi.itemState AND %ODS_SELECTED) THEN 'menu item is selected SetBkColor @lpdi.hDC, GetSysColor(%COLOR_HIGHLIGHT) hBrush = GetSysColorBrush(%COLOR_HIGHLIGHT) SetTextColor @lpdi.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT) bHighlight = %TRUE 'flag, so later we can add or remove the 3D edge around the icon ELSEIF (@lpdi.itemState AND %ODS_GRAYED) THEN 'menu item is disabled SetBkColor @lpdi.hDC, GetSysColor(%COLOR_MENU) hBrush = GetSysColorBrush(%COLOR_MENU) SetTextColor @lpdi.hDC, GetSysColor(%COLOR_MENUTEXT) ELSE 'not selected or disabled SetBkColor @lpdi.hDC, GetSysColor(%COLOR_MENU) hBrush = GetSysColorBrush(%COLOR_MENU) SetTextColor @lpdi.hDC, GetSysColor(%COLOR_MENUTEXT) END IF '%DST_COMPLEX = &H0, %DST_TEXT = &H1, %DST_PREFIXTEXT = &H2, %DST_ICON = &H3, %DST_BITMAP = &H4 drawTxtFlags = &H2 '%DST_PREFIXTEXT drawBmpFlags = &H4 '%DST_BITMAP ' State types for DrawState() ' %DSS_NORMAL = &H0 ' %DSS_UNION = &H10 '// Gray string appearance ' %DSS_DISABLED = &H20 ' %DSS_DEFAULT = &H40 ' %DSS_MONO = &H80 ' %DSS_RIGHT = &H8000 IF (@lpdi.itemState AND %ODS_GRAYED) THEN IF (@lpdi.itemState AND %ODS_SELECTED) THEN SetTextColor @lpdi.hDC, GetSysColor(%COLOR_GRAYTEXT) ELSE drawTxtFlags = drawTxtFlags OR &H20 '%DSS_DISABLED END IF drawBmpFlags = drawBmpFlags OR &H20 '%DSS_DISABLED END IF '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Calculate where we begin drawing the highlight area '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ MenuOffsetX = menuBtnW + 5 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Modify the RECT accordingly '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ rcSep = @lpdi.rcItem IF (@lpdi.itemState AND %ODS_GRAYED) THEN rcSep.nLeft = 0 ELSE rcSep.nLeft = MenuOffsetX END IF SELECT CASE @lpdi.itemID CASE %IDM_SELALL, %IDM_SAVEAS 'No icons for these so draw rcSep.nLeft = 0 'selection all the way out.. END SELECT '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Fill the RECT with proper color, either COLOR_MENU or ' COLOR_HIGHLIGHT, depending on selection state. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CALL FillRect(@lpdi.hDC, rcSep, hBrush) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Draw the bitmap button '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF (@lpdi.itemState AND %ODS_GRAYED) = 0 THEN SELECT CASE @lpdi.itemID CASE %IDM_NEW : hBmp = SetMenuBitmap(0) CASE %IDM_OPEN : hBmp = SetMenuBitmap(1) CASE %IDM_SAVE : hBmp = SetMenuBitmap(2) CASE %IDM_EXIT : hBmp = SetMenuBitmap(7) CASE %IDM_UNDO : hBmp = SetMenuBitmap(6) CASE %IDM_CUT : hBmp = SetMenuBitmap(3) CASE %IDM_COPY : hBmp = SetMenuBitmap(4) CASE %IDM_PASTE : hBmp = SetMenuBitmap(5) END SELECT IF hBmp <> 0 THEN 'Draw the item bitmap CALL DrawState(@lpdi.hDC, 0&, 0&, hBmp, 0&, @lpdi.rcItem.nLeft + 2, _ (((@lpdi.rcItem.nTop + @lpdi.rcItem.nBottom) \ 2)) - 8, 16, 16, drawBmpFlags) DeleteObject hBmp 'Delete the bitmap when done, to avoid memory leaks! '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Calculate the RECT we need for the 3D edge '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ rcSep = @lpdi.rcItem rcSep.nLeft = 0 'Size and pos for "button".. rcSep.nRight = menuBtnW + 3 rcSep.nBottom = rcSep.nTop + GetSystemMetrics(%SM_CYMENU) + 1 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Draw the 3D edge if the item is highlighted, or remove it if it's not '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF bHighlight = %TRUE THEN CALL DrawEdge(@lpdi.hDC, rcSep, %BDR_RAISEDINNER, %BF_RECT) ELSE CALL DrawEdge(@lpdi.hDC, rcSep, %BDR_SUNKENINNER, %BF_FLAT OR %BF_RECT) END IF END IF END IF '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Draw the menu text next to bitmap button, with centered y-pos '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ IF LEN(strMenu) <> 0 THEN rcSep.nLeft = menuBtnW + 7 : rcSep.nRight = @lpdi.rcItem.nRight rcSep.nTop = rcSep.nTop + (((rcSep.nBottom - rcSep.nTop) - lpSize.cy) \ 2) CALL DrawState(@lpdi.hDC, 0&, 0&, BYVAL STRPTR(strMenu), LEN(strMenu), _ rcSep.nLeft, rcSep.nTop, rcSep.nRight, lpSize.cy, drawTxtFlags) rcSep.nLeft = @lpdi.rcItem.nRight - 60 CALL DrawState(@lpdi.hDC, 0&, 0&, BYVAL STRPTR(strMenu2), LEN(strMenu2), _ rcSep.nLeft, rcSep.nTop, rcSep.nRight, lpSize.cy, drawTxtFlags) END IF '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 'Copy the structure back to the pointer '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ lp = lpdi END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Return menu item string '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION GetMenuTxt(BYVAL ItemId AS LONG) AS STRING SELECT CASE ItemId CASE %IDM_FILE : FUNCTION = "&File" CASE %IDM_NEW : FUNCTION = "&New" & CHR$(9) & "Ctrl + N" CASE %IDM_OPEN : FUNCTION = "&Open..." & CHR$(9) & "Ctrl + O" CASE %IDM_SAVE : FUNCTION = "&Save" & CHR$(9) & "Ctrl + S" CASE %IDM_SAVEAS : FUNCTION = "&Save as..." CASE %IDM_EXIT : FUNCTION = "E&xit" & CHR$(9) & "Alt + F4" CASE %IDM_EDIT : FUNCTION = "&Edit" CASE %IDM_UNDO : FUNCTION = "&Undo" & CHR$(9) & "Ctrl + Z" CASE %IDM_CUT : FUNCTION = "Cu&t" & CHR$(9) & "Ctrl + X" CASE %IDM_COPY : FUNCTION = "&Copy" & CHR$(9) & "Ctrl + C" CASE %IDM_PASTE : FUNCTION = "&Paste" & CHR$(9) & "Ctrl + V" CASE %IDM_SELALL : FUNCTION = "Select &All" & CHR$(9) & "Ctrl + A" END SELECT END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Enable or disable edit menu items '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB MenuEditSet(BYVAL wParam AS LONG) LOCAL lRes AS LONG, selStart AS LONG, selEnd AS LONG IF SendMessage(hEdit, %EM_CANUNDO, 0, 0) THEN '<- UNDO CALL EnableMenuItem (wParam, %IDM_UNDO, %MF_ENABLED) ELSE CALL EnableMenuItem (wParam, %IDM_UNDO, %MF_GRAYED) END IF lRes = SendMessage(hEdit, %EM_GETSEL, VARPTR(selStart), VARPTR(selEnd)) IF selStart = selEnd THEN '<- CUT & COPY CALL EnableMenuItem (wParam, %IDM_CUT, %MF_GRAYED) CALL EnableMenuItem (wParam, %IDM_COPY, %MF_GRAYED) ELSE CALL EnableMenuItem (wParam, %IDM_CUT, %MF_ENABLED) CALL EnableMenuItem (wParam, %IDM_COPY, %MF_ENABLED) END IF IF IsClipboardFormatAvailable(%CF_TEXT) THEN '<- PASTE CALL EnableMenuItem (wParam, %IDM_PASTE, %MF_ENABLED) ELSE CALL EnableMenuItem (wParam, %IDM_PASTE, %MF_GRAYED) END IF IF SendMessage(hEdit, %WM_GETTEXTLENGTH, 0, 0) THEN '<- SELECT ALL CALL EnableMenuItem (wParam, %IDM_SELALL, %MF_ENABLED) ELSE CALL EnableMenuItem (wParam, %IDM_SELALL, %MF_GRAYED) END IF END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' SetMenuBitmap - loads a bitmap part into a menu tem '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION SetMenuBitmap (BYVAL bNum AS LONG) AS LONG LOCAL hBmp1 AS LONG, hBmp2 AS LONG, hDC AS LONG, memDC1 AS LONG, memDC2 AS LONG ' Load the bitmap to use ' ~~~~~~~~~~~~~~~~~~~~~~ hBmp1 = LoadImage(GetModuleHandle(BYVAL 0&), BYVAL 1, %IMAGE_BITMAP, 0, 0, %LR_LOADMAP3DCOLORS) ' Grab Screen's DC and create two compatible memory DC's ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ hdc = GetDc(0) memDC1 = CreateCompatibleDC (hdc) memDC2 = CreateCompatibleDC (hdc) ' Create 16x16 pixel bitmap ' ~~~~~~~~~~~~~~~~~~~~~~~~~ hBmp2 = CreateCompatibleBitmap(hdc, 16, 16) ' Release the dc - don't need it anymore. ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ReleaseDC 0, hdc ' Select the bitmaps into the memory DC's ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SelectObject memDC1, hBmp1 SelectObject memDC2, hBmp2 ' Copy selected part of bitmap1 to bitmap2 ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ BitBlt memDC2, 0, 0, 16, 16, memDC1, bNum * 16, 0, %SRCCOPY ' Cleanup ' ~~~~~~~ DeleteDC memDC1 DeleteDC memDC2 DeleteObject hBmp1 '(hBmp2 is deleted in DrawMenuItem) FUNCTION = hBmp2 'return handle to stretched bitmap END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Subclassed text control procedure '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION TextWndProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG SELECT CASE wMsg CASE %WM_INITMENUPOPUP MenuEditSet wParam EXIT FUNCTION CASE %WM_CONTEXTMENU CALL TrackPopupMenu (hmnuEdit, 0, LOWRD(lParam), HIWRD(lParam), 0, hWnd, BYVAL %NULL) EXIT FUNCTION CASE %WM_COMMAND SELECT CASE LOWRD(wParam) CASE %IDM_UNDO : CALL SendMessage(hWnd, %EM_UNDO, 0, 0) CASE %IDM_CUT : CALL SendMessage(hWnd, %WM_CUT, 0, 0) CASE %IDM_COPY : CALL SendMessage(hWnd, %WM_COPY, 0, 0) CASE %IDM_PASTE : CALL SendMessage(hWnd, %WM_PASTE, 0, 0) CASE %IDM_SELALL : CALL SendMessage(hWnd, %EM_SETSEL, 0, -1) END SELECT CASE %WM_KEYDOWN IF (GetKeyState(%VK_CONTROL) AND &H8000) <> 0 THEN 'Control pressed SELECT CASE CHR$(wparam) CASE "N" : MessageBox hWnd, "%IDM_NEW selected", "Message", %MB_OK 'Ctrl + N CASE "O" : MessageBox hWnd, "%IDM_OPEN selected", "Message", %MB_OK 'Ctrl + O CASE "S" : MessageBox hWnd, "%IDM_SAVE selected", "Message", %MB_OK 'Ctrl + S CASE "A" : CALL SendMessage(hWnd, %EM_SETSEL, 0, -1) 'Ctrl + A END SELECT END IF CASE %WM_MEASUREITEM 'get menu item size IF wParam = 0 THEN 'a menu is calling LOCAL hDC AS LONG, hf AS LONG, txt AS STRING, ncm AS NONCLIENTMETRICS LOCAL lpmis AS MEASUREITEMSTRUCT PTR, SizeA AS SIZEL lpmis = lParam 'Copy the pointer into our structure txt = GetMenuTxt(@lpmis.itemID) 'get menu item's text hDC = GetDC(hWnd) ncm.cbSize = SIZEOF(ncm) SystemParametersInfo %SPI_GETNONCLIENTMETRICS, SIZEOF(ncm), BYVAL VARPTR(ncm), 0 IF LEN(ncm.lfMenuFont) THEN hf = CreateFontIndirect(ncm.lfMenuFont) IF hf THEN hf = SelectObject(hDC, hf) END IF GetTextExtentPoint32 hDC, BYVAL STRPTR(txt), LEN(txt), SizeA 'get text size @lpmis.itemWidth = sizeA.cx' + 18 'set width @lpmis.ItemHeight = GetSystemMetrics(%SM_CYMENU) + 1 'set height IF hf THEN DeleteObject SelectObject(hDC, hf) ReleaseDC hWnd, hDC FUNCTION = %TRUE : EXIT FUNCTION END IF CASE %WM_DRAWITEM IF wParam = 0 THEN 'if identifier is 0, message was sent by a menu CALL DrawMenuItem(lParam) 'draw the menu FUNCTION = %TRUE : EXIT FUNCTION END IF END SELECT FUNCTION = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam) END FUNCTION
[This message has been edited by Borje Hagsten (edited February 12, 2002).]
Comment