Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

CreateEmf - creating an Enhanced Metafile (EMF) from a bitmap image

Total Hit ( 4410)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 


Click here to copy the following block
' This routine demonstrates how to create an Enhanced Metafile (EMF) from a
' bitmap image, contained in a PictureBox.
' You must use a PictureBox control, since the Image control doesn't support
' the hDC property, needed to create the image file.
' Draw a PictureBox on a form, and insert a supported image like Bmp,
' Jpg or Gif. Don't use a WMF or EMF image. Useful for imaging apps that need
' to save images to different formats than Bitmap.


' ========== API DECLARATIONS ==========

'Bitmap properties structure
Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type


'Rectagle structure, needed to "build" the EMF
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


'API Functions for drawing graphics
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As _
  Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
  ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
  ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
  ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
  ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As _
  Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal _
  hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
  ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
  ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
  ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
  ByVal dwRop As Long) As Long

'API Functions for creating metafiles
Private Declare Function CreateEnhMetaFile Lib "gdi32" Alias _
  "CreateEnhMetaFileA" (ByVal hdcRef As Long, ByVal lpFileName As String, _
  lpRect As RECT, ByVal lpDescription As String) As Long
Private Declare Function CloseEnhMetaFile Lib "gdi32" (ByVal hdc As Long) As _
  Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As _
  Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, _
  ByVal nMapMode As Long) As Long


'This Enum is needed to set the "Mapping" property for EMF images
Public Enum MMETRIC
    MM_HIMETRIC = 3
    MM_LOMETRIC = 2
    MM_LOENGLISH = 4
    MM_ISOTROPIC = 7
    MM_HIENGLISH = 5
    MM_ANISOTROPIC = 8
    MM_ADLIB = 9
End Enum

' ==========================================

' This function creates an EMF image.
' Parameters:
'  SourceImage: Must be a picturebox
'  FileName: full pathname for Enhanced Metafile on disk
'  Metrics: a value from MMETRIC Enum
'  Comments (optional): You can add your own comments to an Enhanced Metafile
'
' Example:
'  Dim RetVal As Long
'  ' The best way for creating an EMF image is to use the MM_ADLIB mapping mode
'  RetVal = CreateEmf(Picture1, "image1.emf", MM_ADLIB,
' "Enhanced Metafile Demonstration Usage")

Public Function CreateEmf(ByRef SourceImage As Object, ByVal FileName As String, _
  ByVal Metrics As MMETRIC, Optional ByVal Comments As String) As Long
  'Variables and types
  Dim bm As BITMAP
  Dim hdcMem As Long   'Temporary Compatible Device Context


  Dim hdc As Long     'EMF Device Context
  Dim hEmf As Long    'Will get the returned value by CloseEnhMetafile API
  Dim R As RECT      'A rectangle that will enclose the EMF image
  Dim OldScale As Integer 'Used to maintain Picturebox ScaleMode property
  Dim HoldBitmap As Long 'Keeps the bitmap onto memory
  
  Comments = Comments & vbNullChar 'You can add comments to Metafiles. A NULL
                   ' char is needed
  
  GetObject SourceImage, Len(bm), bm 'Reads image properties and puts them
                    ' in a Bitmap structure
  
  R.Top = SourceImage.Top       'Creates a rectangle using bitmap
                    ' properties
  R.Left = SourceImage.Left
  R.Right = SourceImage.Picture.Width
  R.Bottom = SourceImage.Picture.Height
  
  'Sets the Picturebox Scalemode properties to Pixels.
  OldScale = SourceImage.ScaleMode
  SourceImage.ScaleMode = vbPixels
  
  'Creates the metafile to disk reading the picturebox device context thru
  ' the GetDC Api
  'FileName is a string containing the full pathname for the image
  'R is the rectangle structure as shown before
  'Some comments are added.
  hdc = CreateEnhMetaFile(SourceImage.hdc, FileName, R, Comments)
  
  '...sets the mapping property
  SetMapMode hdc, Metrics
    
  'Since Bitmap and Metafile are different, a new compatible device context
  ' must be created
  'with a reference to the EMF device context
  hdcMem = CreateCompatibleDC(hdc)
  
  'Takes the bitmap....
  HoldBitmap = SelectObject(hdcMem, SourceImage)
  
  '...and copies first to intermediate device context reading data from the
  ' bitmap
  BitBlt hdcMem, 0, 0, SourceImage.ScaleWidth, SourceImage.ScaleHeight, _
    SourceImage.hdc, 0, 0, vbSrcCopy
  'and then to the EMF device context
  BitBlt hdc, 0, 0, SourceImage.ScaleWidth, SourceImage.ScaleHeight, hdcMem, _
    0, 0, vbSrcCopy
  
  'Reassigns bitmap previous value to DC before deleting
  SelectObject hdcMem, HoldBitmap
  'Next step is disposing objects
  DeleteDC (hdcMem)
  DeleteObject SelectObject(hdcMem, SourceImage)

  'Closes the new metafile
  hEmf = CloseEnhMetaFile(hdc)
  
  If DeleteEnhMetaFile(hEmf) = 1 Then
                  CreateEmf = 0  'No errors
                  Else
                  CreateEmf = 1  'If an error occurred,
                          ' returns 1
  End If
  
  'sets the PictureBox Scalemode property to the previous mode
  SourceImage.ScaleMode = OldScale
  
End Function


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.