[Resolvido]Erro de Compilação: Tipos Incompatíveis.

Pessoal, bom dia.
Podem me dar um ajudinha nesse erro.

Erro de Compilação: Tipos Incompatíveis.
Office 2016 64 bits.

Segue o codigo:


Public Function LoadImage(ByVal strFName As String) As IPictureDisp

#If Win64 Then

Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As LongPtr
Dim hGdiImage As LongPtr
Dim hBitmap As LongPtr

#Else

Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long

#End If

'http://msdn.microsoft.com/en-us/library/ee691831(v=office.14).aspx


'LongPtr

uGdiInput.GdiplusVersion = 1

If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If

End Function

Public Function ConvertToIPicture(ByVal hPic As Long) As IPictureDisp
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1

With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With

With uPicInfo
.Size = Len(uPicInfo)
.type = PICTYPE_BITMAP
.hPic = hPic
.hpal = 0
End With

OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set ConvertToIPicture = IPic

End Function




Sd

Oliveira

Código:

Option Compare Database
Option Explicit

#If Win64 Then '================ WINDOWS 64 BITS ===================

Private Declare PtrSafe Function GdiplusStartup Lib "gdiplus" (TOKEN As LongLong, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongLong = 0) As Long
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As LongLong, BITMAP As LongPtr) As Long
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongLong) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "gdiplus" (ByVal Image As LongPtr) As Long
Private Declare PtrSafe Function GdiplusShutdown Lib "gdiplus" (ByVal TOKEN As LongLong) As LongLong
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPictureDisp) As Long

Public Type GUID
    DATA1 As Long
    DATA2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type PICTDESC
    cbSizeOfStruct As Long
    PicType As Long
    hImage As LongPtr
    xExt As Long
    yExt As Long
End Type

Private Type GdiplusStartupInput
    GdiplusVersion              As LongLong
    DebugEventCallback          As LongLong
    SuppressBackgroundThread    As LongLong
    SuppressExternalCodecs      As LongLong
End Type

Public Function LoadImage(ByVal strFName As String) As IPictureDisp
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As LongLong
Dim hGdiImage As LongLong
Dim hBitmap As LongLong

uGdiInput.GdiplusVersion = 1
   
    If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
        If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
            GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
            Set LoadImage = ConvertToIPicture(hBitmap)
            GdipDisposeImage hGdiImage
        End If
        GdiplusShutdown hGdiPlus
    End If

End Function

Public Function ConvertToIPicture(ByVal hPic As LongLong) As IPictureDisp

    Dim uPicInfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim IPic As IPictureDisp

    Const PICTYPE_BITMAP = 1

    With IID_IDispatch
        .DATA1 = &H7BF80980
        .DATA2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

   
        With uPicInfo
            'If bIsIcon Then
                '.cbSizeOfStruct = 16
                '.PicType = 3    'PicType Icon
          ' Else
                .cbSizeOfStruct = Len(uPicInfo)
                .PicType = 1    'PicType Bitmap
            'End If
            .hImage = hPic 'hBmp
        End With

    OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic

    Set ConvertToIPicture = IPic
End Function

#Else '=================== WINDOWS 32 BITS ========================
Private Declare Function GdiplusStartup Lib "gdiplus" (TOKEN As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As Long, BITMAP As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal BITMAP As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal TOKEN As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Private Type GUID
    DATA1          As Long
    DATA2          As Integer
    Data3          As Integer
    Data4(0 To 7)  As Byte
End Type

Private Type PICTDESC
    Size  As Long
    type  As Long
    hPic  As Long
    hpal  As Long
End Type

Private Type GdiplusStartupInput
    GdiplusVersion              As Long
    DebugEventCallback          As Long
    SuppressBackgroundThread    As Long
    SuppressExternalCodecs      As Long
End Type

Public Function LoadImage(ByVal strFName As String) As IPictureDisp
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long

uGdiInput.GdiplusVersion = 1
   
    If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
        If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
            GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
            Set LoadImage = ConvertToIPicture(hBitmap)
            GdipDisposeImage hGdiImage
        End If
        GdiplusShutdown hGdiPlus
    End If

End Function

Public Function ConvertToIPicture(ByVal hPic As Long) As IPictureDisp

    Dim uPicInfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim IPic As IPicture

    Const PICTYPE_BITMAP = 1

    With IID_IDispatch
        .DATA1 = &H7BF80980
        .DATA2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

    With uPicInfo
        .Size = Len(uPicInfo)
        .type = PICTYPE_BITMAP
        .hPic = hPic
        .hpal = 0
    End With

    OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic

    Set ConvertToIPicture = IPic
End Function

#End If

Boa Noite,

Obrigado Uilson.

Sd

Oliveira

Obrigado pelo retorno...