乳房增生怎么形成的:VFP 调用AP实用程序(精)I
来源:百度文库 编辑:偶看新闻 时间:2024/10/05 23:16:47
设置表单的窗口区域
* 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
vb 能否调用vfp表单 或者 vfp调用vfp
用VFP写一个调用DLL(DELPHI写的)的DEMO要怎么写
急问高手:VFP中表单如何调用菜单??(提示找不到菜单文件)
VFP调用EXCEL的奇怪问题
如何在VFP中调用帮助文件?
在VFP中怎样调用系统程序
VFP调用EXCEL,如何合并单元格,并将文字居中?
在vfp中如何调用access数据库中的存储过程?
vfp表单text值调用表中得值
VFP中用于调用其它程序的代码是?
求高手解答VFP中数据表调用的问题
vfp中?"i="+str(i,2)是什么意思
知识求解(VFP)
AP course 的意思(英文)
用VFP做一个调用API的DEMO要用到那些函数?
等差数列{An},Ap=q,Aq=p,(p不等于q)求Ap+q
java 调用I浏览器URL传递多个参数
关于VFP(Visual FoxPro)
系统配置实用程序?
系统配置实用程序
系统配置实用程序
系统配置实用程序
系统配置实用程序
系统配置实用程序..