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

    [Resolvido]Duvida com código para inserir imagem em richtextbox

    lupe
    lupe
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 460
    Registrado : 15/07/2010

    [Resolvido]Duvida com código para inserir imagem em richtextbox Empty [Resolvido]Duvida com código para inserir imagem em richtextbox

    Mensagem  lupe 17/12/2011, 19:06

    Olá amigos!

    Encontrei na net um código que tem a finalidade de inserir uma imagem em um controle RichTextBox sem o auxilio do controle CommonDialog, porém, não sei como chamar a função do código.

    Caso alguém saiba como fazer para executar a função ao clicar em um botão, por gentileza, me informe. Ficarei muito grato.

    Segue o código:

    'Inserts the picture at the current insertion point
    Public Function InsertPicture(RTB As RichTextBox, pic As StdPicture)
    Dim strRTFall As String
    Dim lStart As Long
    With RTB
    .SelText = Chr(&H9D) & .SelText & Chr(&H81)
    strRTFall = .TextRTF
    strRTFall = Replace(strRTFall, "\'9d", PictureToRTF(pic))
    .TextRTF = strRTFall
    'position cursor past new insertion
    lStart = .Find(Chr(&H81))
    strRTFall = Replace(strRTFall, "\'81", "")
    .TextRTF = strRTFall
    .SelStart = lStart
    End With
    End Function

    Aqui é a rotina que converte a imagem em um RTF:

    'returns the RTF string representation of our picture
    Public Function PictureToRTF(pic As StdPicture) As String
    Dim hMetaDC As Long, hMeta As Long, hPicDC As Long, hOldBmp As Long
    Dim Bmp As BITMAP, Sz As Size, Pt As POINTAPI
    Dim sTempFile As String, screenDC As Long
    Dim headerStr As String, retStr As String, byteStr As String
    Dim ByteArr() As Byte, nBytes As Long
    Dim fn As Long, i As Long, j As Long

    sTempFile = App.Path & "\~pic" & ((Rnd * 1000000) + 1000000) \ 1 & ".tmp" 'some temprory file
    If Dir(sTempFile) <> "" Then Kill sTempFile

    'Create a metafile which is a collection of structures that store a
    'picture in a device-independent format.
    hMetaDC = CreateMetaFile(sTempFile)

    'set size of Metafile window
    SetMapMode hMetaDC, MM_ANISOTROPIC
    SetWindowOrgEx hMetaDC, 0, 0, Pt
    GetObject pic.Handle, Len(Bmp), Bmp
    SetWindowExtEx hMetaDC, Bmp.Width, Bmp.Height, Sz
    'save sate for later retrieval
    SaveDC hMetaDC

    'get DC compatible to screen
    screenDC = GetDC(0)
    hPicDC = CreateCompatibleDC(screenDC)
    ReleaseDC 0, screenDC

    'set out picture as new DC picture
    hOldBmp = SelectObject(hPicDC, pic.Handle)

    'copy our picture to metafile
    BitBlt hMetaDC, 0, 0, Bmp.Width, Bmp.Height, hPicDC, 0, 0, vbSrcCopy

    'cleanup - close metafile
    SelectObject hPicDC, hOldBmp
    DeleteDC hPicDC
    DeleteObject hOldBmp
    'retrieve saved state
    RestoreDC hMetaDC, True
    hMeta = CloseMetaFile(hMetaDC)
    DeleteMetaFile hMeta

    'header to string we want to insert
    headerStr = "{\pict\wmetafile8" & _
    "\picw" & pic.Width & "\pich" & pic.Height & _
    "\picwgoal" & Bmp.Width * Screen.TwipsPerPixelX & _
    "\pichgoal" & Bmp.Height * Screen.TwipsPerPixelY & _
    ""

    'read metafile from disk into byte array
    nBytes = FileLen(sTempFile)
    ReDim ByteArr(1 To nBytes)
    fn = FreeFile()
    Open sTempFile For Binary Access Read As #fn
    Get #fn, , ByteArr
    Close #fn
    Dim nlines As Long

    'turn each byte into two char hex value
    i = 0
    byteStr = ""
    Do
    byteStr = byteStr & vbCrLf
    For j = 1 To 39
    i = i + 1
    If i > nBytes Then Exit For
    byteStr = byteStr & Hex00(ByteArr(i))
    Next j
    Loop While i < nBytes

    'string we will be inserting
    retStr = headerStr & LCase(byteStr) & vbCrLf & "}"
    PictureToRTF = retStr

    'remove temp metafile
    Kill sTempFile

    End Function

    'adds leading zero to hex value if needed.
    Public Function Hex00(icolor As Byte) As String
    Hex00 = Right("0" & Hex(icolor), 2)
    End Function


    Desde já, obrigado!
    avatar
    Convidad
    Convidado


    [Resolvido]Duvida com código para inserir imagem em richtextbox Empty Re: [Resolvido]Duvida com código para inserir imagem em richtextbox

    Mensagem  Convidad 17/12/2011, 19:35

    Olá

    O código parece ser para inserir a figura no local do foco, então não sei se dará certo com botão.
    A nome da função pública é InsertPicture. Para chamá-la, basta digitar seu nome.

    Então pode tentar isto:

    Private Sub SeuControleBotão_Click()
    Call InsertPicture
    End Sub
    lupe
    lupe
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 460
    Registrado : 15/07/2010

    [Resolvido]Duvida com código para inserir imagem em richtextbox Empty Re: [Resolvido]Duvida com código para inserir imagem em richtextbox

    Mensagem  lupe 17/12/2011, 19:42

    norbs,

    obrigado pela atenção!

    Deu erro ao clicar:

    "Erro de compilação:
    O argumento não é opcional."
    avatar
    Convidad
    Convidado


    [Resolvido]Duvida com código para inserir imagem em richtextbox Empty Re: [Resolvido]Duvida com código para inserir imagem em richtextbox

    Mensagem  Convidad 17/12/2011, 19:56

    Certo,
    então é preciso passar uma valor para a função, como InsertPicture("AlgumaCoisa")...
    Se possível, vou dar uma estudada na função.
    lupe
    lupe
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 460
    Registrado : 15/07/2010

    [Resolvido]Duvida com código para inserir imagem em richtextbox Empty Re: [Resolvido]Duvida com código para inserir imagem em richtextbox

    Mensagem  lupe 17/12/2011, 20:01

    Ok norbs!

    Eu também vou quebrar um pouco mais a cabeça pra tentar chegar à solução. Caso eu chegue primeiro a uma resposta, reporto com a mesma.


    Abraço!
    lupe
    lupe
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 460
    Registrado : 15/07/2010

    [Resolvido]Duvida com código para inserir imagem em richtextbox Empty Re: [Resolvido]Duvida com código para inserir imagem em richtextbox

    Mensagem  lupe 19/12/2011, 19:33

    Alguém sabe uma forma mais simples de inserir imagens em um controle RichTextBox sem o auxilio do CommonDialog?


      Data/hora atual: 28/11/2022, 01:50