PurePDF kompatibles WordWrap für EditorGadget

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Thorsten1867
Beiträge: 1360
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

PurePDF kompatibles WordWrap für EditorGadget

Beitrag von Thorsten1867 »

Ich habe lange nach einer Lösung gesucht, wie der Text im Editorgadget genauso umgebrochen wird, wie er dann in der Ausgabe als PDF (MultiCell mit Justify) erscheint.

Code: Alles auswählen

; WordWrap for EditorGadget to use with PurePDF
; needs PurePDF
; by Thorsten Hoeppner (Thorsten1867)
; Thanks to Lucky Luke and ABBKlaus (PurePDF Sourcecode)

;{ ===== Constants =====
#Window = 0
#MenuPopUp = 0

Enumeration 1
  #Editor
  #MenuPopUp_InsertLF
  #MenuPopUp_Copy
  #MenuPopUp_Cut
  #MenuPopUp_Paste
  #MenuPopUp_Del
  #MenuPopUp_Undo
  #FontEG
EndEnumeration
#GadgetIndex=#PB_Compiler_EnumerationValue
;} =====================

Structure EGFontStructure  
  Name.s
  Size.f
  FontID.l
  CharWidth.w[256]  
EndStructure
Global FontEG.EGFontStructure

Procedure.l SetEditorFont(Font.s, Size.w)
  Protected vCharWidth.w
  FontEG\Size = Size
  Select Font
    Case "Arial", "Helvetica"
      FontEG\Name = "Arial"
      FontEG\FontID = LoadFont(#FontEG, "Arial", Size, 0)
      Restore Helvetica 
    Case "Times", "Times New Roman"
      FontEG\Name = "Times New Roman"
      FontEG\FontID = LoadFont(#FontEG, "Times New Roman", Size, 0)
      Restore Times
  EndSelect
  For j = 0 To 255
    Read vCharWidth
    FontEG\CharWidth[j] = vCharWidth
  Next
  ProcedureReturn FontEG\FontID
EndProcedure


; ===== Procedures Editor =====

Procedure Editor_GetModify(GID.l) ; Editorgadget geändert?
  If IsGadget(GID)
    ProcedureReturn GetGadgetData(GID)
  EndIf
EndProcedure

Procedure.l Editor_GetCursorPos(GID.l) 
  ; returns relative Position of Cursor 
  SendMessage_(GadgetID(GID),#EM_EXGETSEL,0,Range.CHARRANGE) 
  ProcedureReturn Range\cpMax 
EndProcedure

Procedure Editor_SetCursorPos(GID.l, CharIdx.l) 
  Range.CHARRANGE 
  Range\cpMin = CharIdx 
  Range\cpMax = CharIdx
  SendMessage_(GadgetID(GID),#EM_EXSETSEL,0,Range) 
EndProcedure 

Procedure Editor_SelectRange(GID.l, StartPos.l, EndPos.l) 
  ; Set current Range
  Range.CHARRANGE 
  Range\cpMin = StartPos
  Range\cpMax = EndPos
  SendMessage_(GadgetID(GID),#EM_EXSETSEL,0,Range) 
EndProcedure

Procedure Editor_Color(GID, Color.l) 
  format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_COLOR 
  format\crTextColor = Color 
  SendMessage_(GadgetID(GID), #EM_SETCHARFORMAT, #SCF_SELECTION, format) 
EndProcedure

Procedure Editor_Format(GID, flags)
  format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE 
  format\dwEffects = flags 
  SendMessage_(GadgetID(GID), #EM_SETCHARFORMAT, #SCF_SELECTION, format) 
EndProcedure 

Procedure LFCR_Color(GID.l, text.s, hide.b=#False)
  CPos.CHARRANGE
  SendMessage_(GadgetID(GID), #EM_EXGETSEL,0,CPos)
  SendMessage_(GadgetID(GID), #EM_HIDESELECTION, 1, 0)
  text = RemoveString(text, Chr(13))
  pos = FindString(text, Chr(182), 1)
  While pos <> 0
    Editor_SelectRange(GID, pos-1, pos)
    If hide
      Editor_Color(GID, RGB($FF,$FF,$FF))
    Else
      Editor_Color(GID, RGB($C0,$C0,$C0))
    EndIf
    pos = FindString(text, Chr(182), pos+1)
  Wend 
  SendMessage_(GadgetID(GID), #EM_EXSETSEL, 0, CPos)
  SendMessage_(GadgetID(GID), #EM_HIDESELECTION, 0, 0)
EndProcedure


; ===== Editorinhalt setzen/lesen =====

Procedure.s GetEditorText(GID.l)
  Text$ = ReplaceString(GetGadgetText(GID), #CRLF$, " ")
  Text$ = ReplaceString(Text$, Chr(182), Chr(10))
  ProcedureReturn Trim(ReplaceString(Text$, Chr(10)+" ", Chr(10)))
EndProcedure

Procedure.s SetEditorText(GID.l, text.s, w.f, maxline.w, Align.s="J", modify.b=#True, hideLF.b=#False)
  Protected s.s, c.s, pdfWs.f = 0, FontSize.f,Text$ = ""
  
  If IsGadget(GID)
    If SendMessage_(GadgetID(GID) , #EM_GETMODIFY , 0 , 0) = #False And modify
      ProcedureReturn ""
    EndIf
  Else
    ProcedureReturn "" ; Ungültiges Gadget
  EndIf

  CharIdx.l = Editor_GetCursorPos(GID) ; Cursorposition
  If modify : SetGadgetData(GID, 1) : EndIf ; Inhalt geändert
  FontSize = FontEG\Size/(72/25.4)
  wMax.f = (w-2)*1000/FontSize
  s = ReplaceString(ReplaceString(LTrim(text), #CRLF$, " "), "  ", " ") ; Text ohne Zeilenumbrüche / doppelte Leerzeichen
  s = ReplaceString(s, Chr(10), Chr(182))
  nb  = Len(s) ; Textlänge
  sep = -1 : i = 1 : j = 0 : l = 0 : ns = 0 : nl = 1 : c.s = ""
  
  While ( i < nb ) 
    
    c = Mid(s,i,1) ; Nächstes Zeichen 
    Select c ; --- aktueller Buchstabe ---
      Case Chr(182) ;{ Zeilenumbruch
        If ( pdfWs > 0 ) : pdfWs = 0 : EndIf
        Text$ + RemoveString(Trim(Mid(s,j,i-j)), Chr(182)) + Chr(182) + Chr(10)
        i = i + 1 
        sep = -1 : j = i : l = 0 : ns = 0 
        nl= nl +1 
        Continue
        ;}
      Case " " ;{ Leerzeichen
        sep = i : ls = l : ns=ns+1 
        ;}
    EndSelect
    
    l = l + FontEG\CharWidth[Asc(c)]  ; aktuelle Textbreite
    
    If l > wMax ; Textzeile zu lang
      If sep = -1 ;{ automatischer Zeilenumbruch
        If i = j : i = i +1 : EndIf  
        If pdfWs > 0 : pdfWs = 0 : EndIf 
        Text$ + Trim(Mid(s,j,i-j)) + Chr(10)
        ;}
      Else ;{ kein Umbruch
        If Align = "J" ;{ Blocksatz
          If ns > 1 
            pdfWs = (wMax-ls)/1000*FontEG\Size/(ns-1) 
          Else 
            pdfWs = 0 
          EndIf  
        EndIf ;}
        Text$ + Trim(Mid(s,j,sep-j)) + Chr(10)
        i = sep + 1
        ;}
      EndIf  
      sep = -1 : j = i : l = 0 : ns = 0 : nl = nl + 1
      If maxline > 0 And nl > maxline ;{ max. Zeilen überschritten
        If Right(Text$, 1) = Chr(10) : Text$ = Left(Text$, Len(Text$)-1) : EndIf  ; Zeilenumbruch entfernen
        SetGadgetText(GID, Text$) ; Text -> EditorGadget
        LFCR_Color(GID, Text$, hideLF) ; Zeichen für Zeilenumbruch grau bzw. weiß
        Editor_SetCursorPos(GID, CharIdx) ; Cursor auf vorherige Position
        SendMessage_(GadgetID(GID) , #EM_SETMODIFY , 0 , 0) ; Flag (Modify) zurücksetzen
        ProcedureReturn Right(s, Len(s)-i+1)
      EndIf ;}
    Else 
      i = i + 1 
    EndIf
    
  Wend
  
  If pdfWs > 0 : pdfWs = 0 : EndIf
  
  ;{ Restlicher Text
  Text$ + LTrim(Mid(s,j,i-j + 1))
  If Right(Text$, 1) = Chr(10) : Text$ = Left(Text$, Len(Text$)-1) : EndIf ; Zeilenumbruch entfernen
  SetGadgetText(GID, Text$) ; Text -> EditorGadget
  LFCR_Color(GID, Text$, hideLF) ; Zeichen für Zeilenumbruch grau bzw. weiß
  Editor_SetCursorPos(GID, CharIdx) ; Cursor auf vorherige Position
  SendMessage_(GadgetID(GID) , #EM_SETMODIFY , 0 , 0) ; Flag (modify) zurücksetzen
  ;}
  
  ProcedureReturn ""
EndProcedure


; ===== Fenster =====
OpenWindow(#Window,0,0,385,162,"WordWrap (PDF)")
CreatePopupMenu(#MenuPopUp)
MenuItem(#MenuPopUp_InsertLF, "Zeilenumbruch ( "+Chr(182)+" )") 
MenuBar()
MenuItem(#MenuPopUp_Copy, "Kopieren") 
MenuItem(#MenuPopUp_Cut, "Ausschneiden")
MenuBar()
MenuItem(#MenuPopUp_Paste, "Einfügen")
MenuBar()
MenuItem(#MenuPopUp_Del, "Löschen") 
MenuBar()
MenuItem(#MenuPopUp_Undo, "Rückgängig")
If CreateGadgetList(WindowID(#Window))
  eg = EditorGadget(#Editor,10,10,365,142)
  SendMessage_(eg, #EM_SHOWSCROLLBAR, #SB_VERT, #False)
  SendMessage_(eg, #EM_SHOWSCROLLBAR, #SB_HORZ, #False)
EndIf

SetEditorFont("Arial", 11)
SetGadgetFont(#Editor, FontEG\FontID)

Text$ = "Der Schüler hielt sich in bestimmten Situationen nicht zuverlässig genug an vereinbarte Regeln. Mit von ihm akzeptierten Schülern arbeitete er in der Regel zielgerichtet zusammen. Bei Themen, die ihn interes- sierten, beteiligte er sich aktiv am Unterrichtsge- spräch. Er schaffte es nicht immer eigene Interessen mit friedlichen Mitteln durchzusetzen. ·/·"
SetEditorText(#Editor, Text$, 96, 8, "J", #False, #False)


Repeat
  event = WaitWindowEvent()
  Select event
    Case #WM_RBUTTONDOWN ;{ Popup-Menü mit rechter Maustaste
      If GetActiveGadget() = #Editor
        DisplayPopupMenu(#MenuPopUp, WindowID(#Window))
      EndIf
      ;}
    Case #PB_Event_Menu
      Select EventMenu() ;{ PopUp-Menue
        Case #MenuPopUp_Cut
          SendMessage_(GadgetID(#Editor),#WM_CUT,0,0) 
        Case #MenuPopUp_Copy
          SendMessage_(GadgetID(#Editor),#WM_COPY,0,0) 
        Case #MenuPopUp_Paste
          SendMessage_(GadgetID(#Editor),#WM_PASTE,0,0)
        Case #MenuPopUp_Del
          SendMessage_(GadgetID(#Editor),#WM_CLEAR,0,0)
        Case #MenuPopUp_Undo
          SendMessage_(GadgetID(#Editor),#WM_UNDO,0,0)
        Case #MenuPopUp_InsertLF ; Manueller Zeilenumbruch
          Debug "--- Umbruch ---"
          SendMessage_(GadgetID(#Editor), #EM_REPLACESEL, 0, Chr(182))
      EndSelect ;}
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Editor
          If GetActiveGadget() = #Editor
            cut$ = SetEditorText(#Editor, GetGadgetText(#Editor), 96, 8, "J", #True, #False)
            If cut$ ; Text zu lang
              MessageRequester(" WordWrap (PDF)", "Der Text ist zu lang."+Chr(10)+"Der überschüssige Text wurde in die Zwischenablage verschoben.  ", #MB_OK|#MB_ICONWARNING)
              SetClipboardText(Trim(cut$))
            EndIf
          EndIf
      EndSelect
  EndSelect
Until event = 16 
; ===== PurePDF =====
pdf_Create()
pdf_AddPage()
Debug FontEG\Name + " " +Str(FontEG\Size)
pdf_SetFont(FontEG\Name, "", FontEG\Size)
pdf_MultiCell(96,5,GetEditorText(#Editor), 1, #PDF_ALIGN_JUSTIFIED)
Debug "Save PDF"
pdf_Save("ausgabe.pdf")
Debug "Show PDF"
RunProgram("ausgabe.pdf")
; ===================
CloseWindow(#Window)

DataSection
Helvetica:
Data.w  278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278
Data.w  278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 355, 556
Data.w  556, 889, 667, 191, 333, 333, 389, 584, 278, 333, 278, 278, 556, 556, 556, 556, 556, 556
Data.w  556, 556, 556, 556, 278, 278, 584, 584, 584, 556,1015, 667, 667, 722, 722, 667, 611, 778
Data.w  722, 278, 500, 667, 556, 833, 722, 778, 667, 778, 722, 667, 611, 722, 667, 944, 667, 667
Data.w  611, 278, 278, 278, 469, 556, 333, 556, 556, 500, 556, 556, 278, 556, 556, 222, 222, 500
Data.w  222, 833, 556, 556, 556, 556, 333, 500, 278, 556, 500, 722, 500, 500, 500, 334, 260, 334
Data.w  584, 350, 556, 350, 222, 556, 333,1000, 556, 556, 333,1000, 667, 333,1000, 350, 611, 350
Data.w  350, 222, 222, 333, 333, 350, 556,1000, 333,1000, 500, 333, 944, 350, 500, 667, 278, 333
Data.w  556, 556, 556, 556, 260, 556, 333, 737, 370, 556, 584, 333, 737, 333, 400, 584, 333, 333
Data.w  333, 556, 537, 278, 333, 333, 365, 556, 834, 834, 834, 611, 667, 667, 667, 667, 667, 667
Data.w 1000, 722, 667, 667, 667, 667, 278, 278, 278, 278, 722, 722, 778, 778, 778, 778, 778, 584
Data.w  778, 722, 722, 722, 722, 667, 667, 611, 556, 556, 556, 556, 556, 556, 889, 500, 556, 556
Data.w  556, 556, 278, 278, 278, 278, 556, 556, 556, 556, 556, 556, 556, 584, 611, 556, 556, 556
Data.w  556, 500, 556, 500
Times:
Data.w  250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250
Data.w  250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 250, 333, 408, 500
Data.w  500, 833, 778, 180, 333, 333, 500, 564, 250, 333, 250, 278, 500, 500, 500, 500, 500, 500
Data.w  500, 500, 500, 500, 278, 278, 564, 564, 564, 444, 921, 722, 667, 667, 722, 611, 556, 722
Data.w  722, 333, 389, 722, 611, 889, 722, 722, 556, 722, 667, 556, 611, 722, 722, 944, 722, 722
Data.w  611, 333, 278, 333, 469, 500, 333, 444, 500, 444, 500, 444, 333, 500, 500, 278, 278, 500
Data.w  278, 778, 500, 500, 500, 500, 333, 389, 278, 500, 500, 722, 500, 500, 444, 480, 200, 480
Data.w  541, 350, 500, 350, 333, 500, 444,1000, 500, 500, 333,1000, 556, 333, 889, 350, 611, 350
Data.w  350, 333, 333, 444, 444, 350, 500,1000, 333, 980, 389, 333, 722, 350, 444, 722, 250, 333
Data.w  500, 500, 500, 500, 200, 500, 333, 760, 276, 500, 564, 333, 760, 333, 400, 564, 300, 300
Data.w  333, 500, 453, 250, 333, 300, 310, 500, 750, 750, 750, 444, 722, 722, 722, 722, 722, 722
Data.w  889, 667, 611, 611, 611, 611, 333, 333, 333, 333, 722, 722, 722, 722, 722, 722, 722, 564
Data.w  722, 722, 722, 722, 722, 722, 556, 500, 444, 444, 444, 444, 444, 444, 667, 444, 444, 444
Data.w  444, 444, 278, 278, 278, 278, 500, 500, 500, 500, 500, 500, 500, 564, 500, 500, 500, 500
Data.w  500, 500, 500, 500
EndDataSection
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild