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!
===================================
Hi,
the following will take any bitmap handle and convert the underlying image to an RTF string suitable for saving as an rtf file or for streaming into an OLE enabled EditorGadget (see http://www.purebasic.fr/english/viewtop ... tor+gadget)
This code can easily be adapted to convert any EMF (Enhanced MetaFile) into an RTF string.
Code: Select all
;'BMP2RTF'
;Stephen Rodriguez.
;
;Windows only.
;
;Convert a bitmap to an RTF string. This string can be saved to an rtf file or streamed into an OLE enabled
;editor gadget (see http://www.purebasic.fr/english/viewtopic.php?t=20691&highlight=images+editor+gadget).
;
;***********************************************************************************************
EnableExplicit
;Returns an empty string if an error.
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
DisableExplicit
Code: Select all
If LoadImage(1, "test.bmp") ;Use your own bitmap here.
rtf$ = BMP2RTF(ImageID(1))
;Save as rtf file (or you could stream this into an OLE enabled Editor gadget).
If CreateFile(1, "test.rtf")
WriteString(1, rtf$)
CloseFile(1)
MessageRequester("BMP2RTF", Chr(34) + "test.rtf" + Chr(34) + " created successfully!")
EndIf
EndIf
