Convert any bitmap to an RTF (rich text) string

srod · Post by **srod** » Sun Jan 18, 2009 1:24 pm

Update : 18th Jan 2009.

Problems with Wordpad recognising rtf with an embedded EMF (no problems with MS Word) have led me to switch to a basic Window's MetaFile (not an enhanced one). I have also removed all CRLF's from the rtf (for easier streaming) and have sped the code up no end!

The program now runs much much much... faster!

Code is in the first post.

@Psych : having removed all CR \ LF characters, you should no longer have any problems streaming the rtf into an OLE enabled editor gadget.

@Blue : this should fix your problem.

@All : I shall be having a good look at the StringBuilder class as it looks mighty interesting. However, you should no longer need to use this class with this utility as the code now works directly with a memory buffer.

Psych · Post by **Psych** » Sun Jan 18, 2009 2:52 pm

Ok, I tried to stream the RTF generated text into an editorgadget (like load it, convert it, then stream it), and I get nothing, on debugging the return value from the catchrtf function I get 0 (which means no error).
The call I am using is this:

Code: Select all

c.l=catchrtf(12, @a$, @a$+Len(a$),#SFF_SELECTION)
Debug c

I have replaced the a$ with the a$ you gave in your example to see if it was my generated RTF that was at fault (since I was trying to stream RTF generated from a PNG, which generated the RTF fine as I am assuming it references the Image object rather that the filetype, anyway the rtf string I am testing it with now is from your example.)

Another thing, I cant seem to find the comments you made about the replacell parameter, is this just any non zero value? It seems to be OR'd with the flags, so I'm thinking any old value wont do. Of course for my application I need the selection only, but for testing its easier to replace everything so I dont get multiple images in my gadget.

Thanks again.

SCRJ · Post by **SCRJ** » Sun Jan 18, 2009 2:58 pm

>> Code is in the first post.
thx

Psych · Post by **Psych** » Sun Jan 18, 2009 3:00 pm

LOL !!

srod · Post by **srod** » Sun Jan 18, 2009 3:08 pm

Works fine here with a png. Your use of CatchRTF() looks incorrect.

Use :

Code: Select all

CatchRTF(12,@a$, @a$ + Len(a$), #SF_RTF, #SFF_SELECTION)

Note that using CatchRTF() on a string variable will only work in Ascii mode because rtf is a 7-bit Ascii encoding. You are better off using IncludeBinary on an rtf file or a memory buffer which contains Ascii characters only. Of course it is easy enough to convert to Ascii.

Note also that using my above code is probably not the best way of embedding a png image. We can embed a png file directly in rtf.

Psych · Post by **Psych** » Sun Jan 18, 2009 3:29 pm

Ok, this my routine that does the streaming stuff

Code: Select all

r.s=""
SetGadgetText(5,"")
If IsImage(1)
  r=bmp2rtf(ImageID(1))
  If r<>""
    SetGadgetText(5,r)
    ;c.l=CatchRTF(12,@a$, @a$ + Len(a$), #SF_RTF, #SFF_SELECTION)
    c.l=CatchRTF(12,@r, @r + Len(r), #SF_RTF, #SFF_SELECTION)
  EndIf
EndIf

Where 5 is the output EditorGadget where display the RTF, and 12 is the little preview EditorGadget for showing the result of streaming the RTF back in, I can post the whole thing if you like, it's not very large.

The commented out line is from your example using your rtf text, I cant get either to work I am afraid.

However, one good thing to come out of this is at least I can generate rtf from an image, which means my vb program needs not use the clipboard anymore, so even if I cant use it here, I'll still get use from it, LOL!!

srod · Post by **srod** » Sun Jan 18, 2009 3:34 pm

You haven't got the Unicode compiler switch set have you? If so the code will not work.

If not then yes you'd better post the entire code.

Psych · Post by **Psych** » Sun Jan 18, 2009 3:40 pm

That was the first thing I tried, it behaves the same with either compiler encoding.
Ok, here it is, it's a little larger due to the a$ being left in there. You can try it with both now, LOL!!

Code: Select all

XIncludeFile "F:\PURE BASIC\Includes\RTF Streamer.pbi"
a$ = "{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}" 
a$+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20{\pict\wmetafile8\picwgoal903\pichgoal825 " 
a$+"010009000003e402000008000601000000000400000003010800050000000b0200000000050000" 
a$+"000c025e017d01040000002e0118001c000000fb021000070000000000bc020000000001020222" 
a$+"53797374656d00017d010000f7a9724500ea120004ee8339706e22000c020000040000002d0100" 
a$+"0004000000020101001c000000fb029cff0000000000009001000000000440001254696d657320" 
a$+"4e657720526f6d616e0000000000000000000000000000000000040000002d0101000500000009" 
a$+"02000000020d000000320a5700fdff01000400fdfffdff7a015b0120d92d00030000001e000700" 
a$+"0000fc020000ff0000000000040000002d010200040000000601010008000000fa020500000000" 
a$+"00ffffff00040000002d0103000601000024038100bb000300b1000300a80004009f0005009600" 
a$+"06008d00080084000a007b000d00730010006b001300630017005b001b00540020004c00240045" 
a$+"0029003f002f003800340032003a002c0040002700470022004d001d00540019005b0015006200" 
a$+"11006a000e0072000b0079000800810006008a000500920003009a000300a3000200ac000300b4" 
a$+"000300bd000500c5000600ce000800d6000b00de000e00e6001100ed001500f5001900fc001d00" 
a$+"030122000a01270011012c00170132001d01380023013f00280145002e014c003301540037015b" 
a$+"003c01630040016b004401730047017b004a0184004d018d004f01960051019f005201a8005301" 
a$+"b1005401bb005401c4005401ce005301d7005201e0005101e9004f01f2004d01fa004a01030147" 
a$+"010b014401130140011a013c01220137012901330130012e01370128013d01230143011d014901" 
a$+"17014f01110154010a01580103015d01fc006101f5006501ed006801e6006b01de006d01d6006f" 
a$+"01ce007101c5007201bd007301b4007301ac007301a30072019a00710192006f018a006d018100" 
a$+"6b0179006801720065016a00610162005d015b005801540054014d004f0147004901400043013a" 
a$+"003d01340037012f003001290029012400220120001a011b00130117000b01130003011000fa00" 
a$+"0d00f2000a00e9000800e0000600d7000500ce000400c4000300bb00030008000000fa02000000" 
a$+"00000000000000040000002d010400040000000601010007000000fc020000ffffff0000000400" 
a$+"00002d01050008000000fa0200000600000000000000040000002d01060007000000fc02010000" 
a$+"0000000000040000002d0107000601000025038100bb000300b1000300a80004009f0005009600" 
a$+"06008d00080084000a007b000d00730010006b001300630017005b001b00540020004c00240045" 
a$+"0029003f002f003800340032003a002c0040002700470022004d001d00540019005b0015006200" 
a$+"11006a000e0072000b0079000800810006008a000500920003009a000300a3000200ac000300b4" 
a$+"000300bd000500c5000600ce000800d6000b00de000e00e6001100ed001500f5001900fc001d00" 
a$+"030122000a01270011012c00170132001d01380023013f00280145002e014c003301540037015b" 
a$+"003c01630040016b004401730047017b004a0184004d018d004f01960051019f005201a8005301" 
a$+"b1005401bb005401c4005401ce005301d7005201e0005101e9004f01f2004d01fa004a01030147" 
a$+"010b014401130140011a013c01220137012901330130012e01370128013d01230143011d014901" 
a$+"17014f01110154010a01580103015d01fc006101f5006501ed006801e6006b01de006d01d6006f" 
a$+"01ce007101c5007201bd007301b4007301ac007301a30072019a00710192006f018a006d018100" 
a$+"6b0179006801720065016a00610162005d015b005801540054014d004f0147004901400043013a" 
a$+"003d01340037012f003001290029012400220120001a011b00130117000b01130003011000fa00" 
a$+"0d00f2000a00e9000800e0000600d7000500ce000400c4000300bb000300040000002d01040004" 
a$+"0000002d01050004000000f0010600040000002701ffff040000002d010000030000000000" 
a$+"}\par" 
a$+"}" 

Procedure.s BMP2RTF(hBmap) 
  Protected rtf$, bitmap.BITMAP, screenDC, hdcMF, hMF, hdc 
  Protected oldImage, widthTwips, heightTwips, numBytes, mem, *bytes.BYTE, *string.WORD, i, low, high 
  If GetObject_(hBmap, SizeOf(BITMAP), bitmap) 
    If bitmap\bmWidth And bitmap\bmHeight 
      screenDC = GetDC_(0) 
      ;Create an EMF to hold the bitmap. 
        hdcMF = CreateMetaFile_(0) 
      If hdcMF 
        SetMapMode_(hdcMF, #MM_ANISOTROPIC) 
        SetWindowOrgEx_(hdcMF, 0, 0, 0) 
        SetWindowExtEx_(hdcMF, bitmap\bmWidth, bitmap\bmHeight, 0) 
        hdc = CreateCompatibleDC_(screenDC) 
        If hdc 
          oldImage = SelectObject_(hdc, hBmap) 
          BitBlt_(hdcMF, 0, 0, bitmap\bmWidth, bitmap\bmHeight, hdc, 0, 0, #SRCCOPY) 
          SelectObject_(hdc, oldImage) 
          DeleteDC_(hdc) 
          hMF = CloseMetaFile_(hdcMF) 
          If hMF 
            ;Before creating the RTF header we need to calculate the image width/height in twips. 
              widthTwips = MulDiv_(bitmap\bmWidth,1440,GetDeviceCaps_(screenDC, #LOGPIXELSX)) 
              heightTwips = MulDiv_(bitmap\bmHeight,1440,GetDeviceCaps_(screenDC, #LOGPIXELSY)) 
            ;Now the rtf header. 
              rtf$ = "{\rtf1{\pict\wmetafile8\picw" + Str(bitmap\bmWidth) + "\pich" + Str(bitmap\bmHeight) + "\picwgoal" + Str(widthTwips) + "\pichgoal" + Str(heightTwips) + " " 
            ;Add the MF bits as double-character hex. 
            ;First retrieve the MF bits. 
              numBytes = GetMetaFileBitsEx_(hMF, 0, 0) 
            mem = AllocateMemory(numBytes*3) 
            If mem 
              If GetMetaFileBitsEx_(hMF, numBytes, mem) = numBytes 
                *bytes=mem : *string = mem + numBytes 
                For i = 0 To numBytes-1 
                  low = (*bytes\b)&$f + '0': high = (*bytes\b)>>4&$f + '0' 
                  If low > '9' 
                    low + 7 
                  EndIf 
                  If high > '9' 
                    high + 7 
                  EndIf 
                  *string\w = low<<8 + high 
                  *string + 2 
                  *bytes + 1 
                Next 
                rtf$ + PeekS(mem + numBytes, numBytes<<1, #PB_Ascii) + "}}" 
              Else 
                rtf$ = "" 
              EndIf 
              FreeMemory(mem) 
            Else 
              rtf$ = "" 
            EndIf 
            DeleteMetaFile_(hMF) 
          EndIf      
        Else 
          hMF = CloseEnhMetaFile_(hdcMF) 
          DeleteEnhMetaFile_(hMF) 
        EndIf 
      EndIf 
      ReleaseDC_(0, screenDC) 
    EndIf 
  EndIf 
  ProcedureReturn rtf$ 
EndProcedure 

; Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)    
;   sel.CHARRANGE 
;   sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1 
;   
;   If LineEnd = -1 
;     LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1 
;   EndIf 
;   sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0) 
;   
;   If CharEnd = -1 
;     sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0) 
;   Else 
;     sel\cpMax + CharEnd - 1 
;   EndIf 
;   SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel) 
; EndProcedure 
; Procedure InsertEditorText(gadget,Text$) 
;   ProcedureReturn SendMessage_(GadgetID(gadget),#EM_REPLACESEL,0,Text$) 
; EndProcedure 
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
If OpenWindow(0, 216, 0, 494, 371, "Image to RTF",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    If CreateGadgetList(WindowID(0))
      TextGadget(2, 5, 15, 60, 20, "Filepath")
      StringGadget(1, 50, 10, 420, 20, "", #PB_String_ReadOnly)
      ButtonGadget(3, 470, 10, 20, 20, "...")
      Frame3DGadget(10,420,35,70,80,"Preview")
      ImageGadget(4, 425, 50, 60, 60, 0)
      EditorGadget(5, 5, 35, 410, 330);,#PB_Editor_ReadOnly)
      SendMessage_(GadgetID(5), #EM_SETTARGETDEVICE, #Null, 0)
      ButtonGadget(6, 420, 340, 70, 25, "Close")
      ButtonGadget(7, 420, 135, 70, 25, "Generate")
      ButtonGadget(8, 420, 165, 70, 25, "Copy")
      Frame3DGadget(11,420,195,70,80,"RichText")
      EditorGadget(12,425,210,60,60)
      DisableGadget(7,1)
      DisableGadget(8,1)
      Richedit_setinterface(GadgetID(12))
  EndIf
EndIf
Repeat
event=WindowEvent()
Select event
  Case #PB_Event_Gadget
    Select EventGadget()
      Case 6 ;close
        event=#PB_Event_CloseWindow
      Case 3 ;browse
        ld.s=OpenFileRequester("Open Image File","D:\","ImageFiles (All)|*.ico;*.bmp;*.png;*.jpg;*.jpeg;*.wmf",0)
        ;ld="D:\All Commander Icons\Smiley PNG\beer.png"
        SetGadgetText(1,ld)
        DisableGadget(7,1)
        If LoadImage(1,GetGadgetText(1))
          If IsImage(1)  
            CopyImage(1,2)
            ResizeImage(2,60,60)
            SetGadgetState(4,ImageID(2))
            DisableGadget(7,0)
          EndIf
        EndIf
      Case 7 ;Generate
        r.s=""
        SetGadgetText(5,"")
          If IsImage(1)
            r=bmp2rtf(ImageID(1))
            If r<>""
              SetGadgetText(5,r)
              ;c.l=CatchRTF(12,@a$, @a$ + Len(a$), #SF_RTF, #SFF_SELECTION)
              c.l=CatchRTF(12,@r, @r + Len(r), #SF_RTF, #SFF_SELECTION)
            EndIf
        EndIf
        DisableGadget(8,r<>"")
      Case 8 ;copy
    EndSelect
EndSelect
Until event=#PB_Event_CloseWindow

What is that graphic in the a$ by the way?

srod · Post by **srod** » Sun Jan 18, 2009 4:07 pm

Right, apart from the editor gadget 5 which will not display the text because it will try and stream it as rtf content but of course the gadget has not been OLE-enabled, the code all works fine for me!!! Can you upload the png file you are using somewhere?

Psych · Post by **Psych** » Sun Jan 18, 2009 4:17 pm

Well I get the raw rtf and not the streamed image, LOL!!

I tried it with small bitmaps too, and jpegs, same thing, it's a mystery.

srod · Post by **srod** » Sun Jan 18, 2009 4:23 pm

Then there is something wrong with the rtf - or the version of the richedit control your system is using simply will not recognise the rtf.

Let's switch to private message so we don't overly clutter this thread.

Can you run the program and pm me a copy of the resulting rtf string. Simply add a SetClipboardText(r) command at the appropriate part of your code and then you can paste it easily enough to send my way.

einander · Post by **einander** » Sun Jan 18, 2009 4:35 pm

Works like a charm here (WordPad and XP SP2)
Tested with BMP, JPG and PNG.
Thanks for sharing!

Psych · Post by **Psych** » Sun Jan 18, 2009 8:23 pm

Ok, I found another problem with the graphic that is inserted, I've been inserting PNG files into the control via the copy paste method in recent times, before the appearance of this thread, and now I remember why they had to be PNG's.
If you manage to get an image into the control, the image becomes sizable, you can strectch it within the control, this behaviour happens when the use the copy and paste method too, but not with PNG images, and you also get the tranparency that you dont get with a bitmap (meaning if you dont have the standard white background, your images will have a nasty white box around them).
Now in vb the copying of a PNG into a richtextbox gives you a transparent background, with a fixed sized image. This is all well and good in vb, but what about pb? As far as I can see, the loading of an image into memory seems to format it as one type, because even loading a PNG gives you RTF that when applied back into an editorgadget is sizable.
Maybe something can be done with the RTF headers to stop this behaviour.

srod · Post by **srod** » Sun Jan 18, 2009 8:44 pm

As I stated above, this method is not ideal for inserting a png image. the rtf specification allows for the direct embedding of png files in hex format and so you should write some code to allow for this.

srod · Post by **srod** » Sun Jan 18, 2009 10:10 pm

Right, I can embed a png image directly into an rtf stream (without resorting to using a metafile) but then only MS Word seems to be able to show the resulting image. Wordpad will not show it; neither will an OLE enabled editor gadget.

I gather that many rtf files embed images in multiple formats so that things like Wordpad are able to show them etc. png images seems to be an example of such images and indeed, many rtf files include codes to instruct a 'reader' to ignore the png data and instead fall back on a metafile etc.

I thus think we will not be able to work with png images directly in editor gadgets.

What we could do though is alter the code in this thread which 'draws' the bitmap onto a metafile to take the alpha-channel into account. Not sure whether this would give any kind of transparency, but it might be worth a shot!