Using Win32 functions in Visual FoxPro Image Gallery
Code examples:
Custom GDI+ class
Storing content of the Clipboard to a bitmap file
How to print FoxPro form
Capturing keyboard activity of another application with the Raw Input API (VFP9)
Storing screen shot of a form to bitmap file
Displaying icons in the system tray (VFP9)
Pocket PC: custom RAPI class for operating with files and folders on mobile device
GDI+: Implementing image scrolling with inertia
How to print a bitmap file
Monitoring clipboard content changes (VFP9)
Using the LoadImage function to have a bitmap file loaded and displayed on VFP main window
How to ping a remote site using IP Helper API calls
Custom HttpRequest class (WinINet)
Using NetWkstaTransportEnum to obtain MAC Address of remote server
Loading a string resource from an executable file
Enumerating Processes -- WinNT
GDI+: reading and writing metadata in JPEG and TIFF files
How to view icons stored in executable files (Icon Viewer) - II
Obtaining names and positions for shortcuts located on the Windows Desktop
Using InternetSetFilePointer when resuming interrupted download from the Internet
Vertical Label control
A class that encrypts and decrypts files using Cryptography API Functions
Displaying dimmed window behind VFP top-level form
HOWTO: Use the Win32 API to Access File Dates and Times
Reading the structure of VFP main menu

User rating: 10/10 (3 votes)
Rate this code sample:
  • ~
More code examples    Listed functions    Add comment     W32 Constants      Translate this page Printer friendly version of this code sample
Before you begin:
This code sample reads the structure of VFP main menu and saves it in an XML document (the Microsoft.XMLDOM object is used for that).

This is an output this code produces -- the structure of VFP9 main menu.

See also:
  • Transparent Menu on top-level form (requires VFP9)
  • How to hot-track menu item selection in top-level form
  • Adding user-defined items to the Control Menu of VFP form

  • PRIVATE objXml, cTargetFile
    cTargetFile = "c:\temp\mnu.xml"  && replace with valid file name
    
    DECLARE INTEGER GetActiveWindow IN user32
    objXml = CREATEOBJECT("Tmenu", GetActiveWindow(), cTargetFile)
    
    IF TYPE("objXML") = "O"
        objXml.SaveXML
        objXml.ViewXml
    ELSE
        = MessageB("Invalid input parameters. ", 48, " Error")
    ENDIF
    
    DEFINE CLASS Tmenu As Custom
    PROTECTED hWindow, hMenu, xmldoc, rootnode, targetfile
    
    PROCEDURE Init(hwnd, cTargetFile)
        THIS.declare
    
        cTargetFile = FULLPATH(cTargetFile)
        IF PathFileExists(SUBS(cTargetFile, 1,RAT("\",cTargetFile))) = 0
            RETURN .F.  && invalid path
        ENDIF
    
        THIS.hWindow = hwnd
        THIS.hMenu = GetMenu(hwnd)
        IF IsMenu(THIS.hMenu) = 0
            RETURN .F.  && no menu found
        ENDIF
    
        WITH THIS
            .targetfile = cTargetFile
            .xmldoc = CreateObject("Microsoft.XMLDOM")
    
            .xmldoc.LoadXML(CHR(60)+[?xml version="1.0" ?]+CHR(62)+;
                CHR(60)+[TopMenu ]+CHR(47)+CHR(62))
    
            .rootnode = .xmldoc.documentElement()
            .SetProperty(.rootnode, "hWnd", m.hwnd)
            .DescribeNode(-1, .rootnode, .hMenu, 0,0)  && recursion
        ENDWITH
    
    PROCEDURE SaveXML
        THIS.xmldoc.Save(THIS.targetfile)
    
    PROCEDURE ViewXml
        = ShellExecute(0,"open", THIS.targetfile, "", "", 3)
    
    PROCEDURE DescribeNode(hParent, objNode, hMenu, lnItemIndex, lnItemID)
        LOCAL lnItemCount, objSubnode, hSubitem, lnIndex, lnID,;
            lnItemType, lnDataType, lnChecked, lnUnchecked, lnBitmap, lcItemType
    
        THIS.SetProperty(objNode, "hMenu", m.hMenu)
        THIS.SetProperty(objNode, "ItemIndex", m.lnItemIndex)
        THIS.SetProperty(objNode, "ItemID", m.lnItemID)
    
        IF hParent = -1  && root
            THIS.SetProperty(objNode, "WinCaption", THIS.GetWinCaption())
        ELSE
            STORE 0 TO lnItemType, lnDataType, lnBitmap, lnChecked, lnUnchecked
            THIS.GetItemData(hParent, lnItemIndex, @lnItemType,;
                @lnDataType, @lnChecked, @lnUnchecked, @lnBitmap)
    
            THIS.SetProperty(objNode, "ItemType", lnItemType)
            IF lnItemType <> 0
                lcItemType = THIS.GetItemTypeStr(lnItemType)
                THIS.SetProperty(objNode, "ItemTypeStr", lcItemType)
            ENDIF
            THIS.SetProperty(objNode, "DataType", lnDataType)
        ENDIF
    
        IF hMenu = -1
            RETURN
        ENDIF
    
        lnItemCount = GetMenuItemCount(m.hMenu)
        THIS.SetProperty(objNode, "ItemCount", m.lnItemCount)
    
        FOR lnIndex = 0 TO lnItemCount-1
            lnID = GetMenuItemID(m.hMenu, lnIndex)
            IF lnID = -1  && submenu
                objSubnode = THIS.xmldoc.CreateElement("SubMenu")
                hSubitem = THIS.GetSubmenuHandle(m.hMenu, m.lnIndex)
            ELSE  && menu item
                objSubnode = THIS.xmldoc.CreateElement("MenuItem")
                hSubitem = -1
            ENDIF
            objNode.AppendChild(objSubnode)
            THIS.DescribeNode(hMenu, objSubnode, hSubitem, lnIndex, lnID)
        ENDFOR
    RETURN
    
    PROCEDURE SetProperty(objNode, lcProperty, lvValue)
        LOCAL loProperty, loAttr, lcType
        loProperty = objNode.SelectSingleNode(lcProperty)
    
        IF TYPE("loProperty.Value") <> "C"
            loProperty = THIS.xmldoc.CreateElement(lcProperty)
            objNode.AppendChild(loProperty)
        ENDIF
    
        lcType = TYPE("lvValue")
        DO CASE
        CASE lcType = "C"
            lvValue = ALLTRIM(lvValue)
        CASE lcType = "L"
            lvValue = Iif(lvValue, "true","false")
        CASE lcType = "D"
            lvValue = DTOC(lvValue)
        CASE lcType = "T"
            lvValue = TTOC(lvValue)
        CASE lcType = "N"
            lvValue = LTRIM(STR(lvValue, 20))
        ENDCASE
        loProperty.Text = lvValue
    
    PROCEDURE declare
    #DEFINE MENUITEMINFO_SIZE 48
    #DEFINE MIIM_TYPE  16
    #DEFINE MIIM_SUBMENU 4
    #DEFINE MIIM_DATA 32
    #DEFINE MF_STRING 0
    #DEFINE MF_BITMAP 4
    #DEFINE MF_MENUBARBREAK 0x20
    #DEFINE MF_MENUBREAK 0x40
    #DEFINE MIIM_BITMAP 0x80
    #DEFINE MF_OWNERDRAW 0x100
    #DEFINE MFT_RADIOCHECK 0x200
    #DEFINE MF_SEPARATOR 0x800
    #DEFINE MFT_RIGHTORDER 0x2000
    #DEFINE MF_RIGHTJUSTIFY 0x4000
    
        DECLARE INTEGER GetObjectType IN gdi32 INTEGER h
        DECLARE INTEGER GetLastError IN kernel32
        DECLARE INTEGER GetMenu IN user32 INTEGER hWnd
        DECLARE INTEGER IsMenu IN user32 INTEGER hMenu
        DECLARE INTEGER PathFileExists IN shlwapi STRING pszPath
        DECLARE INTEGER GetMenuItemCount IN user32 INTEGER hMenu
        DECLARE INTEGER GetMenuItemID IN user32 INTEGER hMenu, INTEGER nPos
    
        DECLARE INTEGER ShellExecute IN shell32;
            INTEGER hwnd, STRING lpOperation, STRING lpFile,;
            STRING lpParams, STRING lpDir, INTEGER nShowCmd
    
        DECLARE INTEGER GetMenuItemInfo IN user32;
            INTEGER hMenu, INTEGER uItem, INTEGER fByPosition, STRING @lpmii
    
        DECLARE INTEGER GetMenuString IN user32;
            INTEGER hMenu, INTEGER uIDItem, STRING @lpString,;
            INTEGER @nMaxCount, INTEGER uFlag
    
        DECLARE INTEGER GetWindowText IN user32;
            INTEGER hwnd, STRING @lpString, INTEGER cch
    
    FUNCTION GetWinCaption
        LOCAL lcCaption
        lcCaption = SPACE(250)
        = GetWindowText(THIS.hWindow, @lcCaption, LEN(lcCaption))
    RETURN ALLTRIM(STRTRAN(lcCaption, Chr(0), ""))
    
    FUNCTION GetSubmenuHandle(hMenu, lnIndex)
        LOCAL lcBuffer
        lcBuffer = num2dword(MENUITEMINFO_SIZE) +;
            num2dword(MIIM_SUBMENU) + Repli(Chr(0), 40)
        = GetMenuItemInfo(hMenu, lnIndex, 1, @lcBuffer)
    RETURN buf2dword(SUBSTR(lcBuffer, 21,4))
    
    PROCEDURE GetItemData
    PARAM hMenu, lnIndex, lnIType, lnDType, lnChecked, lnUnchecked, lnBMP
        LOCAL lcBuffer, loItemData
        loItemData = CreateObject("PChar", Repli(Chr(0), 250))
        lcBuffer = num2dword(MENUITEMINFO_SIZE) +;
            num2dword(MIIM_TYPE+MIIM_DATA) + Repli(Chr(0), 28) +;
            num2dword(loItemData.hMem) + Repli(Chr(0), 8)
        = GetMenuItemInfo(hMenu, lnIndex, 1, @lcBuffer), lcBuffer
        lnIType = buf2dword(SUBSTR(lcBuffer, 9,4))
        lnDType = buf2dword(SUBSTR(lcBuffer, 37,4))
        lnBMP = buf2dword(SUBSTR(lcBuffer, 45,4))
    
    FUNCTION BTest(lnExpr, lnTest)
    RETURN BitAnd(lnExpr, lnTest) = lnTest
    
    FUNCTION GetItemTypeStr(lnType)
        LOCAL cType
        cType = ""
        cType = cType + Iif(THIS.BTest(lnType, MF_BITMAP),       "bitmap;", "")
        cType = cType + Iif(THIS.BTest(lnType, MF_MENUBARBREAK), "barbreak;","")
        cType = cType + Iif(THIS.BTest(lnType, MF_MENUBREAK),    "break;","")
        cType = cType + Iif(THIS.BTest(lnType, MIIM_BITMAP),     "xbitmap;","")
        cType = cType + Iif(THIS.BTest(lnType, MF_OWNERDRAW),    "owner;","")
        cType = cType + Iif(THIS.BTest(lnType, MFT_RADIOCHECK),  "radio;","")
        cType = cType + Iif(THIS.BTest(lnType, MF_SEPARATOR),    "separator;","")
        cType = cType + Iif(THIS.BTest(lnType, MFT_RIGHTORDER),  "rightord;","")
        cType = cType + Iif(THIS.BTest(lnType, MF_RIGHTJUSTIFY), "rightjust;","")
    RETURN cType
    ENDDEFINE
    
    DEFINE CLASS PChar As Custom
        hMem=0
    
    PROCEDURE Init(lcString)
        THIS.setValue(lcString)
    PROCEDURE Destroy
        THIS.ReleaseString
    
    PROCEDURE SetValue(lcString) && assigns new string value
    #DEFINE GMEM_FIXED 0 
        DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER, INTEGER
        DECLARE RtlMoveMemory IN kernel32 As Str2Heap;
            INTEGER, STRING @, INTEGER
    
        LOCAL lnSize
    
        THIS.ReleaseString
        lcString = lcString + Chr(0)
        lnSize = Len(lcString)
    
        THIS.hMem = GlobalAlloc(GMEM_FIXED, lnSize)
        IF THIS.hMem <> 0
            = Str2Heap(THIS.hMem, @lcString, lnSize)
        ENDIF
    
    PROCEDURE ReleaseString  && releases allocated memory
        IF THIS.hMem <> 0
            DECLARE INTEGER GlobalFree IN kernel32 INTEGER
            = GlobalFree(THIS.hMem)
            THIS.hMem = 0
        ENDIF
    ENDDEFINE
    
    FUNCTION buf2dword(cBuffer)
    RETURN Asc(SUBSTR(cBuffer, 1,1)) + ;
        BitLShift(Asc(SUBSTR(cBuffer, 2,1)),  8) +;
        BitLShift(Asc(SUBSTR(cBuffer, 3,1)), 16) +;
        BitLShift(Asc(SUBSTR(cBuffer, 4,1)), 24)
    
    FUNCTION num2dword(lnValue)
    #DEFINE m0 0x0000100
    #DEFINE m1 0x0010000
    #DEFINE m2 0x1000000
        IF lnValue < 0
            lnValue = 0x100000000 + lnValue
        ENDIF
        LOCAL b0, b1, b2, b3
        b3 = Int(lnValue/m2)
        b2 = Int((lnValue - b3*m2)/m1)
        b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
        b0 = Mod(lnValue, m0)
    RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
    
    
    

    User rating: 10/10 (3 votes)
    Rate this code sample:
    • ~
    7678 bytes  
    Created: 2002-10-31 11:29:48  
    Modified: 2013-10-09 09:16:36  
    Visits in 7 days: 151  
    Listed functions:
    GetActiveWindow
    GetLastError
    GetMenu
    GetMenuItemCount
    GetMenuItemID
    GetMenuItemInfo
    GetMenuString
    GetObjectType
    GetWindowText
    GlobalAlloc
    GlobalFree
    IsMenu
    PathFileExists
    ShellExecute
    Printer friendly API declarations
    My comment:
    All VFP menu items are of the OWNERDRAW type. Which means the main window receives at least two types of menu-related window messages: WM_MEASUREITEM and WM_DRAWITEM.

    The first one is received when menu item is created. The second message comes every time when menu item has to be drawn or redrawn (for example, triggered by item selection change).

    Since VFP9 allows intercepting window messages through BINDEVENT calls, the processing of the WM_DRAWITEM and other menu-related window messages becomes a feasible task.
    Word Index links for this example:
    Translate this page:
      Spanish    Portuguese    German    French    Italian  
    FreeTranslation.com offers instant, free translations of text or web pages.
    User Contributed Notes:
    There are no notes on this subject.


    Copyright 2001-2017 News2News, Inc. Before reproducing or distributing any data from this site please ask for an approval from its owner. Unless otherwise specified, this page is for your personal and non-commercial use. The information on this page is presented AS IS, meaning that you may use it at your own risk. Microsoft Visual FoxPro and Windows are trade marks of Microsoft Corp. All other trademarks are the property of their respective owners. 

    Privacy policy
    Credits: PHP (4.4.9), an HTML-embedded scripting language, MySQL (5.6.38), the Open Source standard SQL database, AceHTML Freeware Version 4, freeware HTML Editor of choice.   Hosted by Korax Online Inc.
    Last Topics Visited (54.198.134.32)
    11 sec.Function: 'StartDoc'
    Function group: 'Printing and Print Spooler'
    21 sec.Function: 'FtpGetCurrentDirectory'
    Function group: 'Internet Functions (WinInet)'
    33 sec.Function: 'htons'
    Function group: 'Windows Sockets 2 (Winsock)'
    40 sec.Function: 'GdipSetMatrixElements'
    Function group: 'GDI+ Matrix'
    55 sec.Function: 'CeRegQueryInfoKey'
    Function group: 'Remote Application Programming (RAPI)'
    1.08 min.
    1.27 min.Function: 'mixerSetControlDetails'
    Function group: 'Windows Multimedia'
    1.43 min.Example: 'Retrieving configuration information for the specified workstation (Win2000/XP)'
    1.63 min.Function: 'SQLConfigDataSource'
    Function group: 'ODBC API'
    1.8 min.
    Function group: 'String'
    Google
    Advertise here!