VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "dwMetaFile"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' Class dwMetaFile
' Metafile object control and configuration class
' Copyright (c) 1996 by Desaware Inc.
' Part of the Desaware API Classes Library

#If Win32 Then
Private hInternalMFile As Long
#Else
Private hInternalMFile As Integer
#End If

Private bIsEnhanced As Boolean

#If Win32 Then
Private Declare Function apiDeleteEnhMetaFile& Lib "gdi32" Alias "DeleteEnhMetaFile" (ByVal hemf As Long)
Private Declare Function apiDeleteMetaFile& Lib "gdi32" Alias "DeleteMetaFile" (ByVal hMF As Long)
Private Declare Function apiGetEnhMetaFileBits& Lib "gdi32" Alias "GetEnhMetaFileBits" (ByVal hemf As Long, ByVal cbBuffer As Long, lpbBuffer As Byte)
Private Declare Function apiGetEnhMetaFileBitsByAddr& Lib "gdi32" Alias "GetEnhMetaFileBits" (ByVal hemf As Long, ByVal cbBuffer As Long, ByVal lpbBuffer As Long)
Private Declare Function apiGetEnhMetaFileDescription& Lib "gdi32" Alias "GetEnhMetaFileDescriptionA" (ByVal hemf As Long, ByVal cchBuffer As Long, ByVal lpszDescription As String)
Private Declare Function apiGetMetaFileBitsEx& Lib "gdi32" Alias "GetMetaFileBitsEx" (ByVal hMF As Long, ByVal nSize As Long, lpvData As Byte)
Private Declare Function apiGetMetaFileBitsExByAddr& Lib "gdi32" Alias "GetMetaFileBitsEx" (ByVal hMF As Long, ByVal nSize As Long, ByVal lpvData As Long)
#Else
Private Declare Function apiDeleteMetaFile% Lib "gdi" Alias "DeleteMetaFile" (ByVal hMF As Integer)
Private Declare Function apiGetMetaFileBits% Lib "gdi" Alias "GetMetaFileBits" (ByVal hMF As Integer)
#End If 'WIN32


Public Property Get hMetaFile() As Long
    hMetaFile = hInternalMFile
End Property

Private Sub RaiseMFError(Optional errval)
    Dim useerr%
    If IsMissing(errval) Then
        RaiseError DWERR_APIRESULT, "dwMetaFile"
    Else
        RaiseError errval, "dwMetaFile"
    End If
End Sub

Public Sub InitializeMetafile(ByVal hNewMFile, IsEnh As Boolean)
    hInternalMFile = hNewMFile
    bIsEnhanced = IsEnh
End Sub

Public Sub DeleteMetafile()
Attribute DeleteMetafile.VB_HelpID = 2520
Attribute DeleteMetafile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim dl&
 
    If bIsEnhanced = True Then
        dl& = apiDeleteEnhMetaFile(hInternalMFile)
    Else
        dl& = apiDeleteMetaFile(hInternalMFile)
    End If
 
    If dl = 0 Then RaiseMFError
    hInternalMFile = 0
#Else
    Dim dl&
 
    dl& = apiDeleteMetaFile(hInternalMFile)
    If dl = 0 Then RaiseMFError
    hInternalMFile = 0
#End If
End Sub

Public Sub DeleteEnhMetafile()
Attribute DeleteEnhMetafile.VB_HelpID = 2642
Attribute DeleteEnhMetafile.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim dl&
    
    If bIsEnhanced = True Then
        dl& = apiDeleteEnhMetaFile(hInternalMFile)
    Else
        dl& = apiDeleteMetaFile(hInternalMFile)
    End If
 
    If dl = 0 Then RaiseMFError
#End If
End Sub

Public Sub GetEnhMetafileBits(lpBits() As Byte)
Attribute GetEnhMetafileBits.VB_HelpID = 2646
Attribute GetEnhMetafileBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim length As Long
    Dim ret&
    
    length = UBound(lpBits) - 1
    ret& = apiGetEnhMetaFileBitsByAddr&(hInternalMFile, length, lpBits(0))
    If ret& = 0 Then RaiseMFError
#End If
End Sub

Public Sub GetEnhMetafileBitsByAddr(ByVal nSize As Long, lAddress As Long)
#If Win32 Then
    Dim ret&
    
    ret& = apiGetEnhMetaFileBitsByAddr&(hInternalMFile, nSize, lAddress)
    If ret& = 0 Then RaiseMFError
#End If
End Sub

#If Win32 Then
' Before using this function, set the lpBits array to the length you
' need (you can use GetMetafileBitsSize to get that information).
Public Sub GetMetafileBits(lpBits() As Byte)
Attribute GetMetafileBits.VB_HelpID = 2557
Attribute GetMetafileBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim length As Long
    Dim ret&
    
    length = UBound(lpBits) - 1
    ret& = apiGetMetaFileBitsExByAddr&(hInternalMFile, length, lpBits(0))
    If ret& = 0 Then RaiseMFError
End Sub
#Else
Public Function GetMetafileBits() As dwGlobalMemory
    Dim ret%
    Dim newGMem As New dwGlobalMemory
    
    ret% = apiGetMetaFileBits(hInternalMFile)
    If ret% = 0 Then RaiseMFError
    newGMem.InitializeGlobalMem ret%
    Set GetMetafileBits = newGMem
End Function
#End If

Public Sub GetMetafileBitsByAddr(ByVal nSize, ByVal lAddress As Long)
#If Win32 Then
    Dim ret&
    
    ret& = apiGetMetaFileBitsExByAddr&(hInternalMFile, CLng(nSize), lAddress)
    If ret& = 0 Then RaiseMFError
#End If
End Sub

Public Function GetEnhMetafileBitsSize() As Long
#If Win32 Then
    Dim ret&
    
    ret& = apiGetEnhMetaFileBitsByAddr&(hInternalMFile, 0, ByVal 0)
    If ret& = 0 Then RaiseMFError
    GetEnhMetafileBitsSize = ret&
#End If
End Function

Public Function GetMetafileBitsSize() As Long
#If Win32 Then
    Dim ret&
    
    ret& = apiGetMetaFileBitsExByAddr&(hInternalMFile, 0, ByVal 0)
    If ret& = 0 Then RaiseMFError
    GetMetafileBitsSize = ret&
#Else
    RaiseMFError DWERR_NOTINWIN16
#End If
End Function

Public Function GetEnhMetaFileDescription() As String
Attribute GetEnhMetaFileDescription.VB_HelpID = 2647
Attribute GetEnhMetaFileDescription.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim ret&
    Dim sDesc$
    
    ret& = apiGetEnhMetaFileDescription(hInternalMFile, 0, vbNullString)
    If ret& = 0 Then RaiseMFError
    sDesc$ = String$(ret&, 0)
    ret& = apiGetEnhMetaFileDescription(hInternalMFile, ret&, sDesc$)
    If ret& = 0 Then RaiseMFError
    GetEnhMetaFileDescription = sDesc$
#End If
End Function
