Experten gesucht!

[prak01]

Hallo an alle,

bin jetzt schon seit wochen dran eine lösung für mein Problem zu finden und zwar der export von einem bild als bmp in word via vba!

das tool welches dem am nähesten kommt wäre Stephan Lebans: MsWord (word.zip)

funktioniert auch gut doch irgendwas verhaut der bei der "horizontalen bzw vertikalen Auflösung"

ich denke die zwei ausschlaggebenden methoden sind(nicht erschrecken sehr viel code =)):

Public Function EMFToDIB() As Boolean 

    ' Play the Metafile into the DIBSection 

    Dim blRet As Boolean 

    Dim hDCtemp As Long 

    ' Instance of EMF Header structure 

    Dim mh As ENHMETAHEADER 

    ' Current Screen Resolution 

    Dim lngXdpi As Long 

    ' Used to convert Metafile dimensions to pixels 

    Dim sngConvertX As Single 

    Dim sngConvertY As Single 

    ' Pels per meter for Bitmapinfo 

    ' Some apps will read thsi value to determine DPI for 

    ' display purposes 

    Dim PelsX As Long, PelsY As Long 

    ' Image dimensions 

    Dim Width As Long, Height As Long 

    Dim hDCref As Long 

    Dim rc As RECT 


    ' Create a temp Device Context 

    hDCtemp = CreateCompatibleDC(0) 

    ' Get Enhanced Metafile Header 

    lngRet = GetEnhMetaFileHeader(m_hEMF, Len(mh), mh) 

    With mh.rclFrame 

        ' The rclFrame member Specifies the dimensions, 

        ' in .01 millimeter units, of a rectangle that surrounds 

        ' the picture stored in the metafile. 

        ' I'll show this as seperate steps to aid in understanding 

        ' the conversion process. 

        ' Convert to MM 

        sngConvertX = (.Right - .Left) * 0.01 

        sngConvertY = (.Bottom - .Top) * 0.01 

    End With 

    ' Convert to CM 

    sngConvertX = sngConvertX * 0.1 

    sngConvertY = sngConvertY * 0.1 

    ' Convert to Inches 

    sngConvertX = sngConvertX / 2.54 

    sngConvertY = sngConvertY / 2.54 

    ' DC for the enumeration of the EMF records 

    'It must be GetDC not CreateCompatibleDC!!! 

    hDCref = apiGetDC(0) 

    ' See if we can get the original Image dimensions 

    ' From an EMRSTRETCHDIBITS metafile record which 

    ' will exist for any Images that were 

    ' originally Bitmap based.(BMP, Jpeg, Tiff etc.) 

    blRet = EnumEMFGetDimension(m_hEMF, hDCref, Width, Height) 

    ' Always release the DC as soon as possible 

    lngRet = apiReleaseDC(0, hDCref) 

    ' Again if Width = 0 then we are dealing with a plain Metafile 

    ' not a DIB wrapped within a Metafile. 

    ' Get the Dimensions from the Metafile Header. 

    If Width = 0 Then 

        ' Get the Image dimensions directly from the EMH Header 

        Width = mh.rclBounds.Right 

        Height = mh.rclBounds.Bottom 

    End If 

    ' Next we need to check and see which dimension values are 

    ' larger, the EnumEMFGetDimension values or the EMF Header values. 

    ' Use Whichever values are larger. This logic will cover the 

    ' case where we have an origina EMF Image but it happens to 

    ' contain one or more calls to the EMRSTRETCHDIBITS record. 

'    If mh.rclBounds.right > Width Then 

'        Width = mh.rclBounds.Right 

'        Height = mh.rclBounds.Bottom 

'    End If 

    ' The vars sngConvertX and  sngConvertY contain the 

    ' dimensions of the Image in inches. 

    ' We need to convert this to Pixels Per METER. 

    ' First convert to Inches 

    PelsX = Width / sngConvertX 

    PelsY = Height / sngConvertY 

    ' A problem here is that we are too accurate compared to 

    ' the rounding used by Word and Explorer. For instance we might 

    ' arrive at a value of 302 DPI when Word originally loaded the 

    ' Image it was only 300 DPI. 

    ' Let's round to the nearest 100th value. 

    ' If the value is under 120 then leave it alone 

    If PelsX > 120 Then 

        PelsX = PelsX + 5 

        PelsY = PelsY + 5 

        PelsX = PelsX \ 10 

        PelsY = PelsY \ 10 

        PelsX = PelsX * 10 

        PelsY = PelsY * 10 

    End If 

    ' Now convert Inches to Meters 

    PelsX = PelsX * 39.37 

    PelsY = PelsY * 39.37 

    'PelsX = PelsX * 8.24 

    'PelsY = PelsY * 8.24 

    'PelsX = 96 

    'PelsY = 96 

    ' Now create our DIBSECTION 

    Create Width, Height, PelsX, PelsY 

    '"PLAY" the Enhanced Metafile 

    ' back into the Device Context containing the DIBSection 

    rc.Top = 0 

    rc.Left = 0 

    rc.Bottom = m_bmi.bmiHeader.biHeight 

    rc.Right = m_bmi.bmiHeader.biWidth 

    lngRet = apiPlayEnhMetaFile(m_hDC, m_hEMF, rc) 

    ' Success 

    EMFToDIB = True 

End Function 

und :

Public Function SaveEMF(strFname As String) 

    Dim lngRet As Long 

    Dim blRet As Long 

    Dim lLength As Long 

    Dim Width As Long 

    Dim Height As Long 

    Dim hDCEMF As Long 

    Dim hDCref As Long 

    Dim rc As RECT 

    ' local storage for out copy of the EMF Header 

    Dim mh As ENHMETAHEADER 

    ' Vars to calculate resolution 

    Dim sngConvertX As Single 

    Dim sngConvertY As Single 

    Dim ImageWidth As Single 

    Dim ImageHeight As Single 

    Dim Xdpi As Single 

    Dim Ydpi As Single 

    Dim TwipsPerPixelX As Single 

    Dim TwipsPerPixelY As Single 

    Dim sngHORZRES As Single 

    Dim sngVERTRES As Single 

    Dim sngHORZSIZE As Single 

    Dim sngVERTSIZE As Single 


    ' To create our EMF 

    'It must be GetDC not CreateCompatibleDC!!! 

    hDCref = apiGetDC(0) 

    ' See if we can get the original Image dimensions 

    ' From an EMRSTRETCHDIBITS metafile record which 

    ' will exist for any Images that were 

    ' originally Bitmap based.(BMP, Jpeg, Tiff etc.) 

    blRet = EnumEMFGetDimension(m_hEMF, hDCref, Width, Height) 

    ' Again if Width = 0 then we are dealing with a plain Metafile 

    ' not a DIB wrapped within a Metafile. 

    ' Get the Dimensions from the Metafile Header. 

    If Width = 0 Then 

        ' Get Enhanced Metafile Header 

        lngRet = GetEnhMetaFileHeader(m_hEMF, Len(mh), mh) 

        ' It is a plain Metafile we are dealing with 

        ' not a DIB wrapped in a Metafile. 

        ' Get the Dimensions from the Metafile Header 

        Width = mh.rclBounds.Right 

        Height = mh.rclBounds.Bottom 

    End If 

    ' Next we need to check and see which dimension values are 

    ' larger, the EnumEMFGetDimension values or the EMF Header values. 

    ' Use Whichever values are larger. This logic will cover the 

    ' case where we have an origina EMF Image but it happens to 

    ' contain one or more calls to the EMRSTRETCHDIBITS record. 

    If mh.rclBounds.Right > Width Then 

        Width = mh.rclBounds.Right 

        Height = mh.rclBounds.Bottom 

    End If 

    ' Setup 

    ' April 19-2004rc.right = Width 

    'rc.Bottom = Height 

    ImageWidth = Width 

    ImageHeight = Height 

    ' Calculate the current Screen resolution. 

    ' I used to simply use GetDeviceCaps and 

    ' LOGPIXELSY/LOGPIXELSX. Unfortunately this does not yield accurate results 

    ' with Metafiles.  LOGPIXELSY will return the value of 96dpi or 120dpi 

    ' depending on the current Windows setting for Small Fonts or Large Fonts. 

    ' Thanks to Feng Yuan's book "Windows Graphics Programming" for 

    ' explaining the correct method to ascertain screen resolution. 

    ' Let's grab the current size and resolution of our Screen DC. 

    sngHORZRES = apiGetDeviceCaps(hDCref, HORZRES) 

    sngVERTRES = apiGetDeviceCaps(hDCref, VERTRES) 

    sngHORZSIZE = apiGetDeviceCaps(hDCref, HORZSIZE) 

    sngVERTSIZE = apiGetDeviceCaps(hDCref, VERTSIZE) 

    ' Convert millimeters to inches 

    sngConvertX = (sngHORZSIZE * 0.1) / 2.54 

    sngConvertY = (sngVERTSIZE * 0.1) / 2.54 

    ' Convert to DPI 

    sngConvertX = sngHORZRES / sngConvertX 

    sngConvertY = sngVERTRES / sngConvertY 

    Xdpi = sngConvertX 

    Ydpi = sngConvertY 

    ' Calculate TwipsPerPixel 

    TwipsPerPixelX = TWIPSPERINCH / Xdpi 

    TwipsPerPixelY = TWIPSPERINCH / Ydpi 

    ' Convert pixels to TWIPS 

    ImageWidth = ImageWidth * TwipsPerPixelX 

    ImageHeight = ImageHeight * TwipsPerPixelY 

    ' Convert TWIPS to Inches 

    ImageWidth = ImageWidth / 1440 

    ImageHeight = ImageHeight / 1440 

    ' Convert Inches to .01 mm 

    ImageWidth = (ImageWidth * 2.54) * 1000 

    ImageHeight = (ImageHeight * 2.54) * 1000 

    ' Ready to call the Create Metafile API 

    rc.Bottom = ImageHeight 

    rc.Right = ImageWidth 

    rc.Left = 0 

    rc.Top = 0 

    ' Create the Metafile 

    hDCEMF = apiCreateEnhMetaFileRECT(hDCref, strFname, rc, vbNullString) 

    If hDCEMF = 0 Then 

        MsgBox "Could not create Metafile", vbCritical 

        lngRet = apiReleaseDC(0, hDCref) 

        Exit Function 

    End If 

    ' Now play the Memory Metafile into our Disk based Metafile 

    rc.Bottom = Height 

    rc.Right = Width 

    lngRet = apiPlayEnhMetaFile(hDCEMF, m_hEMF, rc) 

    ' Now close the file based EMF 

    lngRet = apiCloseEnhMetaFile(hDCEMF) 

    ' Delete it(not really...it merely releases the ref to it completely. 

    lngRet = apiDeleteEnhMetaFile(lngRet) 

    ' Always release what you get 

    lngRet = apiReleaseDC(0, hDCref) 

End Function

auf den ersten blick funktioniert alles jedoch wenn ich dann versuche mit der methode "ConvertBMPtoJPG" (ImageUtils.dll)

das bmp zu konvertieren verhaut er mir die farben...liegt nat. an den dpi

ich sollte noch dazu sagen das ich alles aus access mache...macht die sache natürlich ein wenig schwieriger!

noch als weiteren tip: wenn ich das exportierte bild(bmp) in ein Bildbearbeitungsprogramm lade und wieder als bmp abspeichere ändern sich die dpi und das Bild wird dann auch richtig konvertiert!

Ist ein größeres projekt und ich bin hier schon am verzweifeln wär net wenn sich das einer von euch profis mal anschauen würde bzw. vielleicht fällt jmd sofort was ein!!

viel dank im voraus

[Thanks-and-Goodbye]

Verschoben in die Programmierecke.