PureBasic

Voici une procédure de remplacement de Catchrtf, elle est plus compacte et surtout elle évite d'utiliser une variable prtf utiliser actuellement dans la procédure actuelle.

Code : Tout sélectionner

Procedure.l Catchrtf(gadget, datastart, dataend, replaceall=0)
    Protected donne.settextex
    If replaceall
        ClearGadgetItemList(gadget)
    EndIf 
    longueur=dataend-datastart
    *Tampon=AllocateMemory(Longueur+1)
    CopyMemory(datastart,*Tampon,Longueur)
    donne\flags= 2 ;#ST_SELECTION
    donne\codepage=#CP_ACP
    SendMessage_(GadgetID(gadget),#EM_SETTEXTEX,@donne,*Tampon) 
    FreeMemory(*Tampon)
EndProcedure

Pour ceux qui utilise ce code pour copier des images dans l'éditeur, vous avez du remarquer qu'on ne peut pas utiliser le drag and drop depuis l'explorateur pour charger un fichier ou une image car celui-ci est automatiquement empaqueter.

Voici un code qui permet de le faire, changer la procedure par celle-ci:

Code : Tout sélectionner

Procedure.l RichEdit_QueryAcceptData(*pObject.RichEditOle, *lpdataobj.IDataObject, *lpcfFormat, reco, fReally, hMetaPict)
    Protected pEnumFormats.IEnumFORMATETC,fmtetc.FORMATETC,stgmed.STGMEDIUM
    Protected Extension$,lpszFile.s,hdrop.l,drop.l,nFiles.l,nNames.l,id.l,*Buffer.l
    
    Debug "RichEdit_QueryAcceptData"

; Predefined Clipboard Formats
; Private Const CF_TEXT = 1
; Private Const CF_BITMAP = 2
; Private Const CF_METAFILEPICT = 3
; Private Const CF_SYLK = 4
; Private Const CF_DIF = 5
; Private Const CF_TIFF = 6
; Private Const CF_OEMTEXT = 7
; Private Const CF_DIB = 8
; Private Const CF_PALETTE = 9
; Private Const CF_PENDATA = 10
; Private Const CF_RIFF = 11
; Private Const CF_WAVE = 12
; Private Const CF_UNICODETEXT = 13
; Private Const CF_ENHMETAFILE = 14
; Private Const CF_HDROP = 15
; Private Const CF_LOCALE = 16
; Private Const CF_MAX = 17

drop=0
    ;// Get the COM Interface For format Enumeration
  	If *lpdataobj\EnumFormatEtc(#DATADIR_GET, @pEnumFormats.IEnumFORMATETC)=0
  	;// Enumerate each type of Data supported by this IDataObject, one-by-one
    	While pEnumFormats\Next(1, @fmtetc.FORMATETC, @num.l)=0
    	;Debug fmtetc\cfFormat
        If fmtetc\cfFormat=#CF_HDROP
            lpszFile.s=Space(#MAX_PATH + 1)
                If *lpdataobj\GetData(fmtetc,@stgmed.STGMEDIUM)=0
                hdrop.l = GlobalLock_(stgmed\hGlobal)
                If hdrop
                    nFiles.l = DragQueryFile_(hdrop, -1, #Null, 0)
                    If nFiles=1 ; ici je n'accepte que le glisser déposer d'un seul fichier
                        For nNames = 0 To nFiles-1
                            ZeroMemory_(@lpszFile, #MAX_PATH + 1)
                            DragQueryFile_(hdrop, nNames, @lpszFile, #MAX_PATH + 1)
                            Extension$ = GetExtensionPart(lpszFile)
                            Extension$ = LCase(Extension$)
                            If Extension$="bmp" Or Extension$="png" Or Extension$="jpeg" Or Extension$="jpg"
                                drop=4
                            ElseIf Extension$="rtf"
                                drop=3
                            ElseIf Extension$="txt"
                                drop=2 
                            Else
                                drop=1
                            EndIf 
                        Next 
                    Else 
                          drop=5
                    EndIf 
                    GlobalUnlock_(hdrop)
                EndIf 
                ReleaseStgMedium_(@stgmed)
            EndIf 
        EndIf 
    	Wend 
  	pEnumFormats\Release()
	  EndIf 
	  
	  
	Debug fReally
	
	If fReally=0 And drop=1
	    ProcedureReturn -1
	EndIf 
	
  If fReally=1  And drop>1
      Select drop
          Case 2
             id=ReadFile(#PB_Any, lpszFile)
             *Buffer=AllocateMemory(Lof(id))
             ReadData(id,*Buffer,Lof(id))
             SetGadgetText(GetDlgCtrlID_(*pObject\hwnd),PeekS(*Buffer))
             CloseFile(id)
          Case 3
             LoadRTF(GetDlgCtrlID_(*pObject\hwnd), lpszFile, 0) 
          Case 4
             ;MessageRequester("Information", lpszFile, 0)
             id=LoadImage(#PB_Any,lpszFile)
             Paste_Image(ImageID(id),GetDlgCtrlID_(*pObject\hwnd))
             FreeImage(id)
          Case 5
              MessageRequester("Information", "Ne glisser-déposer qu'un seul fichier à la fois!", 0)   
       EndSelect 
       ProcedureReturn -1
	EndIf 
  
  ProcedureReturn #S_OK
EndProcedure

Juste un problème avec Paste_Image() qui n'est pas reconnu (pas encore inclus), étant utilisé dans RichEdit_QueryAcceptData()

Pour que ça fonctionne j'ai modifié Ole.pbi comme ça

Code : Tout sélectionner

;-*****USER FUNCTIONS***************************************************************************

Declare  Paste_Image(hBitmap.l,Rich_Edit_ID.l)

Par contre impossible d'ouvrir un rtf et de voir son contenu ??

ARRH!! si je viens de voir ça dans l'exemple

Code : Tout sélectionner

Case 1
            Select EventType()
              Case #PB_EventType_LeftClick
                  FichierParDefaut$ = "C:\"
                  Filtre$ = "Fichier texte(*.rtf)|*.rtf"
                  Filtre  = 0 
                  Fichier$ = OpenFileRequester("Choisissez un fichier à charger", FichierParDefaut$, Filtre$, Filtre)
                  If Fichier$
                    LoadRTF(0, "c:\essai.rtf")
                  Else
                    MessageRequester("Information", "La sélection a été annulée.", 0)
                  EndIf
            EndSelect

Donc pour ouvrir le rtf, changez ça :

Code : Tout sélectionner

 LoadRTF(0, "c:\essai.rtf")

par ça :

Code : Tout sélectionner

LoadRTF(0, Fichier$)

et là tout baigne, merci nico!

J'avoue volontier que c'est le bordel avec tous ces codes juste pour afficher une image et encore je me demande si on est pas obliger de libérer les objets à la fermeture de l'edit, ce qui voudrait dire une procedure de plus à rajouter.

Si j'ai bien compris, lors d'un drag drop d'un fichier *.rtf celui-ci ne se charge pas, et pour les images c'est pareil?

[Edit] Apparemment c'est bon!

Si je prend le temps, la semaine prochaine je posterais un fichier include unique.

Dans cette procedure, j'intercepte le drag drop et en fait je l'annule pour appeller mes propres procédures, mais je pense qu'on pourrait se passer de Paste_Image(), il faudrait alors modifier les datas avec *lpdataobj\SetData ; ça doit être possible si quelqu'un veut essayer.

non non, je n'ai pas encore essayé le DetD, c'était seulement le openfilerequester, tu avais oublié de modifier ton fichier de tests....

Par contre je me demande si la procédure déclarée comme j'ai fait ne risque pas de poser problème (bon ça fonctionne mais quand même) car située dans un autre fichier.

juste pour afficher une image

Si si, car justement j'en avais besoin pour pré-formater des documents avant impression, pour mettre un logo en tête de page. Je trouve seulement dommage que ce genre "d'indispensable" ne soit pas implémenter directement. Faudrai faire une prière à St Fred

J'ai testé le Drag and Drop et c'est Ok!

- D'un éditeur à l'autre (gauche>droite et droite>gauche) l'image est déplacée.
- Depuis l'explorateur Windows dans l'un ou l'autre éditeur.

Bonjour à tous.

Je vais à contre-courant dans votre course aux monsieur + de la fonction sur ce superbe code, ou je ne comprend vraiment rien

J'ai éssayé d'isoler juste la fonction de l'ajout de l'image dans l'editeur, car je n'ai besoin que d'elle.
Je suis arrivé à enlever pas mal de procedures.

J'en ai commenté 2, donc apparement elle ne servent à rien pour la fonction que je recherche, mais je n'arrive pas à les supprimer, meme en remplaçant dans les DATAS leur adresse par 0, et pourtant ça a marché pour les autres

Quelqu'un pourrait continuer à simplifier ce code au maximum, en supprimant ce qui ne me servirait à rien dans ce que je veux faire, et afin que j'entrevoie une lueur de comprehension dans ce code hight tech

Code : Tout sélectionner

 Structure iData 
  *pIntf.IDataobject 
  Refcount.l 
  m_stgmed.STGMEDIUM 
  m_fromat.FORMATETC 
EndStructure 

Global NewList IDataObject.iData() 

#STGM_SHARE_EXCLUSIVE=$00000010 
#STGM_READWRITE = $00000002 
#STGM_CREATE = $00001000 
#REO_CP_SELECTION=$FFFFFFFF 
#REO_RESIZABLE=1 
#REO_BELOWBASELINE=2 
#OLERENDER_FORMAT=2 

Procedure dataobject_AddRef(*dataobject.iData) 
;   Debug "AddRef" 
;   *dataobject\Refcount=*dataobject\Refcount+1 
;   ProcedureReturn *dataobject\Refcount 
EndProcedure 

Procedure dataobject_Release(*dataobject.iData) 
;   *dataobject\Refcount=*dataobject\Refcount-1 
;   If *dataobjectRefcount > 0 
;     ProcedureReturn *dataobject\Refcount 
;   Else 
;     ForEach IDataObject() 
;       If IDataObject()=*dataobject 
;         Debug "Release" 
;         DeleteElement(IDataObject()) : Break 
;       EndIf 
;     Next 
;     *dataobject=0 
;   EndIf 
EndProcedure 

Procedure dataobject_QueryInterface(*dataobject.IDataobject, iid, *ppvObject.Long) ; A garder
  If CompareMemory(iid, ?IID_IUnknown, 16)=1 Or CompareMemory(iid, ?IID_IDataObject, 16)=1 

    *ppvObject\l = *dataobject 
    *dataobject\AddRef() 
    ProcedureReturn #S_OK 
  Else 
    *ppvObject=0 
    ProcedureReturn #E_NOINTERFACE 
  EndIf 
EndProcedure 
    
Procedure dataobject_GetData(*dataobject.iData,*pformatetcIn.FORMATETC, *pmedium.STGMEDIUM) ; A garder
  If *pformatetcIn\tymed=*dataobject\m_fromat\tymed 
    If *pformatetcIn\cfFormat=*dataobject\m_fromat\cfFormat 
     
      *pmedium\tymed = *dataobject\m_stgmed\tymed 
      *pmedium\hBitmap = *dataobject\m_stgmed\hBitmap 
      *pmedium\pUnkForRelease = *dataobject\m_stgmed\pUnkForRelease 
    EndIf 
  EndIf 
  ProcedureReturn #S_OK 
EndProcedure 

Procedure dataobject_SetData(*dataobject.iData, *pformatetc.FORMATETC , *pmedium.STGMEDIUM , fRelease ) ; A garder
  
  CopyMemory(*pformatetc,*dataobject\m_fromat,SizeOf(FORMATETC)) 
  CopyMemory(*pmedium,*dataobject\m_stgmed,SizeOf(STGMEDIUM)) 
  ProcedureReturn #S_OK 
  
EndProcedure 

Procedure.l Paste_Image(hBitmap.l,Rich_Edit_ID.l) 
  Protected RET.l,sc.l,pods.IDataobject,stgm.STGMEDIUM ,fm.FORMATETC 
  
  SendMessage_(GadgetID(Rich_Edit_ID), #EM_GETOLEINTERFACE, 0, @RichEditOleObject.IRichEditOle) 
  
  If RichEditOleObject 
    AddElement(IDataObject()) 
    IDataObject()\pIntf=?VTable 
    pods.IDataobject=IDataObject() 
    
    ;       Normalement on devrait dupliquer le bitmap avec cette fonction, 
    ;       mais bien que la fonction return un handle; ça ne fonctionne pas pour autant! 
    ;       hbitmap = OleDuplicateData_(hBitmap, #CF_BITMAP, #Null) 
    
    hBitmap=CopyImage_(hBitmap,#IMAGE_BITMAP,0,0,#LR_COPYRETURNORG) 

    stgm\tymed = #TYMED_GDI            ;         // Storage medium = HBITMAP handle      
    stgm\hBitmap = hBitmap             ;         // HBITMAP handle 
    stgm\pUnkForRelease = #Null        ;         // Use ReleaseStgMedium 
    

    fm\cfFormat = #CF_BITMAP           ;         // Clipboard format = CF_BITMAP 
    fm\ptd = #Null                     ;         // Target Device = Screen 
    fm\dwAspect = #DVASPECT_CONTENT    ;         // Level of detail = Full content 
    fm\lindex = -1                     ;         // Index = Not applicaple 
    fm\tymed = #TYMED_GDI              ;         // Storage medium = HBITMAP handle 
    
    
    CopyMemory(?IID_IUnknown,@iid.IID,16) 
    sc=pods\QueryInterface(iid.IID, @lpDataObject.IDataobject) 
    
    sc=pods\SetData(@fm, @stgm, #True) 
    
    sc = CreateILockBytesOnHGlobal_(#Null, #True, @lpLockBytes.ILockBytes) 
    If sc = #S_OK 
      
      sc =StgCreateDocfileOnILockBytes_(lpLockBytes,#STGM_SHARE_EXCLUSIVE|#STGM_CREATE|#STGM_READWRITE, 0, @lpStorage.IStorage) 
      If sc = #S_OK 
        
        sc =RichEditOleObject\GetClientSite(@lpClientSite.IOleClientSite) 
        If sc = #S_OK 
          
          sc = OleCreateStaticFromData_(lpDataObject, ?IID_IOleObject, #OLERENDER_FORMAT, IDataObject()\m_fromat, lpClientSite, lpStorage, @lpOleObject.IOleObject) 
          If sc = #S_OK 
            
            OleSetContainedObject_(lpOleObject, #True) 
            
            reobject.REOBJECT 
            ZeroMemory_(@reobject, SizeOf(REOBJECT)) 
            reobject\cbStruct = SizeOf(REOBJECT) 
            
            sc = lpOleObject\GetUserClassID(@clsid.CLSID) 
            
            CopyMemory(@clsid.CLSID,@reobject\clsid,16) 
            
            reobject\cp = #REO_CP_SELECTION 
            reobject\dvaspect = #DVASPECT_CONTENT 
            reobject\dwFlags = #REO_RESIZABLE 
            reobject\dwUser = 0 
            reobject\poleobj = lpOleObject 
            reobject\polesite = lpClientSite 
            reobject\pstg = lpStorage 
            reobject\sizel\cx=0 
            reobject\sizel\cy=0 
            
            RET= RichEditOleObject\InsertObject(reobject) 
            
          EndIf 
        EndIf 
      EndIf 
    EndIf 
    
    If lpLockBytes 
      lpLockBytes\Release() 
      lpLockBytes=0 
    EndIf 
    
    If lpDataObject 
      lpDataObject\Release() 
      lpDataObject = #Null 
    EndIf 
    
    If lpOleObject 
      lpOleObject\Release() 
      lpOleObject = #Null 
    EndIf 
    
    If lpStorage 
      lpStorage\Release() 
      lpStorage = #Null 
    EndIf 
    
    If lpClientSite 
      lpClientSite\Release() 
      lpClientSite = #Null 
    EndIf 
    
    If RichEditOleObject 
      RichEditOleObject\Release() 
      RichEditOleObject = #Null 
    EndIf 
  EndIf 
  ProcedureReturn RET 
EndProcedure 

UseJPEGImageDecoder()
;CheminDossierPolices = AppPath;+ "Polices graphiques\"
Police.s = "Recreation"
ExtensionPolice.s = ".ttf"
LoadFont(0, Police, 40)

LoadImage(1,"C:\Africa.jpg") 

If OpenWindow(0, 0, 0, 600, 600, "RichEdit", #PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  SetWindowLong_(WindowID(0),#GWL_STYLE,GetWindowLong_(WindowID(0),#GWL_STYLE)|#WS_CLIPCHILDREN) 
  CreateGadgetList(WindowID(0)) 
  
  EditorGadget(0, 10, 10, 580, 360) 
  
  ButtonImageGadget(2, 10, 380, 200, 200, ImageID(1)) 
  SetGadgetFont(0,FontID(0))  
  Repeat 
    Event = WaitWindowEvent() 
    Select Event 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          
          Case 2 
            Select EventType() 
              Case #PB_EventType_LeftClick 
                Paste_Image(ImageID(1),0) 
            EndSelect 
            
        EndSelect 
        
    EndSelect 
  Until Event = #PB_Event_CloseWindow 
EndIf 



DataSection 
VTable: 
Data.l @dataobject_QueryInterface(), @dataobject_AddRef(), @dataobject_Release() 
Data.l @dataobject_GetData(),0,0 
Data.l 0,@dataobject_SetData()

IID_IDataObject:  ;{0000010e-0000-0000-C000-000000000046"} 
Data.l $0000010E 
Data.w $0000,$0000 
Data.b $C0,$00,$00,$00,$00,$00,$00,$46 

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_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}" 
Data.l $00000000 
Data.w $0000,$0000 
Data.b $C0,$00,$00,$00,$00,$00,$00,$46 

EndDataSection

Merci de votre aide

Il faut laisser les interfaces dans leur intégralité, même si elle semble ne servir à rien! (Dans ce cas là la procédure ne prend pas beaucoup de place)

Si tu veux afficher une image sans avoir besoin de la sauvegarder, alors le code que tu as pris est parfait!

Sinon, le code de Srod suffit à lui -même, il suffit de copier l'image dans le presse papier et d'envoyer un sendmessage(gadgetid(Edit),#WM_PASTE,0,0).

Bon je sais pas pourquoi, mais si tu le dit c'est vrai

Comme pour moi, chaque ligne est une torture, j'essaie tant que faire se peux de réduire vos splendides codes, lorsque je m'aperçois qu'il contiennent des options dont je n'ai pas besoin.

Et au niveau de la complexité, celui-la, c'est pas de la roupie de sansonet

C'est impresionnant, on se demande ou vous allez chercher tout ça

Je m'etais juste dit que y'a surement quelques lignes qui partiraient bien en vacances, rien que pour coller une image, mais bon ce que je me dit et PB, ça fait deux

Encore merci à toi et SROD de ce superbe code

Salut Nico (et salut à tous)
pourrais tu centraliser les codes récents (les derniers corrigés en faite) dans le 1er post, ce serait plus facile de s'y retrouver.
Merci pour ce partage.

j'essaierais de le faire plus tard

PureBasic

Mettre une image Bitmap dans un éditeur

Re: Mettre une image Bitmap dans un éditeur

Re: Mettre une image Bitmap dans un éditeur