RichTextBox Tricks and Tips

[Merri]

Post updated!
Code in post #125 runs slower because it has a small bug: the header string is not separated by space from the image data. After adding a space character the image appears and you'll see it is much faster.

This is my final contribution regarding this function: a massively optimized version. I've removed any API calls that had no real effect or which could be replaced with some simple math. The safe array trick that was in the earlier version of this post has been simplified as well and I now use a Long array for all data processing. Also, a very important change is that I've removed file creation on the disk and the metafile is in memory only! So this should be "the" function for adding images to a RTB. The only change that I can think of is to switch to enhanced metafile format instead of using the very old 16-bit Windows metafile format.

'returns the RTF string representation of our picture
Public Function PictureToRTF(pic As StdPicture) As String
' faster version by Merri 2010-08-10
    Static hx(0 To 255) As Long
    Dim A() As Long, AH(0 To 5) As Long, AP As Long, j As Long
    Dim Meta() As Byte, MetaSize As Long
    Dim lngMetaDC As Long, lngMetaFile As Long, lngOld As Long, lngPicDC As Long, lngScreenDC As Long
    Dim strHeader As String, strFooter As String
    Dim lngHeight As Long, lngWidth As Long
    Dim udtSZ As Size
    ' calculate byte to hex characters converter only once
    If m_Hex(0) = 0 Then
        ' lower case hex notation... characters 0123456789
        For j = 0 To 9: hx(j) = &H30 + j: hx(j * 16) = hx(j): Next
        ' lower case hex notation... characters abcdef
        For j = 0 To 5: hx(j + 10) = &H61 + j: hx((j + 10) * 16) = hx(j + 10): Next
        ' m_Hex is local to the module
        For j = 0 To 255
            ' lower 16 bits contain the hex character for higher 4 bits, higher 16 bits contain the lower 4 bits
            m_Hex(j) = (hx(j And &HF&) * &H10000) Or (hx(j And &HF0&))
        Next j
    End If
    ' start our safe array hacks... create a Long safe array header
    AH(0) = 1: AH(1) = 4: AH(4) = &H3FFFFFFF
    ' a Long array is useful because you can avoid making any further PutMem4/GetMem4 calls, thus improving performance
    AP = ArrPtr(A): PutMem4 AP, VarPtr(AH(0))
    ' make a metafile in memory
    lngMetaDC = CreateMetaFile(vbNullString)
    ' himetric to twips to pixels, always round up (by using a negative value for Int)
    lngWidth = -Int(-pic.Width / 1.76388888888889 / Screen.TwipsPerPixelX)
    lngHeight = -Int(-pic.Height / 1.76388888888889 / Screen.TwipsPerPixelY)
    ' create header
    strHeader = "{\pict\wmetafile8\picw" & pic.Width & "\pich" & pic.Height & _
        "\picwgoal" & (lngWidth * Screen.TwipsPerPixelX) & "\pichgoal" & (lngHeight * Screen.TwipsPerPixelY) & " "
    ' create footer
    strFooter = "}"
    ' create a screen compatible DC
    lngScreenDC = GetDC(0)
    lngPicDC = CreateCompatibleDC(lngScreenDC)
    ReleaseDC 0, lngScreenDC
    ' set picture to the new DC
    lngOld = SelectObject(lngPicDC, pic.Handle)
    ' set size of metafile window
    SetMapMode lngMetaDC, MM_ANISOTROPIC
    SetWindowExtEx lngMetaDC, lngWidth, lngHeight, udtSZ
    ' copy bitmap to metafile
    BitBlt lngMetaDC, 0, 0, lngWidth, lngHeight, lngPicDC, 0, 0, vbSrcCopy
    'cleanup: restore original bitmap and delete (note: DeleteDC destroys lngOld as well)
    SelectObject lngPicDC, lngOld
    DeleteDC lngPicDC
    ' create file from DC
    lngMetaFile = CloseMetaFile(lngMetaDC)
    ' get size of the buffer
    MetaSize = GetMetaFileBitsEx(lngMetaFile, 0, ByVal 0&)
    ' create a buffer... and rip out the extra six bytes of a BSTR and fix pointer too
    j = SysAllocStringByteLen(0, MetaSize - 6) - 4
    ' now get the file bytes to buffer
    GetMetaFileBitsEx lngMetaFile, MetaSize, ByVal j
    ' delete the file from memory
    DeleteMetaFile lngMetaFile
    ' initialize a byte array with no data
    Meta = vbNullString
    ' get pointer to safe array header (Debug.Assert is required for VB6 IDE, there is a bug in "Not array_variable")
    AH(3) = Not Not Meta: Debug.Assert App.hInstance
    ' point to the string we created!
    A(3) = j: A(4) = MetaSize
    ' allocate final output buffer and place it to output string
    AH(3) = VarPtr(PictureToRTF)
    A(0) = SysAllocStringLen(0, Len(strHeader) + Len(strFooter) + MetaSize * 2)
    ' copy header to start of buffer
    Mid$(PictureToRTF, 1, Len(strHeader)) = strHeader
    ' copy footer to end of buffer
    Mid$(PictureToRTF, Len(PictureToRTF) - Len(strFooter) + 1, Len(strFooter)) = strFooter
    ' move array pointer to position
    AH(3) = StrPtr(PictureToRTF) + LenB(strHeader)
    ' convert metafile bytes to hex & place to output buffer
    For j = 0 To MetaSize - 1
        ' convert 8-bit byte to a Long that contains lowercase hexadecimal character representation of higher and lower 4 bits
        A(j) = m_Hex(Meta(j))
    Next j
    ' end safe array hack
    AH(3) = AP: A(0) = 0
End Function

Full benchmark project with updated modRTFpic.bas included. The results below are from a compiled program. The benchmark program has been updated so that the true speed of the function is timed. It happens to be so that adding the image to the RichTextBox now takes much longer than generating the RTF data for it...