' Ownerdrawn MenuItems, very tricky, not everything you expect will be
' available.  You can choose to put whatever you want in your menu items.
' Created by William Yu for Rapid-Q

$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"

CONST ODT_MENU = 1

CONST ODS_SELECTED = 1
CONST ODS_GRAYED = 2
CONST ODS_DISABLED = 4
CONST ODS_CHECKED = 8
CONST ODS_FOCUS = &H10
CONST ODS_DEFAULT = &H20
CONST ODS_COMBOBOXEDIT = &H1000

CONST WM_DRAWITEM = &H2B
CONST WM_MEASUREITEM = &H2C

CONST MF_BYCOMMAND = 0
CONST MF_BYPOSITION = &H400
CONST MF_OWNERDRAW = &H100

CONST MF_STRING = 0
CONST MF_BITMAP = 4

TYPE TMEASUREITEMSTRUCT
    CtlType AS LONG
    CtlID AS LONG
    itemID AS LONG
    itemWidth AS LONG
    itemHeight AS LONG
    itemData AS DWORD
END TYPE

TYPE TDRAWITEMSTRUCT
    CtlType AS LONG
    CtlID AS LONG
    itemID AS LONG
    itemAction AS LONG
    itemState AS LONG
    hwndItem AS LONG
    hDC AS LONG
    left AS LONG
    top AS LONG
    right AS LONG
    bottom AS LONG
    itemData AS DWORD
END TYPE

DIM MeasureItem AS TMEASUREITEMSTRUCT
DIM DrawItem AS TDRAWITEMSTRUCT
DIM Mem AS QMEMORYSTREAM
DIM Bitmap AS QBITMAP
DIM Font AS QFONT
DIM I AS INTEGER
DIM S AS STRING


DECLARE FUNCTION ModifyMenu LIB "USER32" ALIAS "ModifyMenuA" _
                 (hMenu AS LONG, uPosition AS LONG, uFlags AS LONG, _
                  uIDNewItem AS LONG, lpNewItem AS LONG) AS LONG

DECLARE SUB FormWndProc (Hwnd&, uMsg&, wParam&, lParam&)


SUB MenuItemClick (Sender AS QMENUITEM)
    ShowMessage("Thanks for clicking " + Sender.Caption)
END SUB


DIM MenuItem(100) AS QMenuItem

CREATE Form AS QForm
  Center
  Caption = "Ownerdraw Menus"
  CREATE MainMenu AS QMainMenu
    CREATE FileMenu AS QMenuItem
      Caption = "&File"
      CREATE OpenItem AS QMenuItem
        Caption = "&Open"
        Hint = "Open"
      END CREATE
      CREATE ReOpenItem AS QMenuItem
        Caption = "&ReOpen"
        CREATE I1 AS QMenuItem
          Caption = "Item &1"
          Hint = "Item 1"
        END CREATE
        CREATE I2 AS QMenuItem
          Caption = "Item &2"
        END CREATE
        CREATE I3 AS QMenuItem
          Caption = "Item &3"
        END CREATE
      END CREATE
      CREATE BreakItem AS QMenuItem
        Caption = "-"
      END CREATE
      CREATE ExitItem AS QMenuItem
        Caption = "E&xit"
      END CREATE
    END CREATE
    CREATE EditMenu AS QMenuItem
      Caption = "&Edit"
    END CREATE
    CREATE SearchMenu AS QMenuItem
      Caption = "&Search"
    END CREATE
  END CREATE
  WndProc = FormWndProc
END CREATE

FOR I = 1 to 10
  MenuItem(I).Caption = "Item &" + STR$(I)
  MenuItem(I).OnClick = MenuItemClick
  EditMenu.AddItems(MenuItem(I))
NEXT

'-- Change some properties of our menu items
FOR I = 1 to 10
  S = MenuItem(I).Caption
  ModifyMenu(EditMenu.Handle, MenuItem(I).MenuIndex, _
             mf_ByPosition OR mf_OwnerDraw, MenuItem(I).Command, VARPTR(S))
NEXT

Form.ShowModal



SUB FormWndProc (Hwnd&, uMsg&, wParam&, lParam&)
    IF uMsg& = WM_MEASUREITEM THEN
       Mem.Position = 0
       '--
       '-- lParam& is a pointer to the TMeasureItem structure
       '--
       Mem.MemCopyFrom(lParam&, SIZEOF(MeasureItem))
       Mem.Position = 0
       '--
       '-- After we copy it we have to read the structure
       '--
       Mem.ReadUDT(MeasureItem)
       IF MeasureItem.CtlType = ODT_MENU THEN
          '-- There are other types, such as listboxes, etc. that we
          '-- want to avoid.
          MeasureItem.itemWidth = 80      '-- Should be big enough to fit
          MeasureItem.itemHeight = 18     '-- your items.
          Mem.Position = 0
          Mem.WriteUDT(MeasureItem)       '-- Write structure back to memory
          Mem.Position = 0
          '--
          '-- Copy this structure back to the original address, so
          '-- changes can take effect
          '--
          Mem.MemCopyTo(lParam&, SIZEOF(MeasureItem))
       END IF
    ELSEIF uMsg& = WM_DRAWITEM THEN
       Mem.Position = 0
       Mem.MemCopyFrom(lParam&, SIZEOF(DrawItem))
       Mem.Position = 0
       Mem.ReadUDT(DrawItem)
       IF DrawItem.CtlType = ODT_MENU THEN
          Bitmap.Handle = DrawItem.hDC
          IF (ODS_SELECTED AND DrawItem.itemState) <> 0 THEN
             Bitmap.FillRect(DrawItem.left,DrawItem.top,DrawItem.right,DrawItem.bottom, &H009900)
             Bitmap.Circle(DrawItem.left,DrawItem.top+1,16,DrawItem.top+16, clHiLight, clHiLight)
             S = VARPTR$(DrawItem.itemData)
             I = INSTR(S, "&")
             IF I THEN
                Bitmap.TextOut(DrawItem.left+25,DrawItem.top+3,LEFT$(S, I-1),clWhite,-1)
                Font.AddStyles(fsUnderline)
                Bitmap.Font = Font
                Bitmap.TextOut(DrawItem.left+25+Bitmap.TextWidth(LEFT$(S, I-1)),DrawItem.top+3,MID$(S, I+1, 1),clWhite,-1)
                Font.DelStyles(fsUnderline)
                Bitmap.Font = Font
                S = S - "&"
                Bitmap.TextOut(DrawItem.left+25+Bitmap.TextWidth(LEFT$(S, I)),DrawItem.top+3,MID$(S, I+1, LEN(S)),clWhite,-1)
             ELSE
                Bitmap.TextOut(DrawItem.left+25,DrawItem.top+3,S,clWhite,-1)
             END IF
          ELSE
             Bitmap.FillRect(DrawItem.left,DrawItem.top,DrawItem.right,DrawItem.bottom, clMenu)
             Bitmap.Circle(DrawItem.left,DrawItem.top+1,16,DrawItem.top+16, 0, 0)
             S = VARPTR$(DrawItem.itemData)
             I = INSTR(S, "&")
             IF I THEN
                Bitmap.TextOut(DrawItem.left+25,DrawItem.top+3,LEFT$(S, I-1),0,-1)
                Font.AddStyles(fsUnderline)
                Bitmap.Font = Font
                Bitmap.TextOut(DrawItem.left+25+Bitmap.TextWidth(LEFT$(S, I-1)),DrawItem.top+3,MID$(S, I+1, 1),0,-1)
                Font.DelStyles(fsUnderline)
                Bitmap.Font = Font
                S = S - "&"
                Bitmap.TextOut(DrawItem.left+25+Bitmap.TextWidth(LEFT$(S, I)),DrawItem.top+3,MID$(S, I+1, LEN(S)),0,-1)
             ELSE
                Bitmap.TextOut(DrawItem.left+25,DrawItem.top+3,S,0,-1)
             END IF
          END IF
       END IF
    END IF
END SUB