RTF to Image

[The_Dark_Zim-.-]

Hey Ho,

ich versuche gerade ein RTF in ein Image umzuwandeln, bzw. auf ein Canvas zu zeichnen. Aber ich finde leider keine Lösung -.-
Das Laden eines RTF-Dokumentes in ein EditorGadget stellt kein Problem da.

Ich habe folgenden Code mal versucht nach PB zu portieren, aber leider funktioniert das nicht
http://www.swissdelphicenter.com/de/sho ... hp?id=2146

Code: Alles auswählen

Procedure StreamFileIn_Callback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1 
EndProcedure 

Procedure FileStreamIn(FileID.l, File.s, Gadget.l,Option.l) 
  Protected StreamData.EDITSTREAM 
  If ReadFile(FileID, File) 
    StreamData\dwCookie = FileID(FileID) 
    StreamData\dwError = #Null 
    StreamData\pfnCallback = @StreamFileIn_Callback() 
    SendMessage_(GadgetID(Gadget), #EM_STREAMIN, Option, @StreamData) 
    CloseFile(FileID) 
  EndIf 
EndProcedure 

Procedure RichEditToCanvas(RichEdit, Canvas)
  
    cRect.RECT 
    FormatRange.FORMATRANGE   
  
    hdc = GadgetID(Canvas)
    hdcTarget = hdc

    SetRect_(cRect, 0, 0, 2000, 2000) ; Testwerte
    
    FormatRange\hdc = hdc
    FormatRange\hdcTarget = hdcTarget
    FormatRange\rc\left = cRect\left 
    FormatRange\rc\top = cRect\top 
    FormatRange\rc\right = cRect\right 
    FormatRange\rc\bottom = cRect\bottom 
    FormatRange\rcPage\left = cRect\left 
    FormatRange\rcPage\top = cRect\top 
    FormatRange\rcPage\right = cRect\right 
    FormatRange\rcPage\bottom = cRect\bottom 
    FormatRange\chrg\cpMax = Len(GetGadgetText(RichEdit)) - SendMessage_(GadgetID(RichEdit),#EM_GETLINECOUNT,0,0) 
    FormatRange\chrg\cpMin = 0
    
    SetBkMode_(GadgetID(Canvas), #TRANSPARENT);
    SendMessage_(GadgetID(RichEdit),#EM_FORMATRANGE, 1, @FormatRange)
    ; Next call frees some cached Data
    SendMessage_(GadgetID(RichEdit),#EM_FORMATRANGE, 0, 0)
EndProcedure

If OpenWindow(0, 10, 10, 640, 480,"PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered) 
  EditorGadget(1, 0, 0, WindowWidth(0)-100,WindowHeight(0)) 
  ButtonGadget(2, WindowWidth(0)-90,10,80,24,"Drucken") 
  ButtonGadget(3, WindowWidth(0)-90,40,80,24,"Laden") 
  CanvasGadget(4, 0, 0, WindowWidth(0)-100,WindowHeight(0))
  HideGadget(1, 1)

  Repeat 
    EventID.l = WaitWindowEvent() 
    If EventID = #PB_Event_CloseWindow 
      Quit = 1 
    EndIf 
    If EventID = #PB_Event_Gadget 
      Select EventGadget() 
        Case 2 
          RichEditToCanvas(1, 4)
        Case 3 
          DName$ = OpenFileRequester("Datei laden :","*.*", "Text-Dateien|*.txt|Rich Text Files|*.rtf|Alle Dateien|*.*", 0) 
          ;DName$ = "C:\Documents And Settings\Administrator\Desktop\Kopie von mail_text.rtf"
          If UCase(GetExtensionPart(DName$)) = "RTF" 
              FileStreamIn(0,DName$, 1,#SF_RTF) 
          Else 
              FileStreamIn(0,DName$, 1,#SF_TEXT) 
          EndIf 
      EndSelect 
    EndIf 
  Until Quit = 1 
EndIf 
End 

Hat evtl. jemand eine Idee wie man das Umsetzen könnte?

[The_Dark_Zim-.-]

So habe eine Lösung gefunden

Code: Alles auswählen

Global Himg

Procedure StreamFileIn_Callback(hFile, pbBuff, cb, pcb)
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure

Procedure FileStreamIn(FileID.l, File.s, Gadget.l,Option.l)
  Protected StreamData.EDITSTREAM
  If ReadFile(FileID, File)
    StreamData\dwCookie = FileID(FileID)
    StreamData\dwError = #Null
    StreamData\pfnCallback = @StreamFileIn_Callback()
    SendMessage_(GadgetID(Gadget), #EM_STREAMIN, Option, @StreamData)
    CloseFile(FileID)
  EndIf
EndProcedure

Procedure RichEditToCanvas(RichEdit)
  FormatRange.FORMATRANGE   
  cRect.RECT
  
  newdc = CreateCompatibleDC_(#Null)
  SetRect_(cRect, 0, 0,(WindowWidth(0)-100)*15, WindowHeight(0)*15.4)
  
  FormatRange\hdc = newdc
  FormatRange\hdcTarget = newdc
  FormatRange\rc\left = cRect\left
  FormatRange\rc\top = cRect\top
  FormatRange\rc\right = cRect\right
  FormatRange\rc\bottom = cRect\bottom
  FormatRange\rcPage\left = cRect\left
  FormatRange\rcPage\top = cRect\top
  FormatRange\rcPage\right = cRect\right
  FormatRange\rcPage\bottom = cRect\bottom
  FormatRange\chrg\cpMax = Len(GetGadgetText(RichEdit)) - SendMessage_(GadgetID(RichEdit),#EM_GETLINECOUNT,0,0)
  FormatRange\chrg\cpMin = 0
  
  SelectObject_(newdc, Himg)
  SendMessage_(GadgetID(RichEdit),#EM_FORMATRANGE, 1, @FormatRange)
  
  ; Cleanup when finished
  DeleteDC_(newdc)
  SendMessage_(GadgetID(RichEdit),#EM_FORMATRANGE, 0, 0)
EndProcedure

If OpenWindow(0, 10, 10, 640, 480,"PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
  EditorGadget(1, 0, 0, WindowWidth(0)-100,WindowHeight(0))
  ButtonGadget(2, WindowWidth(0)-90,10,80,24,"Drucken")
  ButtonGadget(3, WindowWidth(0)-90,40,80,24,"Laden")
  CanvasGadget(4, 0, 0, WindowWidth(0)-100,WindowHeight(0), #PB_Canvas_Border)
  Himg = CreateImage(0, WindowWidth(0)-100,WindowHeight(0))
  HideGadget(4,1)
  
  Repeat
    EventID.l = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      Quit = 1
    EndIf
    If EventID = #PB_Event_Gadget
      Select EventGadget()
        Case 2
          RichEditToCanvas(1)
          SetGadgetAttribute(4, #PB_Canvas_Image, ImageID(0))
          HideGadget(4,0)
          HideGadget(1,1)
          SaveImage(0, "c:\test.bmp")
        Case 3
          DName$ = OpenFileRequester("Datei laden :","*.*", "Text-Dateien|*.txt|Rich Text Files|*.rtf|Alle Dateien|*.*", 0)
          ;           DName$ = "C:\Documents And Settings\Administrator\Desktop\Kopie von mail_text.rtf"
          If UCase(GetExtensionPart(DName$)) = "RTF"
            FileStreamIn(0,DName$, 1,#SF_RTF)
          Else
            FileStreamIn(0,DName$, 1,#SF_TEXT)
          EndIf
          HideGadget(4,1)
          HideGadget(1,0)
      EndSelect
    EndIf
  Until Quit = 1
EndIf
End

[Kiffi]

So habe eine Lösung gefunden [...]

ich kann es selber zwar (noch) nicht gebrauchen, aber ich finde es gut, dass
Du die Lösung hier postest. So funktioniert Community!

Grüße ... Kiffi