2013-06-19 07:56

' 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

2013-06-19 07:56