PureBasic

Code : Tout sélectionner

; http://www.purebasic.fr/english/viewtopic.php?p=274556#p274556

;'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

If LoadImage(1, #PB_Compiler_Home + "..\Examples\#Commun\bmp.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, "c:\test.rtf")
    WriteString(1, rtf$)
    CloseFile(1)
    MessageRequester("BMP2RTF", Chr(34) + "c:\test.rtf" + Chr(34) + " created successfully!")
  EndIf
EndIf