*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="ctl32_contextmenu.vcx" CPID="1250" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS ctl32_contextmenu AS container *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" ClassIcon="ctl32_contextmenu.bmp" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="lblname" UniqueID="" Timestamp="" /> #INCLUDE "ctl32.h" * *m: add && Adds a new member to a Collection. *m: clear && Clears all menus and menu items. *m: getsystemmenucaptions *m: onwmdrawitem && Bindevent to form WM_DRAWITEM *m: onwmmeasureitem && Bindevent to form WM_MEASUREITEM *m: show && Displays a Form and specifies if the Form is modal or modeless. *m: showcontrolmenu *m: showeditmenu *m: _addmenu *m: _addmenuitem *m: _addmenuitemtocollection *m: _bindevents *m: _setbitmap *m: _setmenuiteminfo_hbmpitem *m: _setmenuiteminfo_miim_checkmarks *p: formhwnd *p: menuitems *p: menus *p: ownerdrawn *p: parenthwnd *p: showflags && http://msdn2.microsoft.com/en-us/library/ms648003.aspx *p: _bitmapcanvasheight && Item bitmap space height *p: _bitmapcanvaswidth && Item bitmap space width *p: _bitmapheight && Bitmap height *p: _bitmapwidth && Bitmap width *p: _brush *p: _controlmenubuilt *p: _drawitemstruct *p: _editmenubuilt *p: _lookuptable *p: _mainhandle && The handle to the top menu in the chain is saved here. *p: _measureitemstruct *p: _memberdata && XML Metadata for customizable properties *p: _nextmenuitemid *p: _windowprocedure * * BackColor = 140,200,200 formhwnd = .F. Height = 21 menuitems = menus = Name = "ctl32_contextmenu" parenthwnd = 0 showflags = 0 Visible = .F. Width = 108 _bitmapcanvasheight = 0 _bitmapcanvaswidth = 0 _bitmapheight = 0 _bitmapwidth = 0 _brush = 0 _controlmenubuilt = .F. _drawitemstruct = .F. _editmenubuilt = .F. _lookuptable = .F. _mainhandle = 0 _measureitemstruct = .F. _nextmenuitemid = 0 _windowprocedure = 0 * ADD OBJECT 'lblname' AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "ctl32_contextmenu", ; FontName = "Tahoma", ; FontSize = 8, ; ForeColor = 0,0,128, ; Height = 15, ; Left = 6, ; Name = "lblname", ; Top = 4, ; Width = 94 *< END OBJECT: BaseClass="label" /> PROCEDURE add && Adds a new member to a Collection. *!* Add *!* This method adds menu bars, menu popups, menu items, *!* and menu items with sub menu popups Lparameters m.peItemKey1, m.peItemKey2, m.pcCaption, m.pePicture If Pcount() = 0 Then Return Endif If Pcount() = 1 Or Empty(m.peItemKey2) Then This._AddMenu(m.peItemKey1) Else This._AddMenuItem(m.peItemKey1, m.peItemKey2, m.pcCaption, m.pePicture) Endif ENDPROC PROCEDURE clear && Clears all menus and menu items. *!* Clear *!* Release all menu popups and ctlMenuPopUp objects Do While This.Menus.Count > 0 apiDestroyMenu(This.Menus(This.Menus.Count).MenuId) This.Menus.Remove(This.Menus.Count) Enddo *!* Release ctlMenuItem objects Do While This.MenuItems.Count > 0 If This.MenuItems(This.MenuItems.Count).PictureId <> 0 Then apiDeleteObject(This.MenuItems(This.MenuItems.Count).PictureId) Endif This.MenuItems.Remove(This.MenuItems.Count) Enddo *!* Reset flags that indicate that certain menus have been created This._EditMenuBuilt = FALSE This._ControlMenuBuilt = FALSE This._NextMenuItemId = 1 ENDPROC PROCEDURE Destroy *!* Destroy This.Clear() ENDPROC PROCEDURE getsystemmenucaptions ******************************************************************************** *!* GetSystemMenuCaptions(m.pnMenuId) ******************************************************************************** *!* This method creates a menu from a specified menu resource id in user32.dll, *!* reads all the menu item Texts of the created menu, destroys the menu, and *!* returns the Texts as a "|" delimited string ******************************************************************************** *!* Menu Resource Id 1 in user32.dll: *!* MENUITEM "&Deshacer", 772 *!* MENUITEM "", 0, MFT_SEPARATOR *!* MENUITEM "Cor&tar", 768 *!* MENUITEM "&Copiar", 769 *!* MENUITEM "&Pegar", 770 *!* MENUITEM "&Eliminar", 771 *!* MENUITEM "", 0, MFT_SEPARATOR *!* MENUITEM "Seleccion&ar todo", 177 *!* MENUITEM "", 0, MFT_SEPARATOR *!* MENUITEM "Lectu&ra de derecha a izquierda", 32768, MFS_GRAYED *!* MENUITEM "Mo&strar caracteres de control Unicode", 32769, MFS_GRAYED *!* Menu Resource Id 16 in user32.dll: *!* MENUITEM "&Restaurar", 61728 *!* MENUITEM "&Mover", 61456 *!* MENUITEM "&Tamaño", 61440 *!* MENUITEM "Mi&nimizar", 61472 *!* MENUITEM "Ma&ximizar", 61488 *!* MENUITEM SEPARATOR *!* MENUITEM "&Cerrar\tAlt+F4", 61536 Lparameters m.pnMenuId As Integer Local ; lnModule As Integer, ; llReleaseLibrary As Boolean, ; lnMenu As Integer, ; lnPopPup As Integer *!* Get module handle of user32 if it is loaded m.lnModule = apiGetModuleHandle("user32.dll") *!* If not loaded, load it If m.lnModule = 0 Then m.llReleaseLibrary = TRUE m.lnModule = apiLoadLibrary("user32.dll") Else m.llReleaseLibrary = FALSE Endif *!* Now create a menu from a menu resource m.lnMenu = apiLoadMenu(m.lnModule, m.pnMenuId) *!* Now get the first menu popup of the menubar m.lnPopUp = apiGetSubMenu(m.lnMenu, 0) Local ; lnMenuItemCount As Integer, ; lnBufferLen As Integer, ; lcBuffer As String, ; lnMenuTextLen As Integer, ; lcMenuCaptions As String *!* Get number of menu items in menu m.lnMenuItemCount = apiGetMenuItemCount(m.lnPopUp) m.lnBufferLen = 0xff *!* Get a string with all the menu item Texts, like: "&Undo|-|&Copy|Cu&t|&Paste|...." m.lcMenuCaptions = "" For m.lnx = 0 To m.lnMenuItemCount - 1 m.lcBuffer = Space(m.lnBufferLen) m.lnMenuTextLen = apiGetMenuString(m.lnPopUp, m.lnx, @m.lcBuffer, m.lnBufferLen, MF_BYPOSITION) If m.lnMenuTextLen = 0 Then m.lcMenuCaptions = m.lcMenuCaptions + "-" Else m.lcMenuCaptions = m.lcMenuCaptions + Left(m.lcBuffer, m.lnMenuTextLen) Endif If m.lnx < m.lnMenuItemCount - 1 Then m.lcMenuCaptions = m.lcMenuCaptions + "|" Endif Endfor apiDestroyMenu(m.lnMenu) If m.llReleaseLibrary = TRUE Then apiFreeLibrary(m.lnModule) Endif Return m.lcMenuCaptions ENDPROC PROCEDURE Init *!* Init External Procedure ctl32.prg Do (Addbs(Justpath(This.ClassLibrary)) + "ctl32.prg") This.MenuItems = Createobject("Collection") This.Menus = Createobject("Collection") *This.MenuKeys = Createobject("Collection") This._DrawItemStruct = Createobject("_DRAWITEMSTRUCT", 0) This._MeasureItemStruct = Createobject("_MEASUREITEMSTRUCT", 0) This._NextMenuItemId = 1 ENDPROC HIDDEN PROCEDURE onwmdrawitem && Bindevent to form WM_DRAWITEM *!* OnWmDrawItem Lparameters m.pnHwnd As Integer, m.pnMsg As Integer, m.pnWparam As Integer, m.pnLparam As Integer Local ; lnLeft, ; lnTop, ; lnWidth, ; lnHeight, ; loMenuItem As ctl32_menuitem, ; llFound As Boolean, ; llDisabled as Boolean, ; llHighlighted as Boolean *!* m.pnlParam is a pointer to a DrawItemStruct structure This._DrawItemStruct.Address = m.pnLparam *!* With This._DrawItemStruct *!* Debugout .CtlType, .CtlID, .ItemID, .itemAction, .itemState, .hwndItem, .hDC, .ItemData *!* Endwith ******************************************************************************** *!* typedef struct tagDRAWITEMSTRUCT { *!* UINT CtlType; *!* UINT CtlID; *!* UINT itemID; *!* UINT itemAction; *!* UINT itemState; *!* HWND hwndItem; *!* HDC hDC; *!* RECT rcItem; *!* ULONG_PTR itemData; *!* } DRAWITEMSTRUCT; ******************************************************************************** *!* We have a menu item in lnItemID, we are going to look it up in the menu items *!* collection. This value is arbitrary, and is set in _AddMenuItemToCollection m.llFound = FALSE For m.lnIndex = 1 To This.MenuItems.Count If This.MenuItems(m.lnIndex).ItemId = This._DrawItemStruct.ItemID m.loMenuItem = This.MenuItems(m.lnIndex) m.llFound = TRUE Exit Endif Endfor *!* If menu item not found, pass message along and return If m.llFound = FALSE Then Return apiCallWindowProc(This._WindowProcedure, m.pnHwnd, m.pnMsg, m.pnWparam, m.pnLparam) Endif *!* If no picture Id, just return If m.loMenuItem.PictureId = 0 Then m.loMenuItem = Null Return TRUE Endif *m.lPictureObject = m.loMenuItem.PictureObject *!* Convert HIMETRIC of iPicture to pixels: *!* :http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20024530.html *!* m.lnHeight = ctlHiMetricToPixelsY(m.loMenuItem.PictureObject.Height) *!* m.lnWidth = ctlHiMetricToPixelsX(m.loMenuItem.PictureObject.Width) m.lnHeight = Max(16, apiGetSystemMetrics(SM_CYMENUCHECK)) m.lnWidth = Max(16, apiGetSystemMetrics(SM_CXMENUCHECK)) m.lnLeft = (This._DrawItemStruct.rcItem.Right - This._DrawItemStruct.rcItem.Left - m.lnWidth) / 2 + This._DrawItemStruct.rcItem.Left m.lnTop = (This._DrawItemStruct.rcItem.Bottom - This._DrawItemStruct.rcItem.Top - m.lnHeight) / 2 + This._DrawItemStruct.rcItem.Top ApiDrawIconEx( ; This._DrawItemStruct.hDC, ; m.lnLeft, ; m.lnTop, ; m.loMenuItem.PictureId, ; m.lnWidth, ; m.lnHeight, ; 0, ; 0, ; DI_NORMAL) *!* With This._DrawItemStruct *!* ?.ctlType, .ctlId, .ItemID, .ItemAction, .ItemState, .hwndItem, .hDC, .rcItem.Left, .rcItem.Top, .rcItem.Right, .rcItem.Bottom *!* Endwith *!* m.loGraphics = _Screen.System.Drawing.Graphics.FromHdc(This._DrawItemStruct.hDC) *!* If m.loMenuItem.Enabled = TRUE Then *!* *!* This is Color: *!* m.loGraphics.DrawImage(m.lPictureObject, m.lnLeft, m.lnTop) *!* Else *!* *!* Draw disabled version of bitmap *!* *!* System.Drawing.Graphics.FromHdc FAILS in Vista when the item is disabled, so *!* *!* we check if we have an object *!* *!* TODO: clean up this code, better "disabled" version of bitmap, grayscale, but change tone *!* *!* emulate disabled bitmaps as much as possible maybe use the button face color *!* If Vartype(m.loGraphics) ="O" Then *!* *!* http://groups.google.kg/group/comp.lang.smalltalk.dolphin/browse_thread/thread/4ab6c6e5cf89cfad/d9a7bbe56adda9ee *!* #Define COLORMATRIX_DISABLED 0.2125, 0.2125, 0.2125, 0, 0, 0.2577, 0.2577, 0.2577, 0, 0, 0.0361, 0.0361, 0.0361, 0, 0, 0, 0, 0, 1, 0, 0.38, 0.38, 0.38, 0, 1 *!* *!* http://www.codeproject.com/vb/net/colormatrix.asp North America Television Standards Committee values *!* *#define COLORMATRIX_DISABLED 0.299, 0.299, 0.299, 0, 0, 0.587, 0.587, 0.587, 0, 0, 0.114, 0.114, 0.114, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1 *!* m.loClrMatrix = _Screen.System.Drawing.Imaging.ColorMatrix.New(COLORMATRIX_DISABLED) *!* m.loAttr = _Screen.System.Drawing.Imaging.ImageAttributes.New() *!* m.loAttr.SetColorMatrix(m.loClrMatrix) *!* m.loPixel = _Screen.System.Drawing.GraphicsUnit.Pixel *!* m.loCanvasRect = _Screen.System.Drawing.Rectangle.New(m.lnLeft, m.lnTop, m.lPictureObject.Width, m.lPictureObject.Height) *!* m.loGraphics.DrawImage(m.lPictureObject, m.loCanvasRect, m.lPictureObject.GetBounds() , m.loPixel, m.loAttr) *!* Endif *!* Endif Return TRUE ENDPROC HIDDEN PROCEDURE onwmmeasureitem && Bindevent to form WM_MEASUREITEM *!* OnWmMeasureItem Lparameters m.pnHwnd, m.pnMsg, m.pnWparam, m.pnLparam *!* m.pnWparam contains the value of the CtlID member of the MEASUREITEMSTRUCT *!* structure pointed to by the lpMeasureItem parameter. This value identifies *!* the control that sent the WM_MEASUREITEM message. If the value is zero, *!* the message was sent by a menu. *!* Some measurements I have done in Windows XP: *!* Menu font size in points-SM_CYMENUCHECK-Height of item w/o pic-height of item w/ pic *!* 6-9-17-20 *!* 8-13-17-20 *!* 9-13-18-20 *!* 10-15-20-20 *!* 11-17-22-22 *!* 12-19-23-23 *!* 13-21-25-25 *!* 14-23-27-27 Local ; lnHeight As Integer, ; lnWidth As Integer, ; lnBorder As Integer *!* m.pnlParam is a pointer to a MeasureItemStruct structure This._MeasureItemStruct.Address = m.pnLparam With This._MeasureItemStruct Debugout .CtlType, .CtlID, .ItemID, .itemWidth, .itemHeight, .ItemData Endwith ******************************************************************************** *!* typedef struct tagMEASUREITEMSTRUCT { *!* UINT CtlType; *!* UINT CtlID; *!* UINT itemID; *!* UINT itemWidth; *!* UINT itemHeight; *!* DWORD itemData *!* } MEASUREITEMSTRUCT; ******************************************************************************** Local loMenuItem As Object, llFound As Boolean *!* m.llFound = FALSE *!* For m.lnIndex = 1 To This.MenuItems.Count *!* If This.MenuItems(m.lnIndex).ItemID = This._MeasureItemStruct.ItemID *!* m.loMenuItem = This.MenuItems(m.lnIndex) *!* m.llFound = TRUE *!* Exit *!* Endif *!* Endfor If This._MeasureItemStruct.ItemID <= This.MenuItems.Count Then m.loMenuItem = This.MenuItems(This._MeasureItemStruct.ItemID) Else Return apiCallWindowProc(This._WindowProcedure, m.pnHwnd, m.pnMsg, m.pnWparam, m.pnLparam) Endif *!* If menu item not found, pass message along and return *!* If m.llFound = FALSE Then *!* Return apiCallWindowProc(This._WindowProcedure, m.pnHWnd, m.pnMsg, m.pnwParam, m.pnlParam) *!* Endif *!* For SM_CYMENUCHECK/SM_CXMENUCHECK lower than 15 we have to compensate *!* 18 gives us a 20 pixel tall menu item Local lnHeight As Integer, lnWidth As Integer m.lnHeight = apiGetSystemMetrics(SM_CYMENUCHECK) If m.lnHeight <= 15 m.lnHeight = 18 Endif m.lnWidth = apiGetSystemMetrics(SM_CXMENUCHECK) If m.lnWidth <= 15 m.lnWidth = 18 Endif If ctlGetOsVersion() <= NTDDI_VISTA Or This.OwnerDrawn Then This._MeasureItemStruct.itemWidth = Max(m.lnWidth, This._MeasureItemStruct.itemWidth - 1) This._MeasureItemStruct.itemHeight = Max(m.lnHeight, This._MeasureItemStruct.itemHeight - 1) Else This._MeasureItemStruct.itemWidth = Max(m.lnWidth, This._MeasureItemStruct.itemWidth ) This._MeasureItemStruct.itemHeight = Max(m.lnHeight, This._MeasureItemStruct.itemHeight) Endif m.loMenuItem = Null Return TRUE ENDPROC PROCEDURE show && Displays a Form and specifies if the Form is modal or modeless. *!* Show() *!* Show(nx, ny) *!* Show(nStyle) Lparameters m.pnX As Integer, m.pnY As Integer, m.plAlreadyScreenCoordinates As Logical *!* m.pnX and m.pnY specifies the point where menu should be *!* positioned, in form coordinates! Should transform to *!* screen coordinates Local ; lnFlags As Integer, ; lnScreenX As Integer, ; lnScreenY As Integer, ; lnItemId As Integer m.lnScreenX = 0 m.lnScreenY = 0 Do Case *!* No parameters, show at mouse cursor pos Case Pcount() = 0 ctlGetCursorPos(@m.lnScreenX, @m.lnScreenY) *!* One parameter = 0 means show at mouse cursor, 1 means show at caret Case Pcount() = 1 And Vartype(m.pnX) = "N" If m.pnX = 0 Then *!* Use mouse pointer position ctlGetCursorPos(@m.lnScreenX, @m.lnScreenY) Else *!* Use caret position ctlGetCaretPos(@m.lnScreenX, @m.lnScreenY) ctlClientToScreen(This.FormHwnd, @m.lnScreenX, @m.lnScreenY) *!* add some pixels here m.lnScreenX = m.lnScreenX + 4 m.lnScreenY = m.lnScreenY + 8 Endif *!* At least two numeric parameters: x,y coordinates Case Vartype(m.pnX) + Vartype(m.pnY) = "NN" m.lnScreenX = m.pnX m.lnScreenY = m.pnY *!* If we don´t have a third parameter, this are form coordinates, *!* otherwise they are already screen coordinates If Pcount() < 3 Then ctlClientToScreen(This.FormHwnd, @m.lnScreenX, @m.lnScreenY) Endif *!* show at mouse cursor pos Otherwise ctlGetCursorPos(@m.lnScreenX, @m.lnScreenY) Endcase If Vartype(This.ShowFlags) = "N" Then m.lnFlags = Bitor(This.ShowFlags, TPM_RETURNCMD) Else m.lnFlags = TPM_RETURNCMD Endif m.lnItemId = apiTrackPopupMenuEx(This.Menus(1).MenuId, m.lnFlags, m.lnScreenX, m.lnScreenY, This.FormHwnd, Null) For m.lnIndex = 1 To This.MenuItems.Count If This.MenuItems(m.lnIndex).ItemID = m.lnItemId Return This.MenuItems.GetKey(m.lnIndex) Exit Endif Endfor Return "" ENDPROC PROCEDURE showcontrolmenu *!* ShowControlMenu Lparameters m.pnX As Integer, m.pnY As Integer Local lcCommand As String *!* Only build menu if it is not already built If This._ControlMenuBuilt = FALSE Then This.Clear If Pemstatus(This, "_ControlTexts", 5) = FALSE Then Local lcCaptions As String, lnCaptionsCount As Integer, lnx As Integer m.lcCaptions = This.GetSystemMenuCaptions(16) m.lnCaptionsCount = Getwordcount(m.lcCaptions,"|") This.AddProperty("_ControlTexts(" + Alltrim(Str(m.lnCaptionsCount)) + ")", "") For m.lnx = 1 To m.lnCaptionsCount This._ControlTexts(m.lnx) = Getwordnum(m.lcCaptions, m.lnx, "|") Endfor Endif This.Add("SMENU") *!* Using OS images This.Add("SMENU", "RESTORE", This._ControlTexts(1), HBMMENU_POPUP_RESTORE) This.Add("SMENU", "MOVE", This._ControlTexts(2)) This.Add("SMENU", "SIZE", This._ControlTexts(3)) If _Screen.Activeform.MinButton Then This.Add("SMENU", "MINIMIZE", This._ControlTexts(4), HBMMENU_POPUP_MINIMIZE) Endif If _Screen.Activeform.MaxButton Then This.Add("SMENU", "MAXIMIZE", This._ControlTexts(5), HBMMENU_POPUP_MAXIMIZE) Endif If _Screen.Activeform.Closable Then This.Add("SMENU", "SEPARATOR1", This._ControlTexts(6)) *!* Modify Shortcut key label: If _Screen.Activeform.ShowWindow = 2 Then This.Add("SMENU", "CLOSE", This._ControlTexts(7), HBMMENU_POPUP_CLOSE) Else This.Add("SMENU", "CLOSE", Getwordnum(This._ControlTexts(7), 1, TABCHAR) + TABCHAR + "Ctrl+F4", HBMMENU_POPUP_CLOSE) Endif This.MenuItems("CLOSE").DefaultItem = TRUE Endif This._ControlMenuBuilt = TRUE Endif *!* Set menu items state: Do Case Case _Screen.Activeform.WindowState = 0 This.MenuItems("RESTORE").Enabled = FALSE This.MenuItems("MOVE").Enabled = TRUE This.MenuItems("SIZE").Enabled = TRUE If _Screen.Activeform.MinButton Then This.MenuItems("MINIMIZE").Enabled = TRUE Endif If _Screen.Activeform.MaxButton Then This.MenuItems("MAXIMIZE").Enabled = TRUE Endif Case _Screen.Activeform.WindowState = 1 This.MenuItems("RESTORE").Enabled = TRUE This.MenuItems("MOVE").Enabled = FALSE This.MenuItems("SIZE").Enabled = FALSE If _Screen.Activeform.MinButton Then This.MenuItems("MINIMIZE").Enabled = FALSE Endif If _Screen.Activeform.MaxButton Then This.MenuItems("MAXIMIZE").Enabled = TRUE Endif Case _Screen.Activeform.WindowState = 2 This.MenuItems("RESTORE").Enabled = TRUE This.MenuItems("MOVE").Enabled = FALSE This.MenuItems("SIZE").Enabled = FALSE If _Screen.Activeform.MinButton Then This.MenuItems("MINIMIZE").Enabled = TRUE Endif If _Screen.Activeform.MaxButton Then This.MenuItems("MAXIMIZE").Enabled = FALSE Endif Endcase m.lcCommand = This.Show(m.pnX, m.pnY) Do Case Case m.lcCommand = "RESTORE" apiSendMessageInteger(This.FormHwnd, WM_SYSCOMMAND, SC_RESTORE, 0) Case m.lcCommand = "MOVE" apiSendMessageInteger(This.FormHwnd, WM_SYSCOMMAND, SC_MOVE, 0) Case m.lcCommand = "SIZE" apiSendMessageInteger(This.FormHwnd, WM_SYSCOMMAND, SC_SIZE, 0) Case m.lcCommand = "MINIMIZE" apiSendMessageInteger(This.FormHwnd, WM_SYSCOMMAND, SC_MINIMIZE, 0) Case m.lcCommand = "MAXIMIZE" apiSendMessageInteger(This.FormHwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0) Case m.lcCommand = "CLOSE" apiSendMessageInteger(This.FormHwnd, WM_SYSCOMMAND, SC_CLOSE, 0) Otherwise Endcase ENDPROC PROCEDURE showeditmenu *!* ShowEditMenu Lparameters m.pnX As Integer, m.pnY As Integer Local lcCommand As String This.Clear If This._EditMenuBuilt = FALSE Then This.Clear *!* Get Edit menu Texts from Windows if we have not done it already: If Pemstatus(This, "_EditTexts", 5) = FALSE Then Local ; lcCaptions As String, ; lnCaptionsCount As Integer, ; lnx As Integer m.lcCaptions = This.GetSystemMenuCaptions(1) m.lnCaptionsCount = Getwordcount(m.lcCaptions,"|") This.AddProperty("_EditTexts(" + Alltrim(Str(m.lnCaptionsCount)) + ")", "") For m.lnx = 1 To m.lnCaptionsCount This._EditTexts(m.lnx) = Alltrim(Getwordnum(m.lcCaptions, m.lnx, "|")) Endfor Endif *!* Add main popup This.Add("_MEDIT") This.Add("_MEDIT", "_MED_UNDO", This._EditTexts(1), "edit_undo_16x16.ico") This.Add("_MEDIT", "SEPARATOR1", This._EditTexts(2)) This.Add("_MEDIT", "_MED_CUT", This._EditTexts(3), "edit_cut_16x16.ico") This.Add("_MEDIT", "_MED_COPY", This._EditTexts(4), "edit_copy_16x16.ico") This.Add("_MEDIT", "_MED_PASTE", This._EditTexts(5), "edit_paste_16x16.ico") This.Add("_MEDIT", "_MED_CLEAR", This._EditTexts(6)) This.Add("_MEDIT", "SEPARATOR2", This._EditTexts(7)) This.Add("_MEDIT", "_MED_SLCTA", This._EditTexts(8)) This._EditMenuBuilt = TRUE Endif *!* Set menu items state: If _Screen.ActiveForm.ActiveControl.BaseClass = "Olecontrol" Then If apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, EM_CANUNDO, 0, 0) = 0 Then This.MenuItems("_MED_UNDO").Enabled = .F. Else This.MenuItems("_MED_UNDO").Enabled = .T. Endif If apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, EM_CANPASTE, 0, 0) = 0 Then This.MenuItems("_MED_PASTE").Enabled = .F. Else This.MenuItems("_MED_PASTE").Enabled = .T. Endif Else This.MenuItems("_MED_UNDO").Enabled = Not Skpbar("_MEDIT", _Med_undo) This.MenuItems("_MED_PASTE").Enabled = Not Empty(_Cliptext) Endif *!* Skpbar(...) fails when you right click in a control that does not have the focus *!* Skpbar still reflects the state of the previous active control If Type("_Screen.Activeform.ActiveControl.SelLength") = "N" Then This.MenuItems("_MED_CUT").Enabled = _Screen.ActiveForm.ActiveControl.SelLength > 0 This.MenuItems("_MED_COPY").Enabled = _Screen.ActiveForm.ActiveControl.SelLength > 0 This.MenuItems("_MED_CLEAR").Enabled = _Screen.ActiveForm.ActiveControl.SelLength > 0 Endif If Pemstatus(_Screen.ActiveForm.ActiveControl, "ReadOnly", 5) Then If _Screen.ActiveForm.ActiveControl.ReadOnly = TRUE Then This.MenuItems("_MED_CUT").Enabled = FALSE This.MenuItems("_MED_CLEAR").Enabled = FALSE This.MenuItems("_MED_PASTE").Enabled = FALSE Endif Endif m.lcCommand = This.Show(m.pnX, m.pnY) If _Screen.ActiveForm.ActiveControl.BaseClass = "Olecontrol" Then Do Case Case m.lcCommand = "_MED_UNDO" apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, WM_UNDO, 0, 0) Case m.lcCommand = "_MED_CUT" apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, WM_CUT, 0, 0) Case m.lcCommand = "_MED_COPY" apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, WM_COPY, 0, 0) Case m.lcCommand = "_MED_PASTE" apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, WM_PASTE, 0, 0) Case m.lcCommand = "_MED_CLEAR" apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, WM_CLEAR, 0, 0) Case m.lcCommand = "_MED_SLCTA" apiSendMessageInteger(_Screen.ActiveForm.ActiveControl.HWnd, EM_SETSEL, 0, -1) Endcase Else Do Case Case m.lcCommand = "_MED_UNDO" Sys(1500, '_MED_UNDO', '_MEDIT') Case m.lcCommand = "_MED_CUT" Sys(1500, '_MED_CUT', '_MEDIT') Case m.lcCommand = "_MED_COPY" Sys(1500, '_MED_COPY', '_MEDIT') Case m.lcCommand = "_MED_PASTE" Sys(1500, '_MED_PASTE', '_MEDIT') Case m.lcCommand = "_MED_CLEAR" Sys(1500, '_MED_CLEAR', '_MEDIT') Case m.lcCommand = "_MED_SLCTA" Sys(1500, '_MED_SLCTA', '_MEDIT') Endcase Endif ENDPROC PROCEDURE _addmenu *!* _AddMenu(ItemKey) *!* This method is used to add menus, menu pop-ups and submenus *!* When adding the first menu, the MenuKey must be the owner form Hwnd Lparameters m.peItemKey Local lcItemKey As String *!* Transform has issues If Vartype(m.peItemKey) = "N" Then m.lcItemKey = Alltrim(Str(m.peItemKey)) Else m.lcItemKey = m.peItemKey Endif If This.Menus.Count = 0 Then This.FormHwnd = _Screen.ActiveForm.HWnd This._BindEvents() Endif This.Menus.Add(Createobject("ctl32_menu"), m.lcItemKey) This.Menus(m.lcItemKey).MenuID = apiCreatePopupMenu() Local ; lcMenuInfo As String, ; loMenuInfo As _MENUINFO m.loMenuInfo = Createobject("_MENUINFO") m.loMenuInfo.fMask = Bitor(MIM_BACKGROUND, MIM_MAXHEIGHT, MIM_STYLE, MIM_MENUDATA) m.loMenuInfo.dwStyle = Bitor(MNS_AUTODISMISS, MNS_CHECKORBMP) m.loMenuInfo.cyMax = This.Menus(m.lcItemKey).Height m.loMenuInfo.hbrBack = 0 m.loMenuInfo.dwContextHelpID = 0 m.loMenuInfo.dwMenuData = 0 m.lcMenuInfo = m.loMenuInfo.Value apiSetMenuInfo(This.Menus(m.lcItemKey).MenuID, @m.lcMenuInfo) Return This.Menus(m.lcItemKey).MenuID ENDPROC PROCEDURE _addmenuitem *!* _AddMenuItem Lparameters m.peItemKey1, m.peItemKey2, m.pcCaption As String, m.pePicture Local ; lcItemKey1 As String, ; lcItemKey2 As String, ; loMenuItem As ctl32_menuitem If Vartype(m.peItemKey1) = "N" Then m.lcItemKey1 = Alltrim(Str(m.peItemKey1)) Else m.lcItemKey1 = m.peItemKey1 Endif If Vartype(m.peItemKey2) = "N" Then m.lcItemKey2 = Alltrim(Str(m.peItemKey2)) Else m.lcItemKey2 = m.peItemKey2 Endif *!* Check if this menuitem has a parent menu: If Empty(This.Menus.GetKey(m.lcItemKey1)) If Empty(This.MenuItems.GetKey(m.lcItemKey1)) *!* There is no parent with the passed m.lcItemKey1 Return Else *!* Create a menu for the parent menuitem if needed If This.MenuItems(m.lcItemKey1).SubMenuId = 0 Then This.MenuItems(m.lcItemKey1).SubMenuId = This._AddMenu(m.lcItemKey1) Endif Endif Endif *!* Add menu item object to MenuItems collection This.MenuItems.Add(Createobject("ctl32_menuitem"), m.peItemKey2) *!* Assign values to all the menu item properties: m.loMenuItem = This.MenuItems(m.peItemKey2) m.loMenuItem.Caption = m.pcCaption *!* ID of the menu that contains this menu item m.loMenuItem.MenuId = This.Menus(m.lcItemKey1).MenuId m.loMenuItem.ItemId = This._NextMenuItemId This._NextMenuItemId = This._NextMenuItemId + 1 *!* Proceed with API: Local ; lcMenuItemInfo As String,; loMenuItemInfo As _MENUITEMINFO ******************************************************************************** *!* typedef struct tagMENUITEMINFO { *!* UINT cbSize; *!* UINT fMask; *!* UINT fType; *!* UINT fState; *!* UINT wID; *!* HMENU hSubMenu; *!* HBITMAP hbmpChecked; *!* HBITMAP hbmpUnchecked; *!* ULONG_PTR dwItemData; *!* LPTSTR dwTypeData; *!* UINT cch; *!* HBITMAP hbmpItem; *!* } MENUITEMINFO, *LPMENUITEMINFO; ******************************************************************************** m.loMenuItemInfo = Createobject("_MENUITEMINFO") *!* *!* cbSize: Size of structure, in bytes. *!* m.loMenuItemInfo.cbSize = 12*4 *!* fMask: Members to retrieve or set m.loMenuItemInfo.fMask = Bitor(MIIM_FTYPE, MIIM_ID, MIIM_STRING, MIIM_DATA) m.loMenuItemInfo.fType = MFT_STRING If m.loMenuItem.Caption = "-" Then m.loMenuItemInfo.fType = Bitor(m.loMenuItemInfo.fType, MF_SEPARATOR) Endif If ctlGetOsVersion() < NTDDI_VISTA m.loMenuItemInfo.fMask = Bitor(m.loMenuItemInfo.fMask, MIIM_BITMAP) m.loMenuItemInfo.hbmpItem = HBMMENU_CALLBACK Else m.loMenuItemInfo.hbmpItem = 0 Endif m.loMenuItemInfo.fState = 0 *!* wID: Application-defined 16-bit value that identifies the menu item. *!* Set fMask to MIIM_ID to use wID. m.loMenuItemInfo.wID = m.loMenuItem.ItemId m.loMenuItemInfo.hSubMenu = 0 m.loMenuItemInfo.hbmpChecked = 0 m.loMenuItemInfo.hbmpUnchecked = 0 *!* dwItemData: Application-defined value associated with the menu item. *!* Set fMask to MIIM_DATA to use dwItemData. m.loMenuItemInfo.dwItemData = 0 *!* Pointer to Text string Local lcCaption As String m.lcCaption = Strtran(m.loMenuItem.Caption, "\t", TABCHAR) m.lcCaption = Strtran(m.lcCaption, "\<", "&") m.loMenuItemInfo.dwTypeData = m.lcCaption + NULA *!* cch: Length of the menu item text, in TCHARs, when information is received *!* about a menu item of the MFT_STRING type. Ignored when the content of a menu *!* item is set by calling SetMenuItemInfo. m.loMenuItemInfo.cch = Len(m.loMenuItemInfo.dwTypeData) *!* Structure members have been set, now create structure string: m.lcMenuItemInfo = m.loMenuItemInfo.Value *!* Count number of menu items of menu, to insert new menu item at the end apiInsertMenuItem( ; m.loMenuItem.MenuId, ; apiGetMenuItemCount(m.loMenuItem.MenuId), ; MF_BYPOSITION, ; @m.lcMenuItemInfo) m.loMenuItem.Picture = m.pePicture m.loMenuItem = .Null. m.loMenuItemInfo = .Null. Return *!* *!* fType: Menu item type: MFT_RADIOCHECK MFT_SEPARATOR MFT_STRING ...; *!* *!* Set fMask to MIIM_TYPE to use fType. *!* If m.loMenuItem.RadioCheck = TRUE Then *!* m.loMenuItemInfo.fType = Bitor(m.loMenuItemInfo.fType, MFT_RADIOCHECK) *!* Endif *!* *!* fState: Menu item state... MFS_CHECKED MFS_DEFAULT MFS_GRAYED ... *!* *!* Set fMask to MIIM_STATE to use fState *!* If m.loMenuItem.Checked = TRUE Then *!* m.loMenuItemInfo.fState = Bitor(m.loMenuItemInfo.fState, MFS_CHECKED) *!* Endif *!* If m.loMenuItem.DefaultItem = TRUE Then *!* m.loMenuItemInfo.fState = Bitor(m.loMenuItemInfo.fState, MFS_DEFAULT) *!* Endif *!* If m.loMenuItem.Enabled = FALSE Then *!* m.loMenuItemInfo.fState = Bitor(m.loMenuItemInfo.fState, MFS_GRAYED) *!* Endif *!* hbmpChecked: Handle to the bitmap to display next to the item if it is selected. *!* If this member is NULL, a default bitmap is used. *!* If the MFT_RADIOCHECK type value is specified, the default bitmap is a bullet. *!"* Otherwise, it is a check mark. *!* Set fMask to MIIM_CHECKMARKS to use hbmpChecked. *!* 20080324 *!* hbmpUnchecked: Handle to the bitmap to display next to the item if it is not selected. *!* If this member is NULL, no bitmap is used. *!* Set fMask to MIIM_CHECKMARKS to use hbmpUnchecked. *!* 20080324 *!* Reset structure *!*m.loMenuItemInfo = Createobject("_MENUITEMINFO") *!* Set callback so we process wm_measureitem and can fix the menu item height If ctlGetOsVersion() < NTDDI_VISTA m.loMenuItemInfo.fMask = MIIM_BITMAP m.loMenuItemInfo.hbmpItem = HBMMENU_CALLBACK m.lcMenuItemInfo = m.loMenuItemInfo.Value apiSetMenuItemInfo(m.loMenuItem.MenuId, m.loMenuItem.ItemId, MF_BYCOMMAND, @m.lcMenuItemInfo) Else *!* should create and add a blank transparent bitmap in Vista *!* of m.loMenuItem.PictureHeight width and height and then assign it: *!* m.loMenuItem.PictureId = m.loMenuItem.PictureObject.GetHBitmap(m.loColor) *!* This._SetMenuItemInfo_hbmpItem(m.loMenuItem.MenuId, m.loMenuItem.ItemId, m.loMenuItem.PictureId) Endif m.loMenuItem.Picture = m.puPicture ENDPROC PROCEDURE _addmenuitemtocollection *!* _AddMenuItemToCollection Lparameters ; m.pcMenuKey, ; m.pItemKey, ; m.pnType, ; m.pcCaption, ; m.puPicture, ; m.plChecked, ; m.plRadioCheck, ; m.plDisabled, ; m.plDefaultItem, ; m.pcStatusBarText Local loMenuItem as ctl32_menuitem *!* Add menu item object to MenuItems collection This.MenuItems.Add(Createobject("ctl32_menuitem"), m.pItemKey) *!* Assign values to all the menu item properties: m.loMenuItem = This.MenuItems(m.pItemKey) m.loMenuItem.Caption = m.pcCaption m.loMenuItem.DefaultItem = m.plDefaultItem m.loMenuItem.Enabled = Not m.plDisabled *!* ID of the menu that contains this menu item m.loMenuItem.MenuId = This.Menus(m.pcMenuKey).MenuId m.loMenuItem.Shortcut = "" m.loMenuItem.Checked = m.plChecked m.loMenuItem.RadioCheck = m.plRadioCheck m.loMenuItem.MenuPKey = m.pcMenuKey *!* if puPicture is numeric, it represents a picture handle m.loMenuItem.Picture = "" If Vartype(m.puPicture) = "N" Then m.loMenuItem.Picture = "" m.loMenuItem.PictureId = m.puPicture Endif If Vartype(m.puPicture) = "C" And File(m.puPicture) Then m.loMenuItem.Picture = m.puPicture Endif m.loMenuItem.ItemKey = m.pItemKey *!* ItemId is a random value m.loMenuItem.ItemId = This.MenuItems.GetKey(m.pItemKey) m.loMenuItem.StatusBarText = Iif(Vartype(m.pcStatusBarText) = "C", m.pcStatusBarText, "") *!* ID of the submenu called by this menu item If m.pnType = 3 m.loMenuItem.SubMenuId = This.Menus(m.pItemKey).MenuId Else m.loMenuItem.SubMenuId = 0 Endif m.loMenuItem = .Null. Return m.pItemKey *!* hbmpItem: Handle to the bitmap to be displayed, *!* or it can be one of the values in the following table. *!* It is used when the MIIM_BITMAP flag is set in the fMask member. *!* HBMMENU_CALLBACK *!* HBMMENU_POPUP_CLOSE *!* HBMMENU_POPUP_MAXIMIZE *!* HBMMENU_POPUP_MINIMIZE *!* HBMMENU_POPUP_RESTORE *!* HBMMENU_SYSTEM ENDPROC PROCEDURE _bindevents *!* _BindEvents() If ctlGetOsVersion() < NTDDI_VISTA Or This.OwnerDrawn Then This._WindowProcedure = ctlGetWindowProcedure(This.FormHwnd) Bindevent(This.FormHwnd, WM_MEASUREITEM, This, "OnWmMeasureItem") Bindevent(This.FormHwnd, WM_DRAWITEM, This, "OnWmDrawItem") Endif ENDPROC PROCEDURE _setbitmap ENDPROC PROCEDURE _setmenuiteminfo_hbmpitem *!* _SetMenuItemInfo_hBmpItem Lparameters pnHostId, pnItemId, pnBitmapId Local ; lcMenuItemInfo As String, ; loMenuItemInfo As _MENUITEMINFO m.loMenuItemInfo = Createobject("_MENUITEMINFO") m.loMenuItemInfo.fMask = MIIM_BITMAP m.loMenuItemInfo.hbmpItem = m.pnBitmapId m.lcMenuItemInfo = m.loMenuItemInfo.Value apiSetMenuItemInfo(m.pnHostId, m.pnItemId, MF_BYCOMMAND, @m.lcMenuItemInfo) m.loMenuItemInfo = Null ENDPROC PROCEDURE _setmenuiteminfo_miim_checkmarks *!* _SetMenuItemInfo_miim_checkmarks Lparameters pnHostId, pnItemId, pnBitmapId Local ; lcMenuItemInfo As String, ; loMenuItemInfo As _MENUITEMINFO m.loMenuItemInfo = Createobject("_MENUITEMINFO") m.loMenuItemInfo.fMask = MIIM_CHECKMARKS m.loMenuItemInfo.hbmpChecked = m.pnBitmapId m.loMenuItemInfo.hbmpUnchecked = m.pnBitmapId m.lcMenuItemInfo = m.loMenuItemInfo.Value apiSetMenuItemInfo(m.pnHostId, m.pnItemId, MF_BYCOMMAND, @m.lcMenuItemInfo) m.loMenuItemInfo = Null ENDPROC PROCEDURE lblname.Init Return FALSE ENDPROC ENDDEFINE