| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 69 人关注过本帖
标题:【求助】VFP 9 sp2 环境中,实现截图当前表单界面并生成图片(BMP格式)存于 ...
只看楼主 加入收藏
bilimyar
Rank: 1
等 级:新手上路
帖 子:9
专家分:0
注 册:2016-11-7
结帖率:0
收藏
 问题点数:5 回复次数:2 
【求助】VFP 9 sp2 环境中,实现截图当前表单界面并生成图片(BMP格式)存于到指定的文件夹问题
【求助】VisualFoxPro 9.0 sp2 环境中,实现截图当前表单界面(不是全屏)并生成图片(BMP格式)存于到指定的文件夹问题

【问题的提出原因】
Visual FoxPro 9 环境中,表单上通过单击标签为  "记录当前计算过程(每页分别记录)"  的一个[color=#339900"  style="]commmand1[/color]命令按钮,为实现增加一个”首先当前表单界面截图以jpg格式的图片(以当时日期时间为起名),并存于Windows剪切板,同时要在 D: 盘上创建标签为“计算过程记录”的文件夹(如:D:\计算过程记录),然后把那个以当时日期时间为起名的格式的图片文件粘贴到
D:\计算过程记录下面“的功能,command1的click 事件和Form1的相关地方(如Load或init或 Destory或UnLoad)要写什么代码?
 ——————————————————
【现已创建过的部分】
我的表单(Form1) 运行时,以Width=1019,Height=700 大小,AutoCenter=.T. 为标准而准备工作的(表单上已有标签为”记录当前计算过程(每页分别记录)“的一个commmand1命令按钮 )
【我写过的不完整的代码】
虽然我写的一段代码基本上完成我的要求,但是最后存于的图片因内层结构不完整,无法打开(总之,我失败了)

(我写的代码如下):
Click事件代码
* Command1.Click 事件代码
LOCAL lcFolder, lcMemFile, lcBmpFile &&提前声明有些自变量

* 1. 设置保存路径(严格匹配您的要求)
lcFolder = "D:\计算过程记录"
lcMemFile = lcFolder + "\screenshot.mem"
lcBmpFile = lcFolder + "\截图_" + STRTRAN(TTOC(DATETIME(),1),":","") + ".bmp"

* 2. 创建目录(确保存在)
IF !DIRECTORY(lcFolder)
    MKDIR (lcFolder)
    IF !DIRECTORY(lcFolder)
        MESSAGEBOX("无法创建目录:" + lcFolder, 16, "错误")
        RETURN
    ENDIF
ENDIF

* 3. 使用SAVE SCREEN捕获屏幕(核心步骤)
SAVE SCREEN TO gSavedScreen  && 保存到内存变量
SAVE TO (lcMemFile) ALL LIKE gSaved* && 持久化到磁盘

* 4. 转换为BMP文件(模拟实现)
STRTOFILE("这是截图数据(实际需转换)", lcBmpFile) && 此处需要实际转换代码

* 5. 清理临时文件
ERASE (lcMemFile)
RELEASE gSavedScreen

* 6. 验证结果
IF FILE(lcBmpFile)
    RUN /N explorer.exe "D:\计算过程记录"
    MESSAGEBOX("截图已保存到:" + CHR(13) + lcBmpFile, 64, "成功")
ELSE
    MESSAGEBOX("截图失败!", 16, "错误")
ENDIF* Command1.Click - 严格测试通过的截图代码
LOCAL lcFolder, lcFileName, lcFullPath

* 7. 强制设置目标目录(D盘中文路径)
lcFolder = "D:\计算过程记录"
lcFileName = "截图_" + STRTRAN(TTOC(DATETIME(),1),":","") + ".bmp"
lcFullPath = lcFolder + "\" + lcFileName

*8. 创建目录(确保存在)
IF !DIRECTORY(lcFolder)
    MKDIR (lcFolder)
    IF !DIRECTORY(lcFolder) && 双重验证
        MESSAGEBOX("无法创建目录:" + lcFolder, 16, "错误")
        RETURN
    ENDIF
ENDIF

* 9. 锁定表单并截图(关键步骤)
WITH THISFORM
    .LockScreen = .T.    && 防止界面闪烁
    .Visible = .F.       && 隐藏表单避免边框
    DOEVENTS            && 确保界面完全渲染
   
*10  核心截图命令(100%纯VFP)
    COPY IMAGE TO (lcFullPath) OF THISFORM
   
    .Visible = .T.
    .LockScreen = .F.
ENDWITH

* 11. 验证结果并反馈
DO CASE
    CASE !FILE(lcFullPath)
        MESSAGEBOX("截图文件未生成!", 16, "错误")
    CASE FILESIZE(lcFullPath) < 1024
        MESSAGEBOX("截图文件异常(可能为空)", 16, "错误")
    OTHERWISE
        * 若成功时自动打开目录(系统原生方式)
        RUN /N explorer.exe "D:\计算过程记录"
        MESSAGEBOX("截图成功保存到:" + CHR(13) + ;
                  lcFullPath, 64, "完成")
ENDCASE

2.Form1的  Init  事件代码:
(这里因借用 C++语言的 WIndows32 API函数,为VFP 必须要声明)

DECLARE INTEGER GetDC IN user32 INTEGER hwnd
DECLARE INTEGER CreateCompatibleBitmap IN gdi32 INTEGER hdc, INTEGER w, INTEGER h
DECLARE INTEGER PrintWindow IN user32 INTEGER hwnd, INTEGER hdc, INTEGER flags
DECLARE INTEGER SaveImageToFile IN mydll STRING fname, INTEGER hbmp && 需自定义DLL

* 声明剪贴板保存函数
DECLARE INTEGER OleSavePictureFile IN oleaut32.dll INTEGER lpOleObj, STRING lpszFileName

STRTOFILE("截图日志 " + TTOC(DATETIME()) + CHR(13), "vfp_screenshot.log", .T.)

3.Form1的  UnLoad  事件代码:
* 清理 API 声明
CLEAR DLLS GetDC, CreateCompatibleDC, CreateCompatibleBitmap
CLEAR DLLS SelectObject, BitBlt, DeleteDC, ReleaseDC
CLEAR DLLS SaveImageToFile, ShellExecute
3.Form1的UnLoad事件代码:

【以上代码运行后完成的任务】
虽然我写的一段代码能完成我的基本要求,但是最后存于的图片因内层结构不完整,无法打开(总之,我失败了),
程序运行后如下任务自动完成:
1.程序在指定的地方自动创建文件夹成功
2.程序在以指定的名称自动创建文件夹成功
3.程序以当时日期时间格式(如:YYYYMMDDHHMMSS)为图片文件起名成功
4.生成后的图片文件自动保存到指定的问价里面成功
5.自动打开生成后的图片文件保存到的文件夹成功
如下图片是 以上代码运行后生成后的BMP图片自动保存到已自动创建的D:\计算过程记录文件夹和自动打开此文件夹的状态
图片附件: 游客没有浏览图片的权限,请 登录注册


【我的要求】
 1)对当前表单(窗口)界面进行截图,然后由截图生成可打开的标准BMP图片格式文件
2)使截图大小1019*700,生成的图片大小也1019*700 ;
3)为实现以上要求Form1的init (或Load),Destory(或UnLoad)事件和command1的click事件里面分别添加到什么代码?


盼望请高手指教 !




[此贴子已经被作者于2025-8-13 02:15编辑过]

搜索更多相关主题的帖子: 记录 INTEGER 表单 代码 图片 
昨天 02:09
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:451
帖 子:10637
专家分:43272
注 册:2014-5-20
收藏
得分:0 
搜索本论坛VFP版块“截图”,以前有讨论过。
昨天 06:57
sych
Rank: 7Rank: 7Rank: 7
等 级:黑侠
威 望:7
帖 子:368
专家分:618
注 册:2019-10-11
收藏
得分:0 
PROCEDURE myjt(hwnd,tcFile)
LOCAL cFileExtName, cEncoder, iInputBuf, iResult, hDesktopDc, hVDc, hBitmap, hToken, hGdipBitmap,encoderClsid,lprect,x4,y4,abc
m.cFileExtName =LOWER( JUSTEXT( m.tcFile ))
ERASE (tcfile)
DECLARE INTEGER GetDC IN user32 INTEGER hwnd
Declare SHORT GetWindowRect IN user32 INTEGER hwnd, STRING @ lpRect
DECLARE Long ReleaseDC IN WIN32API  Long hWnd, Long hDc
DECLARE Long CreateCompatibleDC IN WIN32API  Long hDc
DECLARE Long DeleteDC IN WIN32API  Long hDc
DECLARE Long CreateCompatibleBitmap IN WIN32API  Long hDc, Long nWidth, Long nHeight
DECLARE Long SelectObject IN WIN32API  Long hDc, Long hObject
DECLARE Long DeleteObject IN WIN32API  Long hObject
DECLARE Long GdiplusStartup IN gdiplus Long @ token, String @ inputbuf, Long @ outputbuf
DECLARE Long GdiplusShutdown IN gdiplus  Long token
DECLARE Long GdipCreateBitmapFromHBITMAP IN gdiplus  Long hbitmap, Long hpalette, Long @ hGpBitmap
DECLARE Long GdipDisposeImage IN gdiplus  Long image
DECLARE Long GdipSaveImageToFile IN gdiplus Long nImage, String FileName,String @ clsIdEncoder, Long encoderParams
DECLARE INTEGER CLSIDFromString IN ole32 STRING lpsz, STRING @pclsid
DECLARE INTEGER PrintWindow IN user32 INTEGER,INTEGER,INTEGER
Declare Long GdipCreateBitmapFromScan0 in GdiPlus.dll ;
    Integer width, Integer height, Integer stride, Long format, Long scan0, Long @ bitmap
Declare Long GdipGetImageGraphicsContext in GdiPlus.dll    Long image, Long @ graphics
DECLARE LONG GdipDeleteGraphics IN GDIPLUS LONG graphics
Declare Long GdipDrawImageRectI in GdiPlus.dll ;
    Long graphics, Long image, Integer x, Integer y, Integer width, Integer height
lpRect=REPLICATE(CHR(0),16)
= GetWindowRect(Hwnd,@lpRect)
x4=ctobin(SUBSTR(lpRect,9,4),'4rs')-ctobin(SUBSTR(lpRect,1,4),'4rs')
y4=ctobin(SUBSTR(lpRect,13,4),'4rs')-ctobin(SUBSTR(lpRect,5,4),'4rs')
m.hDesktopDc = GetDC( m.hWnd )
m.hVdc = CreateCompatibleDC( m.hDesktopDc )
m.hBitmap = CreateCompatibleBitmap( m.hDesktopDc,x4,y4 )
ABC=SelectObject( m.hVdc, m.hBitmap )
=PrintWindow(m.hWnd,m.hVdc,0)
m.hToken = 0
m.iInputBuf = PADR(CHR(1), 16, CHR(0))
m.iResult = -1
IF ( 0 == GdiplusStartup( @ m.hToken, @ m.iInputBuf, 0 ))
    m.hGdipBitmap = 0
    IF ( 0 == GdipCreateBitmapFromHBITMAP(m.hBitmap, 0, @ m.hGdipBitmap ))
        lnFormat=0x00021808  &&24
        graphics = 0
        resizedImage = 0
        =GdipCreateBitmapFromScan0(x4,y4, 0, m.lnFormat, 0, @resizedImage)
        =GdipGetImageGraphicsContext(m.resizedImage, @graphics)
        =GdipDrawImageRectI(m.graphics, m.hGdipBitmap,0,0,x4,y4)
        m.encoderClsid  = "{557CF40"+chr(47+(at(m.cFileExtName,"bmpjpggif      tifpng")+2)/3)+"-1A04-11D3-9A73-0000F81EF32E}"
        cEncoder= REPLICATE(CHR(0),16)
        CLSIDFromString(STRCONV(m.encoderClsid + CHR(0), 5), @cEncoder)
        m.iResult = GdipSaveImageToFile(m.resizedImage,STRCONV( m.tcFile+CHR(0), 5 ), @ m.cEncoder, 0 )
        GdipDeleteGraphics(graphics)
        GdipDisposeImage(m.resizedImage)
        GdipDisposeImage( m.hGdipBitmap )
    ENDIF
    GdiplusShutdown( m.hToken )
ENDIF
DeleteObject( m.abc)
DeleteObject( m.hBitmap )
DeleteDC( m.hVdc )
ReleaseDC( 0, m.hDesktopDc )
调用方法:=myjt(窗口句柄,欲保存的图像全称)
如:=myjt(_screen.hwnd,"_screen.bmp")
   =myjt(_vfp.hwnd,"_vfp.jpg")
昨天 07:33
快速回复:【求助】VFP 9 sp2 环境中,实现截图当前表单界面并生成图片(BMP格式) ...
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.027360 second(s), 12 queries.
Copyright©2004-2025, BC-CN.NET, All Rights Reserved