A way of adding a menu to ODCL

[navsun]

dwx and Code see Appendix，
How to respond to menu clicks with a callback function？

Code Select Expand


;;Call windows api to add a menu.   by. yxp_xa   2018/06/28
;; dwx -> dynwrapx.dll Register

(defun c:test()
(setq DWX (vlax-create-object "DynamicWrapperX"))
(dcl-Project-Import (creator_odcl) nil nil)
;(dcl-Project-Load "test.odcl" t nil)
(dcl-Form-Show test/Form1)
)


(defun c:test/Form1#OnInitialize (/)
(vlax-invoke DWX 'Register "user32" "IsWindowUnicode" "i=h" "r=l")
(setq dcl (dcl-Control-GetHWND test/Form1)
    Wincode (vlax-invoke DWX 'IsWindowUnicode dcl)
    APIstr (if (= Wincode 0) "AppendMenuA" "AppendMenuW"))
(vlax-invoke DWX 'Register "user32" "SetMenu" "i=hh" "r=l")
(vlax-invoke DWX 'Register "user32" "CreateMenu" "r=l")
(vlax-invoke DWX 'Register "user32" "CreatePopupMenu" "r=l")
(vlax-invoke DWX 'Register "user32" APIstr "i=plpw" "r=l")
;;(vlax-invoke DWX 'Register "user32" "SetWindowLongW" "i=hlp" "r=p")
;;(vlax-invoke DWX 'Register "user32" "CallWindowProcW" "i=phlll" "r=p")
;;(vlax-invoke DWX 'Register "user32" "GetMenuItemID" "i=hl" "r=l")
;;(vlax-invoke DWX 'Register "user32" "GetMenu" "i=h" "r=h")
;;(vlax-invoke DWX 'Register "user32" "GetSubMenu" "i=hl" "r=h")
(setq hMenu (vlax-invoke DWX 'CreateMenu)
    menu (mapcar '(lambda(x)(list (vlax-invoke DWX 'CreatePopupMenu) x))
        '("File (&F)" "Edit (&E)" "Help (&H)"))
    pop (list
        '((1001 "Open (&O)...")(1002 "Save (&S)")(1003 "Close (&C)"))
        '((2001 "Copy (&C)")(2002 "Paste (&P)")(2003 "Cut (&X)"))
        '((3001 "Help (&H)")(3002 "Register (&R)")(3003 "about (&A)...")))
)
(mapcar '(lambda(x y)(vlax-invoke DWX APIstr hMenu 16 (car x)(cadr x))
    (foreach z y(vlax-invoke DWX APIstr (car x) 0 (car z)(cadr z)))
    ) menu pop)
(vlax-invoke DWX 'SetMenu dcl hMenu)
;;(setq old (vlax-invoke DWX 'SetWindowLongW dcl -4 (need fun Pointer)))
)


(defun c:test/Form1/TextButton1#OnClicked (/)
(dcl-Form-Close test/Form1)
)


(defun creator_odcl()
'("YWt6A6AMAADYptBMBuKTKDMxLT9qQzskWC73PzMOqX64WCTeLj6nX7qGfyjWWFBKz8g77jz3KlcS"
"IsauemnQqnt1Af5h5oZr6dAKuXEeX09YWvRQSz/XGdhhkcN1rPZaEBKtBw2g48dNDZFHCcRdxeR7"
"AQtDlrpHCt11Q/Zd+FoveJN2j0f7SliGcq2o8yCi5YBuJ2cDTs4OnTLaDRRYoravbWapALStNs7h"
"+HW+Ansut9lISgqukztEEJ1N8F58knEM/wiIPJL7FneebiSuskj+cMhfYjpVpXqlVhlJDfCnDigF"
"8uTv/QJp20MfQsiag/qGcwzjfkNKrSm2imwCqbhIuBFVBQQKYpuOlKMol+PcaLT7TJpBIrgDelci"
"v1bZ1OGOmnNQw3NLVY5L/6G+I77EL3W8QJe+BRyyP18AM86o0xmauQ7ywR8k+AeiWqUX8Cpg6a2d"
"9CZfXc5snaHc2A6ogt+rfn0chdaVx7OVsZyc3DWrJqax4AQXH02Ax75RegBYjnEVQxMuSS8vvrIN"
"KKtFrM/dtY65ub5aZu7Vkls2qlaPRr287sIN8vmMJZWjHLHV06t4SLQiBQRzs2wKqnyba88N9aZD"
"b4g5fEFohh93CFr1/7afb/859XkPFyvX6s4haAY40skiQhVw0SSdM57B9ofh9fe2n3hPgdXLYR0h"
"+TUbLvspCGBTl8LoafHhzflThdK4YDkUCADlJzSgkIlPiS2yhVrbbxu4TTIc4pc07HlhsTGI1Ue/"
"oNn8I+t88Ucoj4hfPDFvcmdsFtFDElE/w8gIydIJES2/UJMZwUazELVA0I9XdakUq4olBjalQXeo"
"kMuSZxNBF59H8zF2a4t0olmOD//bNIj3xobjlWerEkkOXat6yex70c74e6sfOC2VQAlvhx7B+Kh2"
"KnTGakna3tv+277b3km1U1ciVxJXAidmGp/uIuv7uLijJBL8xczONlDpVFLMbjeQtbws1G6nygxo"
"MNOynWEWG+UQckJeyywLpCIpF2KYq+uYSTtMeVsrlQCJMd53lbGxgz2WSIF1HGaf5oaBhZRRkVUl"
"W4wdM1sMlR7Z5t66+Au7nrOoe+UwAwSgI5+52K1FDpSKReIJsgMSArnC+S1JOc97xP+1x6FBrq/7"
"go1p48frkw==")
)

(princ)


[roy_043]

Perhaps try this approach?:
http://opendcl.com/forum/index.php?topic=2347.0