艾波·罗斯与罗斯:VFP 调用AP实用程序（精）

设置表单的窗口区域

* Program Name : SetWinRegion.Prg
* Article No.  : [Win API] - 020
* Illustrate   : 设置表单的窗口区域
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 类似于‘在一个表单上戳一个（或几个平行）的透明窟窿’的
*              : API，它把单进行部分透明，其表单并没有宿小，可以看见背后
*              : 的东西，在 VFP 7.0 下运行，效果更佳。*******************************************************Public frm
frm = CreateObject ("Tform")
frm.Visible = .T.
ReturnDefine CLASS Tform As Form
    Caption = "Setting the Window Region"
    Width = 600
    Height = 350
    AutoCenter = .T.
    MaxButton = .F.
    MinButton = .F.    Add OBJECT CmdOn As CommandButton WITH;
        Left=15, Top=7, Width=120, Height=25, FontName = 'System',;
        Caption="Set Region On"    Add OBJECT CmdOff As CommandButton WITH;
        Left=15, Top=35, Width=120, Height=25, FontName = 'System',;
        Caption="Set Region Off"    Procedure  Load
        This.decl
    Endproc    Procedure  CmdOn.Click
        Thisform.regionOn
    Endproc    Procedure  CmdOff.Click
        Thisform.regionOff
    Endproc    Procedure  regionOn
        Local hRgn
        hRgn = CreateRectRgn (0, 0, 200, 100)
        = SetWindowRgn (GetFocus(), hRgn, 1)
    Endproc    Procedure  regionOff
        = SetWindowRgn (GetFocus(), 0, 1)
    Endproc    Procedure  decl
        Declare INTEGER GetFocus IN user32        Declare INTEGER CreateRectRgn IN gdi32;
            INTEGER nLeftRect,;
            INTEGER nTopRect,;
            INTEGER nRightRect,;
            INTEGER nBottomRect        Declare SetWindowRgn IN user32;
            INTEGER hWnd,;
            INTEGER hRgn,;
            SHORT   bRedraw
    Endproc
Enddefine**********************************************************************
* Program Name : Long2Short.Prg
* Article No.  : [Win API] - 019
* Illustrate   : 转换长路径/文件名为短路径/文件名
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : FoxPro 的许多命令/函数只能处理 8/3 格式的短路径/文件名，
*              : 有了 GetShortPathName API 函数，吃饭蹦蹦香......
* Usage        : ? ShortPath("C:\Program Files\Microsoft Visual
*              : Studio\Vfp98")************************************************************************
Function ShortPath
******************
*** Function: Converts a Long Windows filename into a short
*** 8.3 compliant path/filename
*** Pass: lcPath - Path to check
*** Return: lcShortFileName
*************************************************************************
    Lparameter lcPath    Declare INTEGER GetShortPathName IN "kernel32";
        STRING  @ lpszLongPath,;
        STRING  @ lpszShortPath,;
        INTEGER   cchBuffer    lcPath = lcPath
    lcShortName = SPACE(260)
    lnLength = LEN(lcShortName)
    lnResult = GetShortPathName(@lcPath, @lcShortName, lnLength)    If lnResult = 0
        Return ""
    Endif
    Return  LEFT(lcShortName,lnResult)* Program Name : NationalLanguage.Prg
* Article No.  : [Win API] - 018
* Illustrate   : 获取国家语言代码设置
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 系统缺省 LangID = 2052 为中文（简体），其他代码请查找
*              : 手册。我在做一套双语版的‘餐饮管理软件’的时候，启动时
*              : 用该函数判别是中文版还是英文版的 Windows，然后再启动相
*              : 对应语言界面的软件。DECLARE SHORT GetSystemDefaultLangID IN kernel32
DECLARE SHORT GetUserDefaultLangID   IN kernel32
DECLARE SHORT GetSystemDefaultLCID   IN kernel32
DECLARE SHORT GetUserDefaultLCID     IN kernel32
DECLARE SHORT GetThreadLocale        IN kernel32DECLARE INTEGER GetOEMCP IN kernel32
DECLARE INTEGER GetACP IN kernel32
DECLARE INTEGER GetKBCodePage IN user32 "系统缺省 LangID               : ", GetSystemDefaultLangID()
"用户缺省 LangID               : ", GetUserDefaultLangID()
"系统缺省局部字符集标识符 LCID : ", GetSystemDefaultLCID()
"用户缺省局部字符集标识符 LCID : ", GetUserDefaultLCID()
"Current Thread Locale         : ", GetThreadLocale()
"OEM 代码页标识符              : ", GetOEMCP()
"ANSI 代码页标识符             : ", GetACP()
"Current code page (should be the same as GetOEMCP): ", GetKBCodePage()********************************************************************* Program Name : Upper2Lower.Prg
* Article No.  : [Win API] - 017
* Illustrate   : 字符串字母的大小写转换
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 一般不用该函数，因为速度要比 VFP 内含的字符串字母的大小
*              : 写转换函数要慢，但可以在字符串转换量不是太大、并且是在
*              : 函数群中使用，或者对某些 Unicode 串转换，或者要对字符串
*              : 加密，而大多数人对 Win API 不熟，蒙一下。**********************************************************************DECLARE INTEGER CharLower IN user32 STRING @ lpsz
DECLARE INTEGER CharUpper IN user32 STRING @ lpszlcText = "I Love Tuberose, Please Kiss Me......" CharLower (@lcText)
lcText CharUpper (@lcText)
lcText* Program Name : ClosingVFP.Prg
* Article No.  : [Win API] - 016
* Illustrate   : 强行退出 VFP
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 可以直接退出 VFP 的应用程序，避免按右上角的 'X'，提示
*              :‘不能退出 VFP 应用程序’的烦恼，如果要直接退出 VFP 的
*              : 某一子应用程序，可以用 GetExitCodeProcess 仿照使用。Declare ExitProcess IN kernel32 INTEGER uExitCode
ExitProcess (54)    && 任意值* Program Name : UsingShellAbout.Prg
* Program Name : UsingShellAbout.Prg
* Article No.  : [Win API] - 015
* Illustrate   : 显示 Windows About 对话窗
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 该程序使用的人恐怕不多：字型不能调，又有免费为 MS 做广
*              : 告的嫌疑。Declare INTEGER ShellAbout IN shell32;
    INTEGER hwnd,;
    STRING  szApp,;
    STRING  szOtherStuff,;
    INTEGER hIconHWnd = 0
szApp = ">>> 显示 About 对话窗 # >>> 夜来香大酒店"
szOtherStuff = ">>>  The ShellAbout Function ..."
hIcon = 0 ShellAbout (hwnd, szApp, szOtherStuff, hIcon)* Program Name : ReadingOptions.Prg
* Article No.  : [Win API] - 014
* Illustrate   : 读取注册表中 VFP 6.0 的选项
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 这些是有关我经常使用的函数。#Define ERROR_SUCCESS               0
#Define KEY_READ               131097
#Define KEY_ALL_ACCESS         983103
#Define HKEY_CURRENT_USER  2147483649 && 0x80000001Do declhBaseKey = 0
*    lcBaseKey = "Software\Microsoft\VisualFoxPro\3.0\Options"
*    lcBaseKey = "Software\Microsoft\VisualFoxPro\5.0\Options"
lcBaseKey = "Software\Microsoft\VisualFoxPro\6.0\Options"
*    lcBaseKey = "Software\Microsoft\VisualFoxPro\7.0\Options"* try this option too
*    lcBaseKey = "Software\ODBC\ODBC.INI\ODBC Data Sources"If RegOpenKeyEx (HKEY_CURRENT_USER, lcBaseKey,;
        0, KEY_ALL_ACCESS, @hBaseKey) <> ERROR_SUCCESS
    "Error opening registry key"
    Return
EndifCreate CURSOR cs (valuename cs(50), valuevalue cs(200))dwIndex = 0
Do WHILE .T.
    lnValueLen = 250
    lcValueName = Repli(Chr(0), lnValueLen)
    lnType = 0
    lnDataLen = 250
    lcData = Repli(Chr(0), lnDataLen)    lnResult = RegEnumValue (hBaseKey, dwIndex,;
        @lcValueName, @lnValueLen, 0,;
        @lnType, @lcData, @lnDataLen)* for this case on return the type of data (lnType)
* is always equal to 1 (REG_SZ)
* that means null-terminated string    If lnResult <> ERROR_SUCCESS
        Exit
    Endif    lcValueName = Left (lcValueName, lnValueLen)
    lcData = Left (lcData, lnDataLen-1)
    Insert INTO cs VALUES (lcValueName, lcData)    dwIndex = dwIndex + 1
Enddo= RegCloseKey (hBaseKey)
Select cs
Index ON valuename TAG valuename
Go TOP
Brow NORMAL NOWAITProcedure  decl
    Declare INTEGER RegCloseKey IN advapi32 INTEGER hKey    Declare INTEGER RegOpenKeyEx IN advapi32;
        INTEGER   hKey,;
        STRING    lpSubKey,;
        INTEGER   ulOptions,;
        INTEGER   samDesired,;
        INTEGER @ phkResult    Declare INTEGER RegEnumValue IN advapi32;
        INTEGER   hKey,;
        INTEGER   dwIndex,;
        STRING  @ lpValueName,;
        INTEGER @ lpcValueName,;
        INTEGER   lpReserved,;
        INTEGER @ lpType,;
        STRING  @ lpData,;
        INTEGER @ lpcbData********************************************************************* Program Name : ClosingWindows.Prg
* Article No.  : [Win API] - 013
* Illustrate   : 关闭计算机
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 这些是有关 Win 9.x 快速开机/关机的函数，第二个程序只能
*              : 是 Win NT。
* Note         : 测试之前，务必先保存你的文件，万万！！！***********************************************************************#Define EWX_LOGOFF        0
#Define EWX_SHUTDOWN      1
#Define EWX_REBOOT        2
#Define EWX_FORCE         4
#Define EWX_POWEROFF      8
#Define EWX_FORCEIFHUNG  16Declare INTEGER ExitWindows IN "user32" As "ExitWindows";
    INTEGER dwReserved,;
    INTEGER uReturnCodeDeclare INTEGER ExitWindowsEx IN "user32" As "ExitWindowsEx";
    INTEGER uFlags,;
    INTEGER dwReserved* 注销用户
* = ExitWindowsEx (EWX_LOGOFF, 0)* 关闭计算机
* = ExitWindowsEx (EWX_SHUTDOWN, 0)* 重新启动计算机
= ExitWindowsEx (EWX_REBOOT, 0) * WinNT 应该用下列代码：Declare INTEGER GetLastError IN kernel32Declare SHORT InitiateSystemShutdown IN advapi32;
    STRING  lpMachineName,;
    STRING  lpMessage,;
    INTEGER dwTimeout,;
    SHORT   bForceAppsClosed,;
    SHORT   bRebootAfterShutdownIf InitiateSystemShutdown ("", "Your time is out", 10, 0, 1) <> 1
* Common reasons for failure include an invalid
* or inaccessible computer name or insufficient privilege.*   5 = ERROR_ACCESS_DENIED
* 120 = ERROR_CALL_NOT_IMPLEMENTED -- not supported in Win9*
    "Error code:", GetLastError()
Endif
**************************************************************** * Program Name : ChangeSystemColor.Prg
* Article No.  : [Win API] - 011
* Illustrate   : 几个显示目录的函数
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     : *****************************************************************
* 1. Defining VFP executable running Declare INTEGER GetModuleFileName IN kernel32;
    INTEGER  hModule,;
    STRING @ lpFilename,;
    INTEGER  nSizehModule = 0    && means current process
lpFilename = SPACE(250)lnLen = GetModuleFileName (hModule, @lpFilename, Len(lpFilename))
Left (lpFilename, lnLen)
* 2. Displaying the System directoryDeclare INTEGER GetSystemDirectory IN kernel32;
    STRING @ lpBuffer,;
    INTEGER nSizelpBuffer = SPACE (250)
nSizeRet = GetSystemDirectory (@lpBuffer, Len(lpBuffer))If nSizeRet <> 0
    lpBuffer = SUBSTR (lpBuffer, 1, nSizeRet)
    lpBuffer
Endif
* 3. Displaying the Windows directoryDECLARE INTEGER GetWindowsDirectory IN kernel32;
    STRING @lpBuffer,;
    INTEGER nSizelpBuffer = SPACE (250)
nSizeRet = GetWindowsDirectory (@lpBuffer, Len(lpBuffer))IF nSizeRet <> 0
    lpBuffer = SUBSTR (lpBuffer, 1, nSizeRet)
    lpBuffer
ENDIF* Program Name : ChangeSystemColor.Prg
* Article No.  : [Win API] - 010
* Illustrate   : 如何更改系统颜色？
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
#Define COLOR_SCROLLBAR      0
#Define COLOR_ACTIVECAPTION  2
#Define COLOR_WINDOW         5
#Define COLOR_WINDOWFRAME    6
#Define COLOR_MENUTEXT       7
#Define COLOR_WINDOWTEXT     8Declare INTEGER GetSysColor IN "user32" INTEGER nIndexDeclare INTEGER SetSysColors IN "user32";
    INTEGER nChanges,;
    INTEGER @ lpSysColor,;
    INTEGER @ lpColorValues* save old color
lnSavedColor = GetSysColor (COLOR_WINDOWFRAME)* change the color
nChanges = 1
lpSysColor = COLOR_WINDOWFRAME
lpColorValues = RGB (0, 0, 255)        && bright blue
SetSysColors (nChanges, @lpSysColor, @lpColorValues)= MESSAGEB ("窗口的边框颜色已更改，", 64, "Win32 SetSysColor")* restore the old value
SetSysColors (nChanges, @lpSysColor, @lnSavedColor)
= MESSAGEB ("窗口的边框颜色已回原。", 64, "Win32 SetSysColor")****************************************************************** Program Name : SuspendExecution.Prg
* Article No.  : [Win API] - 009
* Illustrate   : 如何迟延程序的执行？
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 如果 INFINITE = DWORD(&Hffffffff)，将引起无限等待，
*              : 我不敢用，慎用。DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
= Sleep (3000)  && 迟延 3 秒****************************************************************** Program Name : PrintingText.Prg
* Article No.  : [Win API] - 008
* Illustrate   : 如何把字符窜直接发送到 VFP 主窗口上？
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
*Do declHWnd = GetActiveWindow()
hDC = GetWindowDC (hwnd)lpString = "Printing Text with TextOut"
= TextOut (hDC, 50,80, lpString, Len(lpString)) &&= ReleaseDC (hwnd, hDC)Procedure  decl
    Declare INTEGER GetWindowDC IN user32 INTEGER hwnd    Declare INTEGER ReleaseDC IN user32;
        INTEGER hwnd, INTEGER hdc    Declare INTEGER GetActiveWindow IN user32    Declare INTEGER TextOut IN gdi32;
        INTEGER hdc,;
        INTEGER x,;
        INTEGER y,;
        STRING  lpString,;
        INTEGER nCount******************************************************************** Program Name : ShellFiles.Prg
* Article No.  : [Win API] - 021
* Illustrate   : 使用 Shell 的文件操作与运行
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 在测试该程序之前，需要正确的文件名和路径，以及所关联 API，
*              : 的可执行文件。#Define SW_SHOWNORMAL     1
#Define SW_SHOWMINIMIZED  2
#Define SW_SHOWMAXIMIZED  3Declare INTEGER GetSystemDirectory IN kernel32;
    STRING @ lpBuffer, INTEGER nSizeDeclare INTEGER ShellExecute IN shell32;
    INTEGER hwnd, STRING lpOperation,;
    STRING lpFile, STRING lpParameters,;
    STRING lpDirectory, INTEGER nShowCmd* 举例：
* 1.使用所关联的可执行文件打开对应的数据文件：
*    = ShellExecute (0, "open", "c:\aa\index.mdb", "", "", SW_SHOWMAXIMIZED)
*    = ShellExecute (0, "open", "c:\aa\aa.bmp", "", "", SW_SHOWMAXIMIZED)
*    = ShellExecute (0, "open", "c:\aa\lacrymosa.mp3", "", "",
SW_SHOWMAXIMIZED)
*    = ShellExecute (0, "open", "c:\aa\mkart.doc", "", "", SW_SHOWMAXIMIZED)
*    = ShellExecute (0, "open", "c:\aa\aa.txt", "", "", SW_SHOWMAXIMIZED)* 2.打开文件夹：
*    = ShellExecute (0, "explore", "c:\Temp", "", "", SW_SHOWMAXIMIZED)* 3.打开查找窗口：
*    = ShellExecute (0, "find", "", "", getSysDir(), SW_SHOWMAXIMIZED)* 4.打印文件：
*    = ShellExecute (0, "print", "c:\aa\index.txt", "", "",
SW_SHOWMAXIMIZED)* 5.访问互连网：
= ShellExecute(0,"open", "http://www.microsoft.com/",;
    "", "", SW_SHOWMAXIMIZED)Function  getSysDir
    lpBuffer = SPACE (250)
    nSizeRet = GetSystemDirectory (@lpBuffer, Len(lpBuffer))
    Return SUBSTR (lpBuffer, 1, nSizeRet)**************************************************************
* Program Name : UsingFrameRgn.Prg
* Article No.  : [Win API] - 012
* Illustrate   : 使用 FrameRgn 显示系统颜色
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     : ***************************************************************#Define sqTop       120
#Define sqLeft       30
#Define sqHeight     64
#Define sqWidth      64
#Define stroke       32
#Define sqInterval   10
#Define dsHeight    600
#Define dsWidth     600Do declX = sqLeft
Y = sqTop
lnColorIndex = 0Do WHILE .T.
    If Not _display (lnColorIndex, X,Y, sqWidth,sqHeight)
        Exit
    Endif    lnColorIndex = lnColorIndex + 1
    X = X + sqWidth + sqInterval    If X > dsWidth
        X = sqLeft
        Y = Y + sqHeight + sqInterval
    Endif
EnddoFunction  _display (lnColorIndex, X,Y, width, height)
* draw a frame using system color    Local hwnd, hDc, hBrush, hRgn
    hBrush = GetSysColorBrush (lnColorIndex)    If hBrush <> 0
        HWnd = GetFocus()
        hDc = GetWindowDC(hwnd)
        hRgn = CreateRectRgn (X, Y, X+width, Y+height)* draw a bold frame
        = FrameRgn (hDc, hRgn, hBrush, stroke, stroke)* set text color
        = SetTextColor (hDc, Rgb (128,128,128))* print color index value
        lcColorIndex = STR(lnColorIndex, 3) + " "
        = TextOut (hDc, X+4,Y+4,;
            lcColorIndex, Len(lcColorIndex))* draw a thin frame with system color 1
        hBrush = GetSysColorBrush (1)
        = FrameRgn (hDc, hRgn, hBrush, 1, 1)        = DeleteObject (hRgn)
        = ReleaseDC (hwnd, hDc)
        Return .T.
    Endif
    Return .F.Procedure  decl
    Declare INTEGER GetFocus IN user32
    Declare INTEGER GetWindowDC IN user32 INTEGER hwnd
    Declare INTEGER ReleaseDC IN user32;
        INTEGER hwnd, INTEGER hdc
    Declare INTEGER DeleteObject IN gdi32 INTEGER hObject    Declare INTEGER GetSysColorBrush IN user32 INTEGER nIndex    Declare INTEGER CreateRectRgn IN gdi32;
        INTEGER nLeftRect, INTEGER nTopRect,;
        INTEGER nRightRect,INTEGER nBottomRect    Declare SHORT FrameRgn IN gdi32;
        INTEGER hdc,;
        INTEGER hrgn, INTEGER hbr,;
        INTEGER nWidth, INTEGER nHeight    Declare INTEGER TextOut IN gdi32;
        INTEGER hdc,;
        INTEGER x, INTEGER y,;
        STRING  lpString, INTEGER nCount    Declare INTEGER SetTextColor IN gdi32;
        INTEGER hdc, INTEGER crColor
 ************************************************************** Program Name : ViewIcons.Prg
* Article No.  : [Win API] - 004
* Illustrate   : 如何显示应用程序文件的图标？
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
***************************************************************PUBLIC frm
    frm = CreateObject ("Tform")
    frm.Visible = .T.DEFINE CLASS Tform As Form
    Width=600
    Height=400
    AutoCenter = .T.
    Caption = "Display Application Icons"    ADD OBJECT lbl As Label WITH;
        Caption="App:", Left=15, Top=10
    ADD OBJECT txt As TextBox WITH;
        Left=60, Top=8, Height=24, Width=450
    ADD OBJECT cmdFile As CommandButton WITH;
        Caption="...", Top=8, Left=512,;
        Width=30, Height=24
    ADD OBJECT cmd As CommandButton WITH;
        Caption="Refresh", Width=80, Height=24,;
        Default=.T.PROCEDURE  Load
    THIS.decl
ENDPROCPROCEDURE  Init
    THIS.txt.Value = THIS.getVFPmodule()
    THIS.Resize
    THIS.cmd.SetFocus
    THIS.drawIcons
ENDPROCPROCEDURE  Resize
    WITH THIS.cmd
        .Left = Int((ThisForm.Width - .Width)/2)
        .Top = THIS.Height - .Height - 10
    ENDWITH
ENDPROCPROCEDURE  drawIcons
    * clear form
    THIS.visible = .F.
    THIS.visible = .T.
    = INKEY (0.1)    && give a break    LOCAL lcExe, hApp, lnIndex, hIcon, X,Y, dX,dY
    lcExe = ALLTRIM(THIS.txt.Value)
    IF Not FILE (lcExe)
        WAIT WINDOW "File " + lcExe + " not found" NOWAIT
    ENDIF    hApp = GetModuleHandle(0)
    STORE 40 TO dX,dY
    Y = 56
    X = dX    lnIndex = 0
    DO WHILE .T.
        hIcon = ExtractIcon (hApp, lcExe, lnIndex)
        IF hIcon = 0
            EXIT
        ENDIF        THIS._draw (hIcon, X,Y)
        = DestroyIcon (hIcon)        lnIndex = lnIndex + 1
        X = X + dX
        IF X > THIS.Width-dX*2
            X = dX
            Y = Y + dY
        ENDIF
    ENDDO
ENDPROCPROTECTED PROCEDURE  _draw (hIcon, X,Y)
    LOCAL hwnd, hdc
    hwnd = GetFocus()
    hdc = GetDC(hwnd) && this form
    = DrawIcon (hdc, X,Y, hIcon)
    = ReleaseDC (hwnd, hdc)
ENDPROCPROCEDURE  selectFile
    LOCAL lcFile
    lcFile = THIS.getFile()
    IF Len(lcFile) <> 0
        THIS.txt.Value = lcFile
        THIS.drawIcons
    ENDIF
ENDPROCPROTECTED FUNCTION getFile
    LOCAL lcResult, lcPath, lcStoredPath
    lcPath = SYS(5) + SYS(2003)
    lcStoredPath = FULLPATH (THIS.txt.Value)
    lcStoredPath = SUBSTR (lcStoredPath, 1, RAT(Chr(92),lcStoredPath)-1)    SET DEFAULT TO (lcStoredPath)
    lcResult = GETFILE("EXE", "Get Executable:", "Open",0)
    SET DEFAULT TO (lcPath)
    RETURN LOWER(lcResult)
ENDFUNCPROCEDURE  decl
    DECLARE INTEGER GetFocus IN user32
    DECLARE INTEGER GetDC IN user32 INTEGER hwnd
    DECLARE INTEGER GetModuleHandle IN kernel32 INTEGER lpModuleName    DECLARE INTEGER ReleaseDC IN user32;
        INTEGER hwnd, INTEGER hdc    DECLARE INTEGER LoadIcon IN user32;
        INTEGER hInstance,;
        INTEGER lpIconName    DECLARE INTEGER ExtractIcon IN shell32;
        INTEGER hInst,;
        STRING  lpszExeFileName,;
        INTEGER lpiIcon    DECLARE SHORT DrawIcon IN user32;
        INTEGER hDC,;
        INTEGER X,;
        INTEGER Y,;
        INTEGER hIcon    DECLARE INTEGER GetModuleFileName IN kernel32;
        INTEGER  hModule,;
        STRING @ lpFilename,;
        INTEGER  nSize    DECLARE SHORT DestroyIcon IN user32 INTEGER hIcon
ENDPROCPROTECTED FUNCTION  getVFPmodule
    LOCAL lpFilename
    lpFilename = SPACE(250)
    lnLen = GetModuleFileName (0, @lpFilename, Len(lpFilename))
RETURN Left (lpFilename, lnLen)
ENDFUNCPROCEDURE  cmd.Click
    ThisForm.drawIcons
ENDPROC
PROCEDURE  cmdFile.Click
    ThisForm.selectFile
ENDPROC
ENDDEFINE
 **************************************************************** Program Name : PrinterDrivers.Prg
* Article No.  : [Win API] - 007
* Illustrate   : 如何显示所安装的打印机驱动程序？
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
****************************************************************Do decl* put existing print server name; if there is one available
lcServer = "PRNSRV001" "*** 打印服务器上的打印机驱动程序是：" + lcServer + ":"
= displayPrinterDrivers (lcServer) && print server
"*** 本地打印机驱动程序是："
= displayPrinterDrivers ("") && local driversFunction  displayPrinterDrivers (lcServer)
    Local cdBuf, pDriverInfo, pcbNeeded, pcReturned* the first call retrieves number of bytes needed to store the return
    pDriverInfo = Chr(0)
    Store 0 TO pcbNeeded, pcReturned
    = EnumPrinterDrivers (lcServer, "Windows NT x86", 1,;
        @pDriverInfo, 0, @pcbNeeded, @pcReturned)* main call
    pDriverInfo = REPLI(Chr(0), pcbNeeded)
    lnResult = EnumPrinterDrivers (lcServer, Chr(0), 1,;
        @pDriverInfo, pcbNeeded, @pcbNeeded, @pcReturned)    If pcReturned = 0
        "No drivers found"
        "Error code returned:", GetLastError()
        Return
    Else
        "pcReturned:", pcReturned
        "pcDriverInfo:", pDriverInfo
    Endif* array for storing addr-offs info
    Dimen adr [pcReturned, 4]* save 4-byte address values for returned blocks
    For ii=1 TO pcReturned
        ss = SUBSTR (pDriverInfo, (ii-1)*4+1, 4)
        adr [ii, 1] = buf2dword(ss)
    Endfor* calculate offsets and lengths
    dd = 0
    For ii=pcReturned TO 2 STEP -1
        adr[ii, 2] = adr[ii-1, 1] - adr[ii, 1] && substr length
        dd = dd + adr[ii, 2]
        adr[ii-1, 3] = dd + 1 && offset
    Endfor
    adr[pcReturned, 3] = 1
    adr[1, 2] = Len(pDriverInfo) - pcReturned*4+1 - adr[1, 3]* remove the leading address part from the buffer
    pDriverInfo = SUBSTR(pDriverInfo, pcReturned*4+1)* extract and display substrings -- driver names
    For ii=1 TO pcReturned
        adr[ii,4] = STRTRAN(SUBSTR (pDriverInfo, adr[ii,3], adr[ii,2]),
Chr(0), "")
        adr[ii,4]
    Endfor
    ReturnFunction  buf2dword (lcBuffer)
    Return;
        Asc(SUBSTR(lcBuffer, 1,1)) + ;
        Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
        Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
        Asc(SUBSTR(lcBuffer, 4,1)) * 16777216Procedure  decl
    Declare INTEGER GetLastError IN kernel32
    Declare INTEGER EnumPrinterDrivers IN winspool.drv;
        STRING    pName,;
        STRING    pEnvironment,;
        INTEGER   Level,;
        STRING  @ pDriverInfo,;
        INTEGER   cdBuf,;
        INTEGER @ pcbNeeded,;
        INTEGER @ pcReturned****************************************************************
* Program Name : ClipMouseCursor.Prg
* Article No.  : [Win API] - 006
* Illustrate   : 如何局限鼠标的光标活动区域？
* Date / Time  : 2001.09.10
* Writer       :
* 1st Post     :
* My Comment   : 个别用户喜欢做与本工作无关的事情，用此法 Try......
****************************************************************PUBLIC frm
frm = CreateObject("TForm")
frm.Visible = .T.DEFINE CLASS TForm As Form
    PROTECTED mClip
    ADD OBJECT cmdClip As TCommand
    ADD OBJECT cmdRestore As TCommandPROCEDURE  Load
     THIS.decl    && declare external functions
ENDPROCPROCEDURE  Init
    STORE .F. TO THIS.MaxButton, THIS.MinButton
    STORE 300 TO THIS.Width, THIS.Height
    THIS.Caption = "Clipping Mouse Cursor Area"
    THIS.BorderStyle = 2
    THIS.AutoCenter = .T.
    THIS.cmdClip.Caption = "Clip"
    THIS.cmdRestore.Caption = "Restore"    * saving initial clipping area
    lpRect = REPLI (Chr(0), 16)
    = GetClipCursor (@lpRect)
    THIS.mClip = lpRect    THIS.Resize
ENDPROCPROCEDURE  Destroy
    THIS.restoreInitStatus
ENDPROCPROCEDURE  Resize
    lnTop = MAX(5, THIS.Height - THIS.cmdClip.Height - 5)
    STORE lnTop TO THIS.cmdClip.Top, THIS.cmdRestore.Top
    THIS.cmdRestore.Left = THIS.Width - THIS.cmdRestore.Width - 10
    THIS.cmdClip.Left = THIS.cmdRestore.Left - THIS.cmdClip.Width - 2
ENDPROCPROCEDURE  clip
* lock the mouse cursor within the form area
    MOUSE AT THIS.top, THIS.left PIXELS  && put cursor inside the form
    * give VFP a moment to update mouse position in its internal data
    = INKEY (0.1)    lpPoint = REPLI (Chr(0), 8)    && buffer for a POINT structure
    = GetCursorPos (@lpPoint)  && retrieve absolute mouse position    LOCAL absX, absY, lcCaptionHeight, lcFrameWidth,;
        lcFrameHeight, lcRect    absX = ThisForm.buf2dword (SUBSTR(lpPoint, 1,4))
    absY = ThisForm.buf2dword (SUBSTR(lpPoint, 5,4))    * retrieve some sizes to be used in calculating the area
    lcCaptionHeight = GetSystemMetrics ( 4)  && size of normal caption area
    lcFrameWidth    = GetSystemMetrics (32)  && resiz.window frame width
    lcFrameHeight   = GetSystemMetrics (33)  && resiz.window frame height    lcRect = REPLI (Chr(0), 16)        && buffer for RECT structure
    * set the RECT by the form position, and size
    THIS.num2rect (absX, absY,;
        absX + THIS.Width + lcFrameWidth,;
        absY + THIS.Height + lcCaptionHeight + lcFrameHeight,;
        @lcRect)    = ClipCursor (lcRect)  && locked!
ENDPROCPROCEDURE  restoreInitStatus
    = ClipCursor (THIS.mClip)
ENDPROCPROCEDURE  cmdClip.Click
    ThisForm.clip
ENDPROCPROCEDURE  cmdRestore.Click
    ThisForm.restoreInitStatus
ENDPROCFUNCTION  buf2dword (lcBuffer)
#DEFINE m0       256
#DEFINE m1     65536
#DEFINE m2  16777216
RETURN;
    Asc(SUBSTR(lcBuffer, 1,1)) + ;
    Asc(SUBSTR(lcBuffer, 2,1)) * m0 +;
    Asc(SUBSTR(lcBuffer, 3,1)) * m1 +;
    Asc(SUBSTR(lcBuffer, 4,1)) * m2
ENDFUNCFUNCTION  num2buf
PARAMETERS  lnValue
#DEFINE m0       256
#DEFINE m1     65536
#DEFINE m2  16777216
    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)PROCEDURE  num2rect (lnLeft, lnTop, lnRight, lnBottom, lcBuffer)
    lcBuffer = THIS.num2buf(lnLeft) + THIS.num2buf(lnTop)+;
        THIS.num2buf(lnRight) + THIS.num2buf(lnBottom)
ENDFUNCPROCEDURE  decl
    DECLARE INTEGER ClipCursor       IN user32   STRING lpRect
    DECLARE INTEGER GetCursorPos     IN user32   STRING @ lpPoint
    DECLARE INTEGER GetClipCursor    IN user32   STRING @ lpRect
    DECLARE INTEGER GetSystemMetrics IN user32   INTEGER nIndex
ENDPROC
ENDDEFINEDEFINE CLASS TCommand As CommandButton
    Width = 60
    Height = 25
    FontName = 'System'
ENDDEFINE