首页 | 编程语言 | 网站建设 | 游戏天堂 | 冲浪宝典 | 网络安全 | 操作系统 | 软件时空 | 硬件指南 | 病毒相关 | IT 认证
软讯网络 > 编程语言 > .NET > C#.NET > 为何在VB6中,"SetClipboardData CF_METAFILEPICT, hGlobal" 该句总是报溢出
【标  题】:为何在VB6中,"SetClipboardData CF_METAFILEPICT, hGlobal" 该句总是报溢出
【关键字】:VB6,SetClipboardData,CF_METAFILEPICT,hGlobal
【来  源】:http://blog.csdn.net/feifeima2008/archive/2006/07/20/945730.aspx

为何在VB6中,"SetClipboardData CF_METAFILEPICT, hGlobal" 该句总是报溢出

 朋友:
   有谁知道msdn中"如何从 Visual Basic 4.0 调用剪贴板 API"中的代码在VB6不能正常运行,即Command2_Click不能正确运行,错误:溢出。

    “如何从 Visual Basic 4.0 调用剪贴板 API”  文章编号:159823 内容如下:

下列语句从磁盘加载元文件并将其复制到 Windows 剪贴板:
   'DiskMetaFileName is the path to a WMF file on the disk.
Clipboard.SetData LoadPicture(DiskMetaFileName), vbCFMetafile

图元文件成功复制到剪贴板。 但是, y 维度元磁盘文件中建议中元文件大小忽略, 并且设置以匹配 x 维度中建议大小。 您可以通过将以下代码片段与窗体上一个图像控件 (Image1) 重现错误:
   Clipboard.Clear                        ' Clear Clipboard.
Clipboard.SetData LoadPicture(DiskMetaFileName), vbCFMetafile
Image1.Stretch = False 'Resize the control to fit the graphics
Image1.Picture = Clipboard.GetData(vbCFMetafile) 'Copy from Clipboard
Debug.Print Image1.Width, Image1.Height

备注: Image1.Width 是始终 Image1.Height 一样。

本文中示例代码提供子程序, SetMetaToClp, 通过直接调用 WindowsAPI 工作纠正错误。

分步示例

1. 启动 Visual Basic 4.0。 如果已经运行, 从文件菜单中选择新项目。 默认情况下创建 Form 1。
2. 向 Form 1 添加两 CommandButtons、 Command 和 Command 2。
3. 向 Form 1 添加一个 Image 控件, Image1。
4. 为 Form 1, 清除所有代码并粘贴以下代码添加到 Form 1 的代码窗口然后:
'Please change the path so that it points to a valid metafile.
Private Const strFileName = "d:\vb4\metafile\arrows\Smallarw.wmf"

Private Sub Command1_Click()
Clipboard.Clear ' Clear Clipboard.
Clipboard.SetData LoadPicture(strFileName), vbCFMetafile
Image1.Stretch = False
Image1.Picture = Clipboard.GetData(vbCFMetafile) 'Copy from Clipboard
Debug.Print Image1.Width, Image1.Height
'Image1.Width is always the same as Image1.Height. Bug!

End Sub

Private Sub Command2_Click()
Clipboard.Clear ' Clear Clipboard.
SetMetaToClp strFileName
Image1.Stretch = False
Image1.Picture = Clipboard.GetData(vbCFMetafile) 'Copy from Clipboard
Debug.Print Image1.Width, Image1.Height

'Image1.Width and Image1.Height now display the metafile size suggested
'in the disk metafile
End Sub
5. 将 Module 1, 模块, 插入项目。 复制并粘贴到 Module 1 如下代码:
Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0
Public Const GMEM_SHARE = &H2000
Public Const GMEM_MOVEABLE = &H2
Public Const GMEM_ZEROINIT = &H40
Public Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Public Const HFILE_ERROR = &HFFFF

Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type

Type RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type

Type APMFILEHEADER
key As Long
hmf As Integer
bbox As RECT
inch As Integer
reserved As Long
checksum As Integer
End Type

#If Win16 Then
Type METAHEADER
mtType As Integer
mtHeaderSize As Integer
mtVersion As Integer
dummy1 As Integer
mtSize As Long
mtNoObjects As Integer
dummy2 As Integer
mtMaxRecord As Long
mtNoParameters As Integer
End Type

Type METAFILEPICT
mm As Integer
xExt As Integer
yExt As Integer
hmf As Integer
End Type
#Else
Type METAHEADER
mtType As Integer
mtHeaderSize As Integer
mtVersion As Integer
mtSize As Long
mtNoObjects As Integer
mtMaxRecord As Long
mtNoParameters As Integer
End Type

Type METAFILEPICT
mm As Long
xExt As Long
yExt As Long
hmf As Long
End Type
#End If

#If Win16 Then
Declare Function OpenClipboard Lib "User" (ByVal hwnd As Integer) _
As Integer
Declare Function CloseClipboard Lib "User" () As Integer
Declare Function EmptyClipboard Lib "User" () As Integer
Declare Function SetClipboardData Lib "User" (ByVal wFormat As _
Integer, ByVal hMem As Integer) As Integer
Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, _
ByVal dwBytes As Long) As Integer
Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As _
Integer) As Integer
Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) _
As Integer
Declare Sub CopyMemory Lib "Kernel" Alias "hmemcpy" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "Kernel" Alias "hmemcpy" (ByVal hpvDest _
As Long, hpvSource As Any, ByVal cbCopy As Long)
Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, _
lpReOpenBuff As OFSTRUCT, ByVal wStyle As Integer) As Integer
Declare Function llseek Lib "Kernel" Alias "_llseek" (ByVal hFile As _
Integer, ByVal lOffset As Long, ByVal iOrigin As Integer) As Long
Declare Function lread Lib "Kernel" Alias "_lread" (ByVal hFile As _
Integer, lpBuffer As Any, ByVal wBytes As Integer) As Integer
Declare Function lread2 Lib "Kernel" Alias "_lread" (ByVal hFile As _
Integer, ByVal lpBuffer As Long, ByVal wBytes As Integer) As Integer
Declare Function hread2 Lib "Kernel" Alias "_hread" (ByVal hFile As _
Integer, ByVal lpBuffer As Long, ByVal wBytes As Long) As Long
Declare Function lclose Lib "Kernel" Alias "_lclose" (ByVal hFile As _
Integer) As Integer
Declare Function SetMetaFileBits Lib "GDI" (ByVal hMem As _
Integer) As Integer
#Else
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "Kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "Kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "Kernel32" Alias "RtlMoveMemory" (ByVal _
hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)
Declare Function OpenFile Lib "Kernel32" (ByVal lpFileName As String, _
lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Declare Function llseek Lib "Kernel32" Alias "_llseek" (ByVal hFile As _
Long, ByVal lOffset As Long, ByVal iOrigin As Long) As Long
Declare Function lread Lib "Kernel32" Alias "_lread" (ByVal hFile _
As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
Declare Function lread2 Lib "Kernel32" Alias "_lread" (ByVal hFile _
As Long, ByVal lpBuffer As Long, ByVal wBytes As Long) As Long
Declare Function lclose Lib "Kernel32" Alias "_lclose" (ByVal hFile _
As Long) As Long
Declare Function SetMetaFileBitsEx Lib "gdi32" (ByVal nSize As Long, _
ByVal lpData As Long) As Long
#End If

Public Const CF_METAFILEPICT = 3

Public Const MM_ANISOTROPIC = 8
Public Const MM_ISOTROPIC = 7
Public Const MM_TWIPS = 6
Public Const MM_HIENGLISH = 5
Public Const MM_HIMETRIC = 3
Public Const MM_LOENGLISH = 4
Public Const MM_LOMETRIC = 2
Public Const MM_TEXT = 1

Public Sub SetMetaToClp(szFileName As String)
Dim inof As OFSTRUCT
Dim APMHeader As APMFILEHEADER
Dim mfHeader As METAHEADER
#If Win16 Then
Dim fh As Integer
Dim hData As Integer
Dim hmf As Integer
Dim hGlobal As Integer
#Else
Dim fh As Long
Dim hData As Long
Dim hmf As Long
Dim hGlobal As Long
#End If
fh = OpenFile(szFileName, inof, OF_READ)
If fh = HFILE_ERROR Then
Debug.Print "openfile fails"
Exit Sub
End If
llseek fh, 0, 0
lread fh, APMHeader, LenB(APMHeader)
llseek fh, LenB(APMHeader), 0
lread fh, mfHeader, LenB(mfHeader)

hData = GlobalAlloc(GHND, (mfHeader.mtSize * 2))
If hData = 0 Then
Debug.Print "fail to allocate memory"
lclose fh
Exit Sub
End If
Dim lpData As Long
lpData = GlobalLock(hData)
llseek fh, LenB(APMHeader), 0
#If Win16 Then
hread2 fh, lpData, mfHeader.mtSize * 2
GlobalUnlock (hData)
hmf = SetMetaFileBits(hData)
#Else
lread2 fh, lpData, mfHeader.mtSize * 2
hmf = SetMetaFileBitsEx(mfHeader.mtSize * 2, lpData)
#End If

lclose fh
'if any above file op's fail, hmf will be 0
'or you can check each file op return to see if it is HFILE_ERROR
'but that will be a big waste of code
If hmf = 0 Then
Debug.Print "openfile or SetMetaFile fails"
GlobalFree hData
Exit Sub
End If
Dim myMetaFilePict As METAFILEPICT
myMetaFilePict.mm = MM_ANISOTROPIC
myMetaFilePict.xExt = 2540& * (APMHeader.bbox.Right - _
APMHeader.bbox.Left) / APMHeader.inch
myMetaFilePict.yExt = 2540& * (APMHeader.bbox.Bottom - _
APMHeader.bbox.Top) / APMHeader.inch
myMetaFilePict.hmf = hmf
'cannot directly put myMetaFilePict to clipboard
'memory block for clipboard has to have the flag GMEM_SHARE
hGlobal = GlobalAlloc(GMEM_SHARE, LenB(myMetaFilePict))
Dim lpPict As Long
lpPict = GlobalLock(hGlobal)
CopyMemory2 lpPict, myMetaFilePict, LenB(myMetaFilePict)
GlobalUnlock hGlobal
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_METAFILEPICT, hGlobal
CloseClipboard
End Sub

Broaden your options: Don't fear native code:【上一篇】
Gridview控件:【下一篇】
【相关文章】
  • VB6数据库编程的一点入门经验
  • 自编的VB6.0调用WinAPI的模块(整合了许多函数和过程)
  • 用VB6写的一个简单俄罗斯方块代码
  • 从dotNet到VB6之模仿构造OleDbDataAdapter与dataset结合
  • VB6.0在PLC与上位机通讯中的应用
  • VB6开发Outlook Add-In
  • System.Reflection.Missing -- Resurrection of the VB6 Missing parameters.
  • Bridge? 一个GIS二次开发中常用的设计模式(在VB6和VB 2005下的实现)
  • 有VB的Trainer吗?VB6或VB.net都行
  • 最近还在用VB6
  • 【随机文章】
  • Fatal error: Call to a member function
  • shell-ch1.文件安全与文件权限
  • C/C++常用的调试宏
  • 调用IE内置打印组件完成web打印方案及例程
  • 安装MS SQL Server 2005的痛苦经历
  • 查看SQL SERVER 加密存储过程,函数,触发器,视图
  • 在linux下架设CS1.5服务器
  • 光接入网络技术
  • A Drag and Drop List Control
  • Automatic Update prompting to download KB890859 again and again?
  • 【相关评论】
    没有相关评论
    【发表评论】
    姓名:
    邮件:
    随机码*
    评论*
          
    |  首 页  |  版权声明  |  联系我们   |  网站地图  |
    CopyRight © 2004-2007 软讯网络 All Rigths Reserved.