PureBoard

Verfasst: **17.08.2014 20:40**

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?

Verfasst: **18.08.2014 19:21**

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

Verfasst: **18.08.2014 19:27**

The_Dark_Zim-.- hat geschrieben: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

PureBoard

RTF to Image

RTF to Image

Re: RTF to Image

Re: RTF to Image