home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / classlib / desaware / dwmetafl.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  5.9 KB  |  187 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwMetaFile"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. ' Class dwMetaFile
  11. ' Metafile object control and configuration class
  12. ' Copyright (c) 1996 by Desaware Inc.
  13. ' Part of the Desaware API Classes Library
  14.  
  15. #If Win32 Then
  16. Private hInternalMFile As Long
  17. #Else
  18. Private hInternalMFile As Integer
  19. #End If
  20.  
  21. Private bIsEnhanced As Boolean
  22.  
  23. #If Win32 Then
  24. Private Declare Function apiDeleteEnhMetaFile& Lib "gdi32" Alias "DeleteEnhMetaFile" (ByVal hemf As Long)
  25. Private Declare Function apiDeleteMetaFile& Lib "gdi32" Alias "DeleteMetaFile" (ByVal hMF As Long)
  26. Private Declare Function apiGetEnhMetaFileBits& Lib "gdi32" Alias "GetEnhMetaFileBits" (ByVal hemf As Long, ByVal cbBuffer As Long, lpbBuffer As Byte)
  27. Private Declare Function apiGetEnhMetaFileBitsByAddr& Lib "gdi32" Alias "GetEnhMetaFileBits" (ByVal hemf As Long, ByVal cbBuffer As Long, ByVal lpbBuffer As Long)
  28. Private Declare Function apiGetEnhMetaFileDescription& Lib "gdi32" Alias "GetEnhMetaFileDescriptionA" (ByVal hemf As Long, ByVal cchBuffer As Long, ByVal lpszDescription As String)
  29. Private Declare Function apiGetMetaFileBitsEx& Lib "gdi32" Alias "GetMetaFileBitsEx" (ByVal hMF As Long, ByVal nSize As Long, lpvData As Byte)
  30. Private Declare Function apiGetMetaFileBitsExByAddr& Lib "gdi32" Alias "GetMetaFileBitsEx" (ByVal hMF As Long, ByVal nSize As Long, ByVal lpvData As Long)
  31. #Else
  32. Private Declare Function apiDeleteMetaFile% Lib "gdi" Alias "DeleteMetaFile" (ByVal hMF As Integer)
  33. Private Declare Function apiGetMetaFileBits% Lib "gdi" Alias "GetMetaFileBits" (ByVal hMF As Integer)
  34. #End If 'WIN32
  35.  
  36.  
  37. Public Property Get hMetaFile() As Long
  38.     hMetaFile = hInternalMFile
  39. End Property
  40.  
  41. Private Sub RaiseMFError(Optional errval)
  42.     Dim useerr%
  43.     If IsMissing(errval) Then
  44.         RaiseError DWERR_APIRESULT, "dwMetaFile"
  45.     Else
  46.         RaiseError errval, "dwMetaFile"
  47.     End If
  48. End Sub
  49.  
  50. Public Sub InitializeMetafile(ByVal hNewMFile, IsEnh As Boolean)
  51.     hInternalMFile = hNewMFile
  52.     bIsEnhanced = IsEnh
  53. End Sub
  54.  
  55. Public Sub DeleteMetafile()
  56. Attribute DeleteMetafile.VB_HelpID = 2520
  57. Attribute DeleteMetafile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  58. #If Win32 Then
  59.     Dim dl&
  60.  
  61.     If bIsEnhanced = True Then
  62.         dl& = apiDeleteEnhMetaFile(hInternalMFile)
  63.     Else
  64.         dl& = apiDeleteMetaFile(hInternalMFile)
  65.     End If
  66.  
  67.     If dl = 0 Then RaiseMFError
  68.     hInternalMFile = 0
  69. #Else
  70.     Dim dl&
  71.  
  72.     dl& = apiDeleteMetaFile(hInternalMFile)
  73.     If dl = 0 Then RaiseMFError
  74.     hInternalMFile = 0
  75. #End If
  76. End Sub
  77.  
  78. Public Sub DeleteEnhMetafile()
  79. Attribute DeleteEnhMetafile.VB_HelpID = 2642
  80. Attribute DeleteEnhMetafile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  81. #If Win32 Then
  82.     Dim dl&
  83.     
  84.     If bIsEnhanced = True Then
  85.         dl& = apiDeleteEnhMetaFile(hInternalMFile)
  86.     Else
  87.         dl& = apiDeleteMetaFile(hInternalMFile)
  88.     End If
  89.  
  90.     If dl = 0 Then RaiseMFError
  91. #End If
  92. End Sub
  93.  
  94. Public Sub GetEnhMetafileBits(lpBits() As Byte)
  95. Attribute GetEnhMetafileBits.VB_HelpID = 2646
  96. Attribute GetEnhMetafileBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  97. #If Win32 Then
  98.     Dim length As Long
  99.     Dim ret&
  100.     
  101.     length = UBound(lpBits) - 1
  102.     ret& = apiGetEnhMetaFileBitsByAddr&(hInternalMFile, length, lpBits(0))
  103.     If ret& = 0 Then RaiseMFError
  104. #End If
  105. End Sub
  106.  
  107. Public Sub GetEnhMetafileBitsByAddr(ByVal nSize As Long, lAddress As Long)
  108. #If Win32 Then
  109.     Dim ret&
  110.     
  111.     ret& = apiGetEnhMetaFileBitsByAddr&(hInternalMFile, nSize, lAddress)
  112.     If ret& = 0 Then RaiseMFError
  113. #End If
  114. End Sub
  115.  
  116. #If Win32 Then
  117. ' Before using this function, set the lpBits array to the length you
  118. ' need (you can use GetMetafileBitsSize to get that information).
  119. Public Sub GetMetafileBits(lpBits() As Byte)
  120. Attribute GetMetafileBits.VB_HelpID = 2557
  121. Attribute GetMetafileBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  122.     Dim length As Long
  123.     Dim ret&
  124.     
  125.     length = UBound(lpBits) - 1
  126.     ret& = apiGetMetaFileBitsExByAddr&(hInternalMFile, length, lpBits(0))
  127.     If ret& = 0 Then RaiseMFError
  128. End Sub
  129. #Else
  130. Public Function GetMetafileBits() As dwGlobalMemory
  131.     Dim ret%
  132.     Dim newGMem As New dwGlobalMemory
  133.     
  134.     ret% = apiGetMetaFileBits(hInternalMFile)
  135.     If ret% = 0 Then RaiseMFError
  136.     newGMem.InitializeGlobalMem ret%
  137.     Set GetMetafileBits = newGMem
  138. End Function
  139. #End If
  140.  
  141. Public Sub GetMetafileBitsByAddr(ByVal nSize, ByVal lAddress As Long)
  142. #If Win32 Then
  143.     Dim ret&
  144.     
  145.     ret& = apiGetMetaFileBitsExByAddr&(hInternalMFile, CLng(nSize), lAddress)
  146.     If ret& = 0 Then RaiseMFError
  147. #End If
  148. End Sub
  149.  
  150. Public Function GetEnhMetafileBitsSize() As Long
  151. #If Win32 Then
  152.     Dim ret&
  153.     
  154.     ret& = apiGetEnhMetaFileBitsByAddr&(hInternalMFile, 0, ByVal 0)
  155.     If ret& = 0 Then RaiseMFError
  156.     GetEnhMetafileBitsSize = ret&
  157. #End If
  158. End Function
  159.  
  160. Public Function GetMetafileBitsSize() As Long
  161. #If Win32 Then
  162.     Dim ret&
  163.     
  164.     ret& = apiGetMetaFileBitsExByAddr&(hInternalMFile, 0, ByVal 0)
  165.     If ret& = 0 Then RaiseMFError
  166.     GetMetafileBitsSize = ret&
  167. #Else
  168.     RaiseMFError DWERR_NOTINWIN16
  169. #End If
  170. End Function
  171.  
  172. Public Function GetEnhMetaFileDescription() As String
  173. Attribute GetEnhMetaFileDescription.VB_HelpID = 2647
  174. Attribute GetEnhMetaFileDescription.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  175. #If Win32 Then
  176.     Dim ret&
  177.     Dim sDesc$
  178.     
  179.     ret& = apiGetEnhMetaFileDescription(hInternalMFile, 0, vbNullString)
  180.     If ret& = 0 Then RaiseMFError
  181.     sDesc$ = String$(ret&, 0)
  182.     ret& = apiGetEnhMetaFileDescription(hInternalMFile, ret&, sDesc$)
  183.     If ret& = 0 Then RaiseMFError
  184.     GetEnhMetaFileDescription = sDesc$
  185. #End If
  186. End Function
  187.