MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

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

    avatar
    oliveiraferraz
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 82
    Registrado : 26/09/2012

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

    Mensagem  oliveiraferraz 7/7/2020, 14:54

    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
    Uilson Brasil
    Uilson Brasil
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1039
    Registrado : 23/04/2013

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

    Mensagem  Uilson Brasil 8/7/2020, 01:05

    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


    .................................................................................
    ::: Uilson Brasil
    ::: Design in Microsoft Access
    avatar
    oliveiraferraz
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 82
    Registrado : 26/09/2012

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

    Mensagem  oliveiraferraz 8/7/2020, 22:35

    Boa Noite,

    Obrigado Uilson.

    Sd

    Oliveira


    Uilson Brasil
    Uilson Brasil
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1039
    Registrado : 23/04/2013

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

    Mensagem  Uilson Brasil 9/7/2020, 21:39

    Obrigado pelo retorno...


    .................................................................................
    ::: Uilson Brasil
    ::: Design in Microsoft Access

    Conteúdo patrocinado


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

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 29/3/2024, 01:40