Foxtable(狐表)用户栏目专家坐堂 → ft为何闪退?


  共有2350人关注过本帖树形打印复制链接

主题:ft为何闪退?

帅哥哟,离线,有人找我吗?
kgdce
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:616 积分:6733 威望:0 精华:0 注册:2013/12/17 1:00:00
ft为何闪退?  发帖心情 Post By:2021/3/4 23:44:00 [只看该作者]

全局代码有如下代码:
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public  Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public  Declare Function EmptyClipboard Lib "user32" () As Long
'// CreateMetaFileA DeleteEnhMetaFile
Public Declare Function CopyEnhMetaFileA  Lib "gdi32" (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
Public Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As Long) As Long

Public Function fnSaveAsEMF(strFileName As String) As Boolean
Dim CF_ENHMETAFILE As Long = 14
Dim ReturnValue As Long
OpenClipboard(0)
ReturnValue = CopyEnhMetaFileA(GetClipboardData(CF_ENHMETAFILE), strFileName)
EmptyClipboard
CloseClipboard
'// Release resources to it eg You can now delete it if required
'// or write over it. This is a MUST
DeleteEnhMetaFile(ReturnValue)
fnSaveAsEMF = (ReturnValue <> 0)
End Function
命令窗口有如下代码,在桌面上建立图片文件夹,内放a.xlsx文件。执行至黄色代码处
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目7.foxdb
出现闪退,不知何原因,请指教!
Dim App As New MSExcel.Application
App.Visible = True
Dim Wb As MSExcel.Workbook = App.WorkBooks.Open("C:\Users\wuyong\Desktop\图片\a.xlsx")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
Dim Co As MSExcel.ChartObject = Ws.ChartObjects(1)
Dim Cht As MSExcel.Chart = Co.Chart
cht.ChartArea.Select
app.Selection.Copy
messagebox.show("01")
If fnSaveAsEMF("C:\Users\wuyong\Desktop\图片\001.emf") Then
    messagebox.show("1")
Else
    messagebox.show("2")
End If
[此贴子已经被作者于2021/3/4 23:45:49编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/3/5 8:46:00 [只看该作者]

调用这句代码出错,trycatch也捕捉不到异常。这是直接调用的系统api,我也搞不懂是什么问题

ReturnValue = CopyEnhMetaFileA(GetClipboardData(CF_ENHMETAFILE), strFileName)

 回到顶部
帅哥哟,离线,有人找我吗?
kgdce
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:616 积分:6733 威望:0 精华:0 注册:2013/12/17 1:00:00
  发帖心情 Post By:2021/3/5 10:23:00 [只看该作者]

我也知道是这句出错,所以才问为什么?查了百度也没有相关解决方案。还请大神提供解决思路。
有一个新思路,cht有这个方法,可以将图片拷到剪贴板,但如何将剪贴板上的数据再存为wmf或emf文件不会,这有什么办法吗?

经测试 cht.copypicture(2,-4117)  这句代码可以过去的。执行如下代码不会闪退,但会出现算术运算溢出的错误。请指教。

If fnSaveAsEMF("C:\Users\wuyong\Desktop\图片\001.emf") Then

    messagebox.show("1")

Else

    messagebox.show("2")

End If


[此贴子已经被作者于2021/3/5 12:45:53编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
kgdce
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:616 积分:6733 威望:0 精华:0 注册:2013/12/17 1:00:00
  发帖心情 Post By:2021/3/5 19:41:00 [只看该作者]

调用CopyEnhMetaFile函数 ansi版本CopyEnhMetaFileA会导致程序崩溃,应该调用unicode版本CopyEnhMetaFile,因为上下文都调用ansi版本,但是ft提示找不到函数CopyEnhMetaFile接口,请检查CopyEnhMetaFile函数api接口定义是否导入。

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/3/6 8:55:00 [只看该作者]

试试

<UnmanagedFunctionPointer(CallingConvention.Cdecl, CharSet:=CharSet.Unicode)> _
Public Declare Function CopyEnhMetaFileA  Lib "gdi32" (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long

 回到顶部
帅哥哟,离线,有人找我吗?
kgdce
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:616 积分:6733 威望:0 精华:0 注册:2013/12/17 1:00:00
  发帖心情 Post By:2021/3/6 10:51:00 [只看该作者]


图片点击可在新窗口打开查看此主题相关图片如下:4802b9ec-4b51-4d4a-8e2d-a6304f0abeb7.png
图片点击可在新窗口打开查看
上面代码不可用。但测试下面代码,发现测试通过,可能是剪贴板的内容格式的问题,不知如何改下面的代码,使得app.Selection.Copy的内容存为图元文件,请指教!
'全局代码------------------------------------------------------------------------------开始
<DllImport("user32.dll")>
Public Function GetClipboardData(hWndNewOwner As IntPtr) As Boolean
End Function
<DllImport("user32.dll")>
Public Function SetClipboardData(uFormat As UInteger, hMem As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")>
Public Function CloseClipboard() As Boolean
End Function
<DllImport("gdi32.dll")>
Public Function CopyEnhMetaFile(hemfSrc As IntPtr, hNULL As System.Text.StringBuilder) As IntPtr
End Function
<DllImport("gdi32.dll")>
Public Function CloseEnhMetaFile(hdc As IntPtr) As Integer
End Function
<DllImport("gdi32.dll")>
Public Function DeleteEnhMetaFile(hemf As IntPtr) As IntPtr
End Function
Public Function SaveEnhMetafileToFile(mf As Metafile, fileName As String) As Boolean
Dim bResult As Boolean = False
Dim hEMF As IntPtr
hEMF = mf.GetHenhmetafile()
' invalidates mf
If Not hEMF.Equals(New IntPtr(0)) Then
    Dim tempName As New StringBuilder(fileName)
    Dim hCopyEMF As IntPtr = CopyEnhMetaFile(hEMF, tempName)
    DeleteEnhMetaFile(hCopyEMF)
    DeleteEnhMetaFile(hEMF)
End If
Return bResult
End Function
'全局代码------------------------------------------------------------------------------结束
'命令窗口代码
Dim metafile As New Metafile("C:\Users\wuyong\Desktop\图片\003.emf") ‘此行如何换成app.Selection.Copy的内容
SaveEnhMetafileToFile(metafile,"C:\Users\wuyong\Desktop\图片\005.emf")

[此贴子已经被作者于2021/3/6 10:57:31编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
kgdce
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:616 积分:6733 威望:0 精华:0 注册:2013/12/17 1:00:00
  发帖心情 Post By:2021/3/8 15:14:00 [只看该作者]

vba测试通过,ft不过,是不是bUg?

 回到顶部