CLEAR
#define PROGRESS_CONTINUE 0
#define PROGRESS_CANCEL 1
#define PROGRESS_STOP 2
#define PROGRESS_QUIET 3
DECLARE integer CopyFileEx in Kernel32 string lpExistingFileName, string lpNewFileName,long lpProgressRoutine,long lpData,long pbCancel,long dwCopyFlags
DECLARE integer EnumChildWindows IN WIN32API integer hWnd, long lpEnumProc, long lParam
DECLARE Integer EnumFontFamilies IN gdi32 As EnumFontFamiliesA Integer hdc ,String lpszFamily ,Integer lpEnumFontFamProc,Integer lParam
DECLARE INTEGER GetDC IN WIN32API INTEGER hwnd
set library to callback
pCallBackMyWindow=0
pCallBackFontProc=0
pCallBackMyWindow=0
pCallBackMyWindow=SetAddressOf('MyWindow', 'i')
pCallBackFontProc=SetAddressOf('FontProc', 'iiii')
pCallBackCopyProc=SetAddressOf( 'CopyProc', 'IIIIiiiii')
EnumFontFamiliesA(GetDC(_vfp.hWnd),NULL,pCallBackFontProc,0)
EnumChildWindows(_vfp.hWnd,pCallBackMyWindow,0)
pbCancel=0
nRet=0
nRet=CopyFileEx("c:\vfp9.0.rar", "c:\vfp9.0back.rar", pCallBackCopyProc, 0, @pbCancel, 0)
ReleaseAddressOf(pCallBackCopyProc)
ReleaseAddressOf(pCallBackMyWindow)
ReleaseAddressOf(pCallBackFontProc)
SET LIBRARY TO
Function CopyProc
lparameters TotalFileSize, TotalBytesTransferred,StreamSize, StreamBytesTransferred,StreamNumber,CallbackReason,SourceFile,DestinationFile,lpData
?TotalFileSize, TotalBytesTransferred, ;
StreamSize, StreamBytesTransferred, ;
StreamNumber, ;
CallbackReason, ;
SourceFile, ;
DestinationFile, ;
lpData
return PROGRESS_CONTINUE
ENDFUNC
FUNCTION MyWindow
lparameters hwnd
?hwnd
return 1
ENDFUNC
FUNCTION FontProc
lparameters lpelfe as long,lpntme as long,fonttype as integer, lparam as long
*!*?lpelfe,lpntme,fonttype,lparam
logfont=sys(2600,lpelfe,28+33)
newtextmetric=sys(2600,lpntme,17*4+1)
facename=alltrim(right(logfont,33))
facename=substr(facename,1,at(0h00,facename)-1)
? facename
return 1
ENDFUNC
[此贴子已经被作者于2022-3-19 23:19编辑过]