Using Win32 functions in Visual FoxPro Image Gallery
Code examples:
Custom GDI+ class
Splash Screen for the VFP application
Obtaining names and positions for shortcuts located on the Windows Desktop
Displaying dimmed window behind VFP top-level form
Printing text with the Escape function
Enumerating devices installed on the local machine
Subclassing CommandButton control to create BackColor property
GDI+: Implementing image scrolling with inertia
How to make a VFP form fading out when released (GDI version)
How to put a vertical text scrolling on the form (a movie cast)
Vertical Label control
System Image List Viewer
Enumerating Processes -- WinNT
Converting image file to .ICO file
Class library providing access to the System Registry
Disconnecting USB Mass Storage Device programmatically
Winsock: retrieving Web pages using sockets (HTTP, port 80)
How to play AVI file on the _screen
Passing data records between VFP applications via the Clipboard
Capturing keyboard activity of another application with the Raw Input API (VFP9)
Reading and setting system access privileges for the current process
Monitoring clipboard content changes (VFP9)
Detecting changes in connections to removable drives (VFP9)
How to print a bitmap file
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: 141  
    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-2018 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.234.0.2)
    3 sec.
    Function group: 'Shell Functions'
    5 sec.Function: 'timeGetDevCaps'
    Function group: 'Windows Multimedia'
    8 sec.
    Function group: 'Device Context'
    10 sec.Function: 'CreateEnhMetaFile'
    Function group: 'Metafile'
    13 sec.Function: 'GdipGetImageGraphicsContext'
    Function group: 'GDI+ Image'
    15 sec.Function: 'mmioCreateChunk'
    Function group: 'Windows Multimedia'
    17 sec.Examples
    19 sec.Function: 'AVIStreamLength'
    Function group: 'Windows Multimedia'
    22 sec.Example: 'Moving shortcut to a specified position on the Windows Desktop'
    24 sec.Example: 'Printing text with the Escape function'
    Google
    Advertise here!