Insert Image to EditorGadget Using TOM [Windows]
Posted: Mon Sep 02, 2024 2:46 pm
Code: Select all
;************************************************************************
;
; Insert an image into an EditorGadget
; No clipboard, No query file in the disk
; Using a TOM method
;
;************************************************************************
; This code creates its own iDataObject interface in order to
; make a call to the function: OleCreateStaticFromData
;************************************************************************
;
Procedure.s GetWinErrorMessage(errorCode)
Protected messageBuffer.s = Space(256) ; Buffer pour le message
Protected messageLength
messageLength = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM | #FORMAT_MESSAGE_IGNORE_INSERTS, #Null, errorCode, 0, @messageBuffer, 256, #Null)
If messageLength > 0
; Supprime les retours à la ligne à la fin du message
messageBuffer = ReplaceString(messageBuffer, Chr(10), "")
messageBuffer = ReplaceString(messageBuffer, Chr(13), "")
messageBuffer = Trim(messageBuffer)
Else
messageBuffer = "Unknown error code:"
EndIf
ProcedureReturn messageBuffer + " ($" + Hex(errorCode) + ")"
EndProcedure
;
Procedure.l TOM_InsertFromImage(Image, Rich_Edit_Hdl, PosInText)
; 'Rich_Edit_Hdl' peut être un numéro de Gadget ou un handle (pointeur) vers un RicheEdit Control.
; 'Image' peut être un numéro d'image PureBasic ou un handle vers celle-ci.
;
#STGM_SHARE_EXCLUSIVE=$00000010
#STGM_READWRITE = $00000002
#STGM_CREATE = $00001000
#REO_CP_SELECTION=$FFFFFFFF
#REO_RESIZABLE=1
#REO_BELOWBASELINE=2
#OLERENDER_FORMAT=2
;
Protected RichEditOleObject.IRichEditOle
Protected lpLockBytes.ILockBytes
Protected lpStorage.IStorage
Protected lpClientSite.IOleClientSite
Protected lpOleObject.IOleObject
Protected *pDataObject.IDataObject
Protected sc
Protected hBitmap
Protected *pTextDocument.ITextDocument
Protected *pTextRange.ITextRange
Protected var.VARIANT
;
Structure iData
*pIntf.IDataobject
m_stgmed.STGMEDIUM
m_format.FORMATETC
EndStructure
;
Protected mDataObj.idata
;
If IsImage(Image)
Image = ImageID(Image)
EndIf
;
If IsGadget(Rich_Edit_Hdl)
Rich_Edit_Hdl = GadgetID(Rich_Edit_Hdl)
EndIf
;
hBitmap = CopyImage_(Image, #IMAGE_BITMAP, 0, 0, #LR_COPYRETURNORG)
If hBitmap
;
; Get the RichOLEInterface on our EditorGadget:
SendMessage_(Rich_Edit_Hdl, #EM_GETOLEINTERFACE, 0, @RichEditOleObject)
;
If RichEditOleObject
; We are going to create an IDataObject that will contain the image data.
; Creating such an object is quite complex, as it is an interface object
; that must be provided with a collection of methods to read data, return
; data, provide the list of contained objects, etc.
;
; The IDataObject we are going to create will implement only one of these methods: GetData
; as it is the only one necessary to call OleCreateStaticFromData_
;
; The method table for our IDataObject, VTable_IDataObject, is at the end of this file.
; If you look at it, you will see that it only points to 'dataobject_GetData()'
; or to a dummy method I named 'NotImplemented', which is used
; for all the non-implemented methods.
;
; If our IDataObject were complete, it would include the following methods:
; dataobject_AddRef(*dataobject.iData)
; dataobject_Release(*dataobject.iData)
; dataobject_QueryInterface(*dataobject.IDataobject, iid, *ppvObject.Integer)
; dataobject_GetDataHere(*dataobject, *pformatetc, *pmedium)
; dataobject_QueryGetData(*dataobject, *pformatetc)
; dataobject_GetCanonicalFormatEtc(*dataobject, *pformatectIn ,*pformatetcOut)
; dataobject_SetData(*dataobject.iData, *pformatetc.FORMATETC , *pmedium.STGMEDIUM , fRelease)
; dataobject_EnumFormatEtc(*dataobject, dwDirection , *ppenumFormatEtc)
; dataobject_DAdvise(*dataobject,*pformatetc, advf, *pAdvSink, *pdwConnection)
; dataobject_DUnadvise(*dataobject, dwConnection)
; dataobject_EnumDAdvise(*dataobject, *ppenumAdvise)
;
; It would take several hundred lines of code to implement all of that!
;
; Instead, we will take a shortcut by asking OleCreateStaticFromData_ to do the most of
; the work for us :)
;
; First create our makeshift IDataObject:
;
mDataObj\pIntf = ?VTable_IDataObject
;
mDataObj\m_stgmed\tymed = #TYMED_GDI ; Storage medium must be set to #TYMED_GDI for #CF_BITMAP
; and to #TYMED_HGLOBAL for all other formats.
; m_stgmed and m_format MUST have the same value
; in their respective 'tymed' fields!
mDataObj\m_stgmed\hBitmap = hBitmap ; Data handle
; You should have mDataObj\m_stgmed\hGlobal = hData for other data than BITMAP
mDataObj\m_stgmed\pUnkForRelease = #Null ; Use ReleaseStgMedium
mDataObj\m_format\cfFormat = #CF_BITMAP ; An IDataObject can have values like #CF_DIB,
; #CF_BITMAP, #CF_TEXT, or #CF_RTF, among others.
mDataObj\m_format\ptd = #Null ; Target Device = Screen
mDataObj\m_format\dwAspect = #DVASPECT_CONTENT ; Level of detail = Full content
mDataObj\m_format\lindex = -1 ; Index = Not applicaple
mDataObj\m_format\tymed = #TYMED_GDI ; Storage medium must be set to #TYMED_GDI for #CF_BITMAP
;
; Then, we prepare what is necessary for a call to OleCreateStaticFromData
; Create an ILockBytes to be able to obtain an IStorage:
sc = CreateILockBytesOnHGlobal_(#Null, #True, @lpLockBytes)
If sc = #S_OK
; Creat an empty IStorage:
sc = StgCreateDocfileOnILockBytes_(lpLockBytes, #STGM_SHARE_EXCLUSIVE | #STGM_CREATE | #STGM_READWRITE, 0, @lpStorage)
; Free ILockBytes. We don't need it anymore:
lpLockBytes\Release()
If sc = #S_OK
;
; Create an IOleClientSite:
sc = RichEditOleObject\GetClientSite(@lpClientSite)
If sc <> #S_OK
Debug "Unable to create IOleClientSite from the RichEditOleObject. Error: " + GetWinErrorMessage(SC)
lpStorage\Release()
Else
sc = OleCreateStaticFromData_(mDataObj, ?IID_IOleObject, #OLERENDER_FORMAT, mDataObj\m_format, lpClientSite, lpStorage, @lpOleObject)
If sc <> #S_OK
Debug "Error OleCreateStaticFromData_: " + GetWinErrorMessage(SC)
lpStorage\Release()
lpClientSite\Release()
Else
; From our makeshift IDataObject, OleCreateStaticFromData_()
; has just created an lpOleObject.
; This powerful object can itself create an IDataObject
; from the information we provided to it:
SC = lpOleObject\QueryInterface(?IID_IDataObject, @*pDataObject.IDataObject)
If SC <> #S_OK
Debug "Unable to create IDataObject. Error: " + GetWinErrorMessage(SC)
lpOleObject\Release()
lpStorage\Release()
lpClientSite\Release()
Else
; Here we have a fully functional IDataObject
; (with all the possible methods, or nearly so).
; Other thank to OleCreateStaticFromData_() : the Bitmap we've given
; to our makeshift IDataObject had been automatically converted into
; DIB format wich is necessary to the ITextRange\Paste() method!
;
; Final step: we need to create a TOM interface on our RichEdit
SC = RichEditOleObject\QueryInterface(?IID_ITextDocument, @*pTextDocument.ITextDocument)
If SC <> #S_OK
Debug "Unable to create ITextDocument: " + GetWinErrorMessage(SC)
*pDataObject\Release()
Else
;
; Get the text range:
SC = *pTextDocument\Range(PosInText, PosInText, @*pTextRange.ITextRange)
*pTextDocument\Release()
If SC <> #S_OK
Debug "Unable to get the ITextRange. Error : " + GetWinErrorMessage(SC)
Else
; Create a VARIANT with a pointer to our new and complete IDataObject
var.VARIANT
var\vt = #VT_UNKNOWN ; | #VT_BYREF
var\ppunkVal = *pDataObject
;
; Paste our IDataObject into the range:
; Clipboard in NOT used. The paste operation is done from our IDataobject.
SC = *pTextRange\Paste(@var, #CF_DIB)
If sc <> #S_OK
Debug "Range does'nt accept Data : " + GetWinErrorMessage(SC)
EndIf
*pTextRange\Release()
EndIf
*pDataObject\Release() ; Destroy our beautifull object (snif!)
EndIf
;
; Cleanup :
lpOleObject\Release()
lpStorage\Release()
lpClientSite\Release()
EndIf
EndIf
EndIf
EndIf
EndIf
;
RichEditOleObject\Release()
EndIf
;
DeleteObject_(hBitmap)
;
EndIf
;
ProcedureReturn SC
EndProcedure
;
Procedure dataobject_GetData(*dataobject.iData, *pformatetcIn.FORMATETC, *pmedium.STGMEDIUM)
; This procedure is essential for the operation of the previous one.
; It implements the 'GetData' method for the IDataObject we create in this program.
;
; Its role is to fill the '*pmedium.STGMEDIUM' structure passed as a parameter
; with the data from *dataobject\m_stgmed (the data of our image).
; The hbitmap or hGlobal content of *dataobject\m_stgmed is duplicated, and a pointer to this
; duplicated content is placed in *pmedium.STGMEDIUM.
;
; GetData will work only if the requested data format (*pformatetcIn\cfFormat)
; matches the one in our IDataObject, which is either: #CF_BITMAP or #CF_DIB.
;
Protected hbitmap
If *pformatetcIn\tymed = *dataobject\m_format\tymed
If *pformatetcIn\cfFormat = *dataobject\m_format\cfFormat
; The format requested by the procedure is indeed the one we have in our data.
*pmedium\tymed = *dataobject\m_stgmed\tymed
*pmedium\pUnkForRelease = *dataobject\m_stgmed\pUnkForRelease
If *dataobject\m_format\cfFormat = #CF_BITMAP And *dataobject\m_stgmed\tymed = #TYMED_GDI
;Debug "Format Bitmap asked"
hbitmap = OleDuplicateData_(*dataobject\m_stgmed\hBitmap, *dataobject\m_format\cfFormat, #Null)
*pmedium\hBitmap = hbitmap
ProcedureReturn #S_OK
ElseIf *dataobject\m_stgmed\tymed = #TYMED_HGLOBAL
;Debug "Format Dib asked"
hGlobal = OleDuplicateData_(*dataobject\m_stgmed\hGlobal, *dataobject\m_format\cfFormat, #Null)
*pmedium\hGlobal = hGlobal
ProcedureReturn #S_OK
Else
*pmedium\hGlobal = 0
ProcedureReturn #DV_E_FORMATETC
EndIf
EndIf
EndIf
ProcedureReturn #DV_E_FORMATETC
EndProcedure
;
Procedure NotImplemented(a, b, c = 0, d = 0, e = 0)
Debug "This procedure shoudn't be called."
ProcedureReturn #E_NOTIMPL
EndProcedure
;
DataSection
VTable_IDataObject:
Data.i @NotImplemented(), @NotImplemented(), @NotImplemented()
Data.i @dataobject_GetData(),@NotImplemented(),@NotImplemented()
Data.i @NotImplemented(),@NotImplemented(),@NotImplemented()
Data.i @NotImplemented(),@NotImplemented(),@NotImplemented()
IID_IOleObject: ;"{00000112-0000-0000-C000-000000000046}"
Data.l $00000112
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IDataObject:
Data.l $0000010e
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_ITextDocument:
Data.l $8CC497C0
Data.w $A1DF, $11CE
Data.b $80, $98, $00, $AA, $00, $47, $BE, $5D
EndDataSection
; ****************************************************************************
;
; DEMO
;
; ****************************************************************************
;
If OpenWindow(0, 0, 0, 700, 500, "RichEdit", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
;
EGadget = EditorGadget(#PB_Any, 10, 10, WindowWidth(0)-20, WindowHeight(0)-20)
; EditorGadget MUST be set to #TM_RICHTEXT in order to allow TOM ITextRange to work.
SendMessage_(GadgetID(EGadget), #EM_SETTEXTMODE, #TM_RICHTEXT, 0) ; Absolutely necessary!
SetGadgetText(EGadget,"essai")
;
Filters$ = "Bitmap|*.bmp|JPeg|*.jpg;*.jpeg"
Filter = 1
Fichier$ = OpenFileRequester("Choose an image file", "", Filters$, Filter)
If Fichier$
UseJPEGImageDecoder()
MImage = LoadImage(#PB_Any, Fichier$)
If MImage
TOM_InsertFromImage(MImage, EGadget,0)
Else
Debug "Image isn't loaded"
EndIf
EndIf
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
End
; ADDITIONAL COMMENT: Another way of using TOM to insert an image into an EditorGadget
; is to call the ITEXTRANGE\InsertImage() method. However, this approach has a significant
; drawback: ITEXTRANGE\InsertImage() inserts the image from an IStream, which must
; be kept active as long as the EditorGadget is in use. This requires cleanup only at the
; end of the program (after closing the EditorGadget or removing the image). However, we all
; know how easy it is to forget such things, and the trouble of leaving resources active due
; to negligence. If you still prefer to use the IStream method, here's how to proceed:
;
;
; Import "gdiplus.lib"
; GdiplusStartup(*token, *input, *output)
; GdiplusShutdown(token)
; GdipCreateBitmapFromStream(pStream.IStream, *GdiPImage)
; GdipCreateBitmapFromFile(FileName.p-bstr, *GdiPImage)
; GdipGetImageWidth(GdiPImage, *Width) ; *width is a pointer to LONG (.l)
; GdipGetImageHeight(GdiPImage, *Height) ; *Height is a pointer to LONG (.l)
; GdipDisposeImage(GdiPImage)
; EndImport
; ;
; Structure GdiplusStartupInput
; GdiplusVersion.l
; DebugEventCallback.l
; SuppressBackgroundThread.l
; SuppressExternalCodecs.l
; EndStructure
; ;
; Procedure GdiP_Init()
; Shared GdiplusToken
; Protected GdiplusStartupInput.GdiplusStartupInput
;
; If GdiplusToken = 0
; GdiplusStartupInput\GdiplusVersion = 1
;
; SC = GdiplusStartup(@GdiplusToken, @GdiplusStartupInput, #Null)
; If SC <> 0
; Debug "Erreur GDI : "+Str(SC)
; ProcedureReturn 0
; Else
; ProcedureReturn GdiplusToken
; EndIf
; Else
; ProcedureReturn GdiplusToken
; EndIf
; EndProcedure
;
; Procedure GdiP_Shutdown()
; Shared GdiplusToken
; GdiplusShutdown(GdiplusToken)
; GdiplusToken = 0
; EndProcedure
;
; Structure StreamAndGlobal
; pIStream.IStream
; GlobalMemory.i
; EndStructure
;
; Procedure ReleaseStreamData(*StreamData.StreamAndGlobal)
; If *StreamData\pIStream
; *StreamData\pIStream\Release()
; *StreamData\pIStream = 0
; EndIf
; If *StreamData\GlobalMemory
; GlobalFree_(*StreamData\GlobalMemory)
; *StreamData\GlobalMemory = 0
; EndIf
; GdiP_Shutdown()
; EndProcedure
;
;
; Procedure InsertImageFromOLEStream(Gadget, StartPos, EndPos, Fichier.s, *StreamData.StreamAndGlobal)
; Protected RichEditOleObject.IRichEditOle
; Protected *pTextDocument.ITextDocument
; Protected *pTextRange.ITextRange2
; Protected ImageSize, *pGlobalMemory
; Protected ImageWidth.l, ImageHeight.l, Bitmap.i
; Protected hFile, type, ascent
; Protected SC
; ;
; If Gadget = 0 Or Fichier = "" Or *StreamData = 0
; Debug "Erreur dans les paramètres."
; ProcedureReturn #False
; EndIf
; ;
; If IsGadget(Gadget)
; Gadget = GadgetID(Gadget)
; EndIf
; ;
; SendMessage_(Gadget, #EM_GETOLEINTERFACE, 0, @RichEditOleObject)
; ;
; If RichEditOleObject = 0
; Debug "Erreur lors de la récupération de l'interface RichEdit OLE."
; Else
; SC = RichEditOleObject\QueryInterface(?IID_ITextDocument2, @*pTextDocument)
; If SC <> #S_OK
; Debug "Erreur lors de la récupération de l'interface ITextDocument2 : " + Str(SC)
; Else
; ; Il n'est pas utile de conserver RichEditOleObject une fois ITextDocument2 obtenue.
; RichEditOleObject\Release()
; ;
; ; Récupérer l'image du fichier dans un 'GlobalMemory' :
; ;
; hFile = ReadFile(#PB_Any, Fichier)
;
; If hFile = 0
; Debug "L'ouverture du fichier a échoué."
; *pTextDocument\Release()
; ProcedureReturn #False
; Else
; ImageSize = Lof(hFile)
; *StreamData\GlobalMemory = GlobalAlloc_(#GMEM_MOVEABLE, ImageSize)
; *pGlobalMemory = GlobalLock_(*StreamData\GlobalMemory)
;
; If *pGlobalMemory = 0
; Debug "GlobalAlloc_ ou GlobalLock_ a échoué."
; ReleaseStreamData(*StreamData)
; *pTextDocument\Release()
; ProcedureReturn #False
; Else
; ; Lire directement le fichier dans la mémoire allouée
; ReadData(hFile, *pGlobalMemory, ImageSize)
; CloseFile(hFile)
; GlobalUnlock_(*StreamData\GlobalMemory)
; ;
; ; Créer le flux à partir de la mémoire globale
; If CreateStreamOnHGlobal_(*StreamData\GlobalMemory, #False, @*StreamData\pIStream) <> #S_OK
; Debug "Erreur lors de la création du IStream."
; ReleaseStreamData(*StreamData)
; *pTextDocument\Release()
; ProcedureReturn #False
; EndIf
; EndIf
; EndIf
; ;
; ; Déplacer le curseur du flux au début
; *StreamData\pIStream\Seek(0, #STREAM_SEEK_SET, #Null)
; ; Obtenir les dimensions du Bitmap contenu dans le flux :
; GdiP_Init()
; If GdipCreateBitmapFromStream(*StreamData\pIStream, @Bitmap) = #S_OK
; GdipGetImageWidth(Bitmap, @ImageWidth.l)
; GdipGetImageHeight(Bitmap, @ImageHeight.l)
; GdipDisposeImage(Bitmap)
; GdiP_Shutdown()
; Else
; Debug "Erreur GDI"
; ReleaseStreamData(*StreamData)
; *pTextDocument\Release()
; ProcedureReturn #False
; EndIf
; ;
; ; Convert dimensions to metrics :
; ImageWidth * 2540 / 96
; ImageHeight * 2540 / 96
; ;
; ; Obtenir la plage de texte actuelle
; SC = *pTextDocument\Range(StartPos, EndPos, @*pTextRange)
; *pTextDocument\Release()
; If SC <> #S_OK
; Debug "Impossible d'obtenir le TextRange."
; ReleaseStreamData(*StreamData)
; ProcedureReturn #False
; Else
; ; Insérer l'image
; ;
; ; On rembobine le Stream, pour pouvoir le lire à nouveau
; *StreamData\pIStream\Seek(0, #STREAM_SEEK_SET, #Null)
; ;
; #TA_BASELINE = 24
; #TA_BOTTOM = 8
; #TA_TOP = 0
; ; Comme le spécifie la documentation, ascent ne change quelque chose que lorsque type = #TA_BASELINE
; type = #TA_TOP
; ascent = 0
; If *pTextRange\InsertImage(ImageWidth, ImageHeight, ascent, type, "Image", *StreamData\pIStream) <> #S_OK
; Debug "Erreur lors de l'insertion de l'image."
; EndIf
; *pTextRange\Release()
; EndIf
; ;
; ; ReleaseStreamData(*StreamData)
; ; La ligne précédente a été mise en commentaire car le RichEdit (Editorgadget)
; ; a absolument besoin que le IStream reste ouvert, faute de quoi l'image
; ; disparaît dans le contenu (on a unectangle tout blanc à la place de l'image).
; ; Il faudra donc penser à faire ReleaseStreamData(StreamData)
; ; à la fin du programme qui appelle cette procédure (une fois le Editorgadget fermé).
; ;
; EndIf
; EndIf
; ProcedureReturn #True
; EndProcedure
;
;
;
; EGadget = EditorGadget(#PB_Any, 10, 10, WindowWidth(0)-20, WindowHeight(0)-20)
;
; Define StreamData.StreamAndGlobal
; InsertImageFromOLEStream(EGadget, 0, 0, Fichier$, StreamData)
; .........
; Use your Editorgadget Here
; Then close your window
; .........
; ReleaseStreamData(StreamData)
