Files
comun/utile/ctl32/ctl32_contextmenu.vc2

1183 lines
36 KiB
Plaintext
Raw Permalink Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
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
*</PropValue>
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<6D>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<6F>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