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

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

' 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 structurePrivate Type BITMAP    bmType As Long   bmWidth As Long   bmHeight As Long   bmWidthBytes As Long   bmPlanes As Integer   bmBitsPixel As Integer   bmBits As LongEnd Type'Rectagle structure, needed to "build" the EMFPrivate Type RECT        Left As Long        Top As Long        Right As Long        Bottom As LongEnd Type'API Functions for drawing graphicsPrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As _    LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _    ByVal hObject As Long) As LongPrivate 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 LongPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As _    LongPrivate Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal _    hObject As Long, ByVal nCount As Long, lpObject As Any) As LongPrivate 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 metafilesPrivate Declare Function CreateEnhMetaFile Lib "gdi32" Alias _    "CreateEnhMetaFileA" (ByVal hdcRef As Long, ByVal lpFileName As String, _    lpRect As RECT, ByVal lpDescription As String) As LongPrivate Declare Function CloseEnhMetaFile Lib "gdi32" (ByVal hdc As Long) As _    LongPrivate Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As _    LongPrivate 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 imagesPublic Enum MMETRIC        MM_HIMETRIC = 3        MM_LOMETRIC = 2        MM_LOENGLISH = 4        MM_ISOTROPIC = 7        MM_HIENGLISH = 5        MM_ANISOTROPIC = 8        MM_ADLIB = 9End 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

Share the Post:
XDR solutions

The Benefits of Using XDR Solutions

Cybercriminals constantly adapt their strategies, developing newer, more powerful, and intelligent ways to attack your network. Since security professionals must innovate as well, more conventional endpoint detection solutions have evolved

AI is revolutionizing fraud detection

How AI is Revolutionizing Fraud Detection

Artificial intelligence – commonly known as AI – means a form of technology with multiple uses. As a result, it has become extremely valuable to a number of businesses across

AI innovation

Companies Leading AI Innovation in 2023

Artificial intelligence (AI) has been transforming industries and revolutionizing business operations. AI’s potential to enhance efficiency and productivity has become crucial to many businesses. As we move into 2023, several

data fivetran pricing

Fivetran Pricing Explained

One of the biggest trends of the 21st century is the massive surge in analytics. Analytics is the process of utilizing data to drive future decision-making. With so much of

kubernetes logging

Kubernetes Logging: What You Need to Know

Kubernetes from Google is one of the most popular open-source and free container management solutions made to make managing and deploying applications easier. It has a solid architecture that makes

ransomware cyber attack

Why Is Ransomware Such a Major Threat?

One of the most significant cyber threats faced by modern organizations is a ransomware attack. Ransomware attacks have grown in both sophistication and frequency over the past few years, forcing

data dictionary

Tools You Need to Make a Data Dictionary

Data dictionaries are crucial for organizations of all sizes that deal with large amounts of data. they are centralized repositories of all the data in organizations, including metadata such as