Bild in RTF-Datei einbinden

[horsthorn]

Irgendeine "graue XProfan-Eminenz" hatte mal einen Code veröffentlicht, mit dem es möglich war, Bilder in RTF-Dateien einzubinden.
Finde den Urheber und den Code einfach nicht. Kann mir jemand einen Tipp geben ?

[THFR]

RTF mit OLE-Objekten siehe : Index und Home Dieter Zornow

Gruß Thomas

[Uwe 'Pascal']

Hi Leute!

Hier nochmal eine aktuelle kompakte Minimalversion:

'****************** Demo: IRichEditOleCallback-Interface für RichEdit-Controls
'****************** XProfan² 11/12 + Windows XP
'****************** © by Uwe "Pascal" Niemeier 09'2010
window (%maxx-10),(%maxy-10)
usermessages 16
 
$H Windows.ph
$H Richedit.ph
 
def StgCreateDocfileOnILockBytes(4) !"ole32","StgCreateDocfileOnILockBytes"
def OleCreateFromFile(8) !"ole32","OleCreateFromFile"
def CreateILockBytesOnHGlobal(3) !"ole32","CreateILockBytesOnHGlobal"
def CLSIDFromString(2) !"ole32","CLSIDFromString"
 
declare IFace&,VTable#,asm#
dim asm#,20'--ASM-Ersatz für QueryAcceptData >> zu viele Parameter (6!) für ProcAddr()
long  asm#,0=-1192457387,-2147467263,-1034033781,24
dim VTable#,60'--------------------IRichEditOleCallback-Interface
long VTable#, 0=procaddr("NotImplemented",2)'-----QueryInterface
long VTable#, 4=procaddr("NotImplemented",1)'-----AddRef (return &E_NOTIMPL)
long VTable#, 8=procaddr("NotImplemented",1)'-----Release (return &E_NOTIMPL)
long VTable#,12=procaddr("GetNewStorage",2)'------GetNewStorage (IStorage aktualisieren)
long VTable#,16=procaddr("NotImplemented",4)'-----GetInPlaceContext
long VTable#,20=procaddr("NotImplemented",2)'-----ShowContainerUI
long VTable#,24=procaddr("QueryInsertObject",4)'--QueryInsertObject (return &E_OK)
long VTable#,28=procaddr("NotImplemented",2)'-----DeleteObject
long VTable#,32=asm#'-----------------------------QueryAcceptData (return &E_NOTIMPL)
long VTable#,36=procaddr("NotImplemented",2)'-----ContextSensitiveHelp
long VTable#,40=procaddr("NotImplemented",4)'-----GetClipboardData
long VTable#,44=procaddr("NotImplemented",4)'-----GetDragDropEffect
long VTable#,48=procaddr("GetContextMenu",5)'-----GetContextMenu (wird aufgerufen bei Rechtsklick)
long VTable#,52=VTable#
IFace&=VTable#+52
 
proc NotImplemented'---------------------------------------NotImplemented
return $80004001
endproc'------------------------------------------------------------------
 
proc GetNewStorage'------------------------------------------GetNewStorage
parameters IFace&,IStorage&
declare ILockBytes&
CreateILockBytesOnHGlobal(0,1,addr(ILockBytes&))
StgCreateDocfileOnILockBytes(ILockBytes&,$1012,0,IStorage&)
CallMethod(ILockBytes&,2)'--Release
return 0
endproc'------------------------------------------------------------------
 
proc QueryInsertObject'----------------------------------QueryInsertObject
return 0'--Rückfrage, ob Einfügen erlaubt >> OK
endproc'------------------------------------------------------------------
 
proc GetContextMenu'----------------------------------------GetContextMenu
var File$=loadfile$("Bild einfügen","*.bmp")'--Hier könnte auch ein Menü erscheinen
case len(File$):InsertOLE(Edit&,File$)'--------Es können auch andere Dateitypen eingefügt werden
endproc'------------------------------------------------------------------
 
proc CallMethod'-------------------------------------------CallMethod
parameters IFace&,Method&
declare VTable&
VTable&=long(IFace&,0)
Method&=long(VTable&,Method&*4)
case %pcount=2:return call( Method&,IFace& )
case %pcount=3:return call( Method&,IFace&,&(3) )
case %pcount=4:return call( Method&,IFace&,&(3),$(4) )
case %pcount=5:return call( Method&,IFace&,&(3),&(4),&(5) )
endproc'-------------------------------------------------------------
 
proc InsertOle'---------------------------------------------InsertOle
parameters RTF&,File$'--Hier wird das Bild an Cursor/Markierung eingefügt
declare ILockBytes&,IStorage&,IDataObject&,IRichEditOle&,FORMATETC#,IID#,Temp#
dim FORMATETC#,20:dim IID#,16:dim Temp#,261:long FORMATETC#,8=1,-1
CreateILockBytesOnHGlobal(0,1,addr(ILockBytes&))
StgCreateDocfileOnILockBytes(ILockBytes&,$1012,0,addr(IStorage&))
stringW Temp#,0="{0000010e-0000-0000-C000-000000000046}"'--IID_IDataObject
CLSIDFromString(Temp#,IID#)
stringW Temp#,0=File$
OleCreateFromFile(0,Temp#,IID#,1,FORMATETC#,0,IStorage&,addr(IDataObject&))
sendmessage(RTF&,~EM_GETOLEINTERFACE,0,addr(IRichEditOle&))
CallMethod(IRichEditOle&,18,IDataObject&,0,0)'--ImportDataObject
CallMethod(ILockBytes&,2)'----Release
CallMethod(IStorage&,2)'------Release
CallMethod(IDataObject&,2)'---Release
CallMethod(IRichEditOle&,2)'--Release
dispose IID#:dispose FORMATETC#:dispose Temp#
endproc'-------------------------------------------------------------
 
var Edit&=create("RichEdit",%hwnd,"Einfügen an Cursorposition bei Rechtsklick",0,0,width(%hwnd),height(%hwnd))
sendmessage(Edit&,~EM_SETOLECALLBACK,0,IFace&)'--Ab hier können auch Dokumente mit Bild geladen werden
 
while 1
 waitinput
 case %umessage=16:break
endwhile
 
destroywindow(Edit&)
dispose asm#
dispose VTable#
'--Eigendlich sollten hier noch die ProzedurAdressen freigegeben werden

"graue XProfan-Eminenz"

SeeYou
Pascal

[horsthorn]

Uwe "Pascal"
Großen Dank für die aktuelle Version ! - Das habe ich gebraucht

[Frabbing]

Unser OLE-Meister Pascal!

[THFR]

Ich denke Horst wollte ein BILD einsetzen. Da bietet im Moment Dieters PCU die beste Lösung. Uns Uwe 'Pascal' : Bitte noch ein Script für Bilder.

Gruß Thomas

[horsthorn]

Für mich ist "Pascals" Code der bessere. Ich will ja nicht in Wordpad oder Textmaker oder Ä. die Bilder einfügen. Das können diese Programme ja selbst. Ich will in ein XProfan-RICHEDIT Bilder einfügen und der Vorteil von "Pascals" Code ist der, daß das Bild an der Cursor-Position eingefügt wird und abgespeichert werden kann.

[THFR]

@Horst, das ist mit Dieters RTF-pcu in einem XPrafan Rich-Edit erstellt und nur um den Unterschied zwischen BILD bzw. OLE zu zeigen, und, dass wenn es mit einem anderen Texteditor geöffnet wird, auch wie erstellt angezeigt wird.

Gruß Thomas

[horsthorn]

Habe mich jetzt in die PCU eingearbeitet. Ein Problem bleibt aber für mich (bin vielleicht auch zu blöd dafür):
Ein Briefkopf wird geladen - links oben das Übliche, Name, Adresse usw.
Jetzt soll rechts oben in gleicher Höhe ein Logo geladen werden und das klappt nicht. Entweder Adresse oder Logo oder eines der beiden weiter unten im Richedit.
Geht das nicht oder mache ich etwas falsch ? In meinem "Uralt"-Textmaker ist das kein Problem.
Als Beispiel hier eine Vorlage. Das ist aber ein JPG-Bild. So soll aber der Briefkopf aussehen mit Eingabe des Textes und rechts das Logo. Hoffe, ich habe mich verständlich ausgedrückt.

[THFR]

@Horst, bei einer MS RTF ist ein Objekt bzw. Bild immer an eine Zeile gebunden und die Zeilenhöhe entspricht dann der Bildhöhe.
Was du suchst ist eine Datei mit formatiertem Text und einem "Bild-Container", die aber dann, wenn sie mit einem RTF-Editor geöffnet und als *.rtf gespeichert, auch zerstört wird.
Das hatte ich hier dir einmal vorgestellt und das ist sicher das was du suchst.
Werde ein Beispiel erstellen. Kann bis zum Wochenende dauern.

Gruß Thomas

[THFR]

@Horst, ich habe etwas mit der oFrame.dll zusammen gestellt.
Ein Problem habe ich noch mit dem oFrame-Objekt. Das bekomme ich einfach zum Ersetzen nicht gelöscht und so entstehen n..Objekte beim Einfügen.
Die Position des Objekts zu verändern ist natürlich auch über ein Dialogfenster (mit Skalierung) oder per Subproc möglich.

@Frank, kannst du zum Löschen eines Objekts einen Weg aufzeigen oder wie kann ein Objekt per Befehl neu positioniert und in der Größe verändert werden.

Set("ErrorLevel", 1)
$H Windows.ph


DEF SetWndSize(3) ~SetWindowPos(&(1),0,0,0,%(2),%(3),~SWP_NOMOVE | ~SWP_NOZORDER)
DEF Redraw(1) ~RedrawWindow(&(1),0,0,~RDW_FRAME | ~RDW_INVALIDATE | ~RDW_ALLCHILDREN | ~RDW_ERASE)



'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)

Proc G2l
   Parameters Hdl&
   Clear C2sstrc#
   @Clienttoscreen(R_Edit&,C2sstrc#)
   x%=@G2lx()
   y%=@G2ly()
   Clear C2sstrc#
   @Clienttoscreen(Hdl&,C2sstrc#)
   L_Bildx%=@G2lx()-x%
   L_Bildy%=@G2ly()-y%
Endproc

Declare C2sstrc#
Dim C2sstrc#,8
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def GetClientRect(2) !"USER32","GetClientRect"

Def OF_SetMoveRect(5) !"oframe","OF_SetMoveRect"
Def OF_SetSizeRect(5) !"oframe","OF_SetSizeRect"
Def OF_SetBitmap(4) !"oframe","OF_SetBitmap"
Def OF_SetText(4) !"oframe","OF_SetText"
Def OF_SetIcon(5) !"oframe","OF_SetIcon"
Def OF_SetStyle(6) !"oframe","OF_SetStyle"
Def OF_SetGdi(6) !"oframe","OF_SetGdi"

var owndll&=UseDll("OFrame.dll")
Declare rect#
Dim rect#,16

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


Window 10,10 - 800,500
GetClientRect(%hwnd,rect#)

PopUp "&Datei"
    AppendMenu 100,"Laden"
    AppendMenu 101,"Speichern"
    Separator
    SubPopUp "Bild"
    AppendMenu 102,"Bild Laden"
    AppendMenu 103,"Bild Skalieren"
    AppendMenu 104,"Bild Löschen"
    EndSub

    Separator
    AppendMenu 109,"&Ende"

Declare Bmp1&,temp$,text$,x$,y$
Declare File$,bytes&,bereich#
declare x%,y%
Declare L_Bild%,L_Bx$,L_By$,L_BPix$
Declare Logo&[], L_BildH%, L_BildB%, Logo_text$

var LR_File$="Neu.rpl"

var L_Bild$=""
var L_Bildy%=20
var L_Bildx%=20
var Logo%=0

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var R_EDIT&=Create("RichEdit",%hWnd,"",100,40,400,200)
settext R_Edit&,"\n\nKlaus Wassermann\n\nAm Wasserturm 12\n23455 Wasserburg"

While 1
  WaitInput

  case (%key=2) OR MenuItem(109):BREAK
  case MenuItem(102): BILDWAHL

  If menuitem(101) '~~~~~~~~~~~~~~~~~~~~~~~~~~speichern
    File$=savefile$("Datei speichern",LR_File$)
    G2l Logo&[Logo%]

    if File$<>""
       call(&SaveRTF,R_Edit&,addr(File$))

        bytes&=@FileSize(file$)
        x%=bytes&

        If trim$(L_Bild$)<>""
         Translate$(L_Bild$,"\","\\")
         Bmp1&=Create("hSizedPic", -1, L_Bild$, (L_BildB%/100*L_Bild%), (L_BildH%/100*L_Bild%), 1)
         L_Bx$=right$(("000000"+Str$(%bmpx)),6)
         L_By$=right$(("000000"+Str$(%bmpy)),6)
         x$=right$(("000000"+Str$(L_Bildx%)),6)
         y$=right$(("000000"+Str$(L_Bildy%)),6)
         L_BPix$=right$(("0000000"+Str$(x%+72)),7) '39 by für Zeile Bildinformation

         Logo_text$=bild2txt(bmp1&,%bmpx,%bmpy)

         deleteobject bmp1&
         Else
         x$="000000"
         y$="000000"
         L_Bx$="000000"
         L_By$="000000"
         L_BPix$="0000000"
         Logo_text$=""
       EndIf

       Assign #2,file$
       Append #2
       print #2, "{\info{\vern6450}}"
       print #2, "{\info{\|Logo|"+x$+"|"+y$+"|"+L_Bx$+"|"+L_By$+"|"+L_BPix$+"}" ' Bildinformation
       print #2,Logo_text$
       Close #2
     endIf
     redraw (R_Edit&)
     setfocus(R_Edit&)

    ElseIf menuitem(100) '~~~~~~~~~~~~~~~~~~~~~~~~~~Laden
     L_Bild$=""
     case Logo%>0:ShowWindow(Logo&[Logo%],0)
     
     File$=LoadFile$("Datei öffnen","*.rpl")
     If len(file$)>0
       Translate$(File$,"\","\\")
       assign #1,File$
       reset #1
       ClearList
       x%=0
       whilenot eof(#1)
          input #1,temp$
          inc x%
          if Match$("info", temp$)<>""
            If substr$(temp$,2,"|")="Logo"

               L_Bildx%=val(substr$(temp$,3,"|"))
               L_Bildy%=val(substr$(temp$,4,"|"))
               L_BildB%=val(substr$(temp$,5,"|"))
               L_BildH%=val(substr$(temp$,6,"|"))

               x%=val(substr$(temp$,7,"|"))
               If L_BildB%>0
                  Dim Bereich#, FileSize(File$)+2
                  @BlockRead(File$, Bereich#, 0,FileSize(File$))
                  text$=@String$(Bereich#,x%)
                  Bmp1&=txt2bild(text$,L_BildB%,L_BildH%)
                  L_Bild$="Test.png"
                  SavePic L_Bild$,Bmp1&
                  Dispose bereich#
               EndIf
            EndiF
          endif
       wend
       close #1
       Rtf("LoadRTF",R_Edit&,file$)
       BILDLADEN
    EndIf

    ElseIf menuitem(104) '~~~~~~~~~~~~~~~~~~~~~~~~~~Bild Löschen
    ShowWindow(Logo&[Logo%],0)
    L_Bild$=""
    
  Endif

EndWhile

DestroyWindow(%hwnd)
DeleteObject Bmp1&
DeleteObject R_Edit&
FreeDll owndll&
Dispose C2sstrc#
Dispose rect#

end

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
PROC BILDWAHL
  Set("Decimals",6)
  L_Bild$=LoadFile$("Ein Bild wählen - auf die Größe achten - und auf Öffnen klicken",\
    "alle Bilder|*.BMP;*.JPG;*.GIF;*.PNG")
  casenot L_Bild$="" : BILDLADEN
EndProc

PROC BILDLADEN
     case L_Bild$="" : Return
     case Logo%>0:ShowWindow(Logo&[Logo%],0)
     Bmp1&=Create("hPic",-1,L_Bild$)
     L_BildB%=%BmpX'
     L_BildH%= %BmpY'
     Set("Decimals",0)
     L_Bild%=100
     case L_BildB%>100: L_Bild%=10000/L_BildB%
     case L_BildH%>100: L_Bild%=10000/L_BildH%
     Bmp1&=Create("hSizedPic", -1, L_Bild$, (L_BildB%/100*L_Bild%), (L_BildH%/100*L_Bild%), 1)
     inc Logo%
     Logo&[Logo%]=Control("OFRAME", "", $40000001,L_Bildx%,L_Bildy%, %BmpX, %BmpY, R_Edit&, 0, %hInstance, $0)
     OF_SetBitmap(Logo&[Logo%],0,0,1)
     OF_SetBitmap(Logo&[Logo%],bmp1&,0,1)
     OF_SetSizeRect(Logo&[Logo%],%BmpX, %BmpY,%BmpX, %BmpY)
     OF_SetMoveRect(Logo&[Logo%],0,0,Long(rect#,8),Long(rect#,12))
     OF_SetStyle(Logo&[Logo%],1,0,0,0,0)
     ShowWindow(Logo&[Logo%],1)
     SetFocus(%hwnd)
ENDPROC


proc txt2bild 'von iF

    parameters s$,_width&,_height&
    s$=decode64(s$)
    var hPic&=create("hNewPic",_width&,_height&,0)
    var sz&=((_width&*32\8-1) | 3+1)*abs(_height&)
    declare mem#
    dim mem#,40
    long mem#,0=40,_width&,_height&,0,0,sz&
    byte mem#,12=1
    byte mem#,14=32
    external("gdi32.dll","SetDIBits",%hDC,hPic&,0,_height&,addr(s$),mem#,0)
    dispose mem#
    return hPic&

endproc

proc bild2txt ' von iF
    parameters h&,_width&,_height&
    var sz&=((_width&*32\8-1) | 3+1)*abs(_height&)
    declare mem#
    dim mem#,40
    long mem#,0=40,_width&,_height&,0,0,sz&
    byte mem#,12=1
    byte mem#,14=32
    declare pixels#
    dim pixels#,sz&

    ifnot external("gdi32.dll","GetDIBits",%hDC,h&,0,_height&,pixels#,mem#,0)
        dispose pixels#,mem#
        return 0
    endif

    var txt$=encode64(char$(pixels#,0,_width&*_height&*4-4))
    dispose pixels#,mem#
    return txt$
endproc

Gruß Thomas

[Frabbing]

In der Größe verändert müsste doch gehen, indem du neue Größen-Grenzen setzt oder einfach mit SetWindowPos. Letzteres auch zum positionieren.
Control löschen mit DestroyWindow. Ganz normalweg.

[Uwe 'Pascal']

Hi Leute!

@ Thomas: Bilder in RTF sind ja auch OLE-Objekte; ist nur eine Frage der beim Einfügen eingestellten Ansicht. Mein Code sollte BMPs als Bild anzeigen. Gleiches gilt übrigens auch für ins RTF-Dokument eingefügte RTF-Dateien; quasi Text im Text, allerdings nicht direkt zu bearbeiten, weil als Bild dargestellt.

@Horst: Was spricht dagegen, den ganzen Briefkopf als Bild einzufügen? Oder Text und Logo einzeln als Bild, mit Leerzeichen oder Tabs dazwischen? (Verschiedene Ausrichtungen in einer Zeile klappt leider nicht)
Oder lieber HTML?

SeeYou
Pascal

[horsthorn]

@Pascal

@Horst: Was spricht dagegen, den ganzen Briefkopf als Bild einzufügen? Oder Text und Logo einzeln als Bild, mit Leerzeichen oder Tabs dazwischen? (Verschiedene Ausrichtungen in einer Zeile klappt leider nicht)
Oder lieber HTML?

An sich spricht nichts dagegen. Allerdings müsste ich dann für jeden neuen Kunden (Freund von mir hat eine kleine Schreinerei und will eben für Angebote und Rechnungen so einen Briefkopf haben) ein neues Bild erstellen.
Im Moment habe ich das ganze mit XProfan gelöst. Hier wird das Logo über HPIC... an den gewünschten Platz gestellt. Auch die Druckroutine habe ich selbst mit "Usefont...." erstellt. Die Kundendaten werden aus einer kleinen CSV-Datei eingelesen und das klappt ja auch alles. Selbst Rechnungen werden vom Programm erstellt inclusive Mehrwertsteuer usw... Was mich reizt, ist die Formatierung in einer RTF-Datei. Na ja, man kann nicht alles haben.