PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

RichEdit Funktionen (OOP): Jetzt mit ImageSupport

https://www.purebasic.fr/german/viewtopic.php?t=24582

Seite 1 von 5

RichEdit Funktionen (OOP): Jetzt mit ImageSupport

Verfasst: 18.07.2011 06:51
von ts-soft
Ich hab mal die RichText Funktionen, die hier, im engl. Forum sowie im CodeArchiv rumfliegen
zu einer Include in OOP form gepresst und aktualisiert.

Dies ist eine Vorbereitung für eines meiner nächsten Projekte, sollte aber auch für andere nützlich sein.

Code: Alles auswählen

;======================================================================
; Library:         RichEdit.pbi
; 
; Author:          Thomas (ts-soft) Schulz
; Co-Author:       Michael (neotoma) Taupitz
; Offcut:          Stolen from: freak, danilo, srod, andreas and others
;                  from PB-Forums and CodeArchiv
; Date:            July 18, 2011
; Version:         1.6
; Target Compiler: PureBasic 4.5+
; Target OS:       Windows
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;======================================================================
; Historie:
; Version 1.1, July 19, 2011
; added: Redo(), GetText()

; Version 1.2
; added: insertflag for LoadRTF(), LoadText()
; added: better Unicode-Support for LoadText(), SaveText()
; added: GetSelText(), FindText()
; changed: SetBackColor() for better compatibility with GadgetFunctions

; Version 1.3
; added: SetAlignment()

; Version 1.4, July 20, 2011
; added: SetLeftMargin(), SetRightMargin()

; Version 1.5
; added: GetFont(), GetFontSize(), GetFontStyle()

; Version 1.6, July 21, 2011 (neotoma)
; added: SelectAll(), Unselect(), Indent(), Outdent()
; added: ClearBackColor(), DisableRedraw(), IsTextSelected()
; added: GetZoom(), SetZoom(), CountWords(), GetRTFText()
;
; Version 1.7, July 25, 2011 (neotoma)
; added: GetTextBackColor(), SetTextBackColor(), ClearTextBackColor()
; added: ScrollToLine(), GetParagraphAlign(), GetLineSpacing()
; added: SetLineSpacing.(), IsModified(), SetModified(), IsLink()
; added: GetWordUnderCursor(), GetCurrentWord()
; added: Replace(), ReplaceAll(), SetBulleted(), GetLineCount()  
; added: IsSuperscript(), SetSuperscript(), IsSubscript()
; added: SetSubscript(),ChangeFontSize(), LimitText()
; added: HideSelection(),SetUnderlineWave(),ClearUnderlineWave()
; added: Redraw(), GetTextLength(), GetTextColor()
; added: IsSmallCaps(), SetSmallCaps(),IsAllCaps(), SetAllCaps()
; added: CanPaste(), GetCursorPosition(), GetWordAtPosition()
; added: GetFirstVisibleLineNumber(), GetFirstVisibleLinePos()
; added: GetLastVisibleLineNumber(), GetLastVisibleLinePos()
; added: GetLastVisibleLineText(), GetCharPosOfPreviousWord()
; added: GetCharPosOfNextWord(), EmptyUndoBuffer()
; added: GetFirstCharPosOnLine(), GetLineLength()
; added: IsALignLeft(), IsAlignCenter(), IsAlignRight() 

; Version 1.8, July 31, 2011 (neotoma)
; added: IsAlignJustify(),GetWordUnderCursorStart(), GetWordUnderCursorEnd()
; added: GetScrollPosX(), GetScrollPosY(),SetScrollPos(), SetLink()
; added: SetUndoLimit()
; modified : GetWordAtPosition(), GetWordUnderCursor()
; added again: SetTextBackColor()
; added: AppendText()
; 
;======================================================================

#CFM_BACKCOLOR = $4000000
#CFE_AUTOBACKCOLOR = #CFM_BACKCOLOR
#ENM_LINK = $04000000
#CFM_LINK = $00000020
#CFE_LINK = $0020
#CFE_SUBSCRIPT = $00010000
#CFE_SUPERSCRIPT = $00020000
#CFM_SUBSCRIPT = #CFE_SUBSCRIPT | #CFE_SUPERSCRIPT
#CFM_SUPERSCRIPT=#CFM_SUBSCRIPT
#PFA_JUSTIFY = 4  ;New paragraph-alignment option 2.0

#CFM_ALLCAPS    = $80
#CFE_ALLCAPS    = #CFM_ALLCAPS
#CFM_SMALLCAPS  = $40
#CFE_SMALLCAPS  = #CFM_SMALLCAPS

#ST_DEFAULT = 0
#ST_KEEPUNDO = 1
#ST_SELECTION = 2


Interface RichEdit
  Free(); gibt das Gadget und den Objektspeicher frei
  GetID.i(); gibt die PB ID zurück
  GethWnd.i(); gibt das OS-Handle zurück
  GetX.i(); X-Koordinate
  GetY.i(); Y-Koordinate
  GetWidth.i(); Editorbreite
  GetHeight.i(); Editorhöhe
  GetReadOnly.i(); ermitteln ob ReadOnly oder nicht
  GetCursorX.i(); Zeile der Schreibmarke
  GetCursorY.i(); Spalte der Schreibmarke
  GetFont.s()
  GetFontSize.i()
  GetFontStyle.l()
  GetZoom.i(); Gibt Zoom in Prozent zurück
  Resize(x.l, y.l, w.l, h.l)
  DisableRedraw.i(bVal.i = #True); Verhindert das Neuzeichnen des Editor
  Clear(); Editor leeren
  GetText.s()
  GetRTFText.s(); Gibt den RTF-Stream als String zurück
  GetSelText.s()
  FindText.i(Text.s, Flags.l = #FR_DOWN); Flags: #FR_DOWN, #FR_MATCHCASE, #FR_WHOLEWORD
  CountWords.i()
  Cut()
  Copy()
  Paste()
  BeginUndo(); startet die Undo-Aufzeichnung
  StopUndo(); beendet die Undo-Aufzeichnung
  CanUndo.i()
  Undo()
  Redo()
  LoadRTF(FileName.s, insert.l = #False)
  LoadText(FileName.s, insert.l = #False)
  SaveRTF(FileName.s)
  SaveText(FileName.s)
  Print(DocName.s = "pbprint", dialog.i = #False)
  SetFont.i(Name.s)
  SetFontSize.i(Size.l)
  SetFontStyle.i(Style.l = 0)
  SetZoom.i(zoom.i); Setzt Zoom (in Prozent)
  SetAlignment(Flag.l = #PB_Default); #PB_Text_Center, #PB_Text_Right
  SetLeftMargin(pixel.w)
  SetRightMargin(pixel.w)  
  SetCtrlBackColor.i(Color.l)
  SetTextBackColor.i(Color.l)
  GetTextBackColor.i()
  ClearTextBackColor.i()  
  SetTextColor.i(ForeColor.l, BackColor.l = #PB_Default)
  SetSelection.i(LineStart.l, CharStart.l, LineEnd.l = #PB_Default, CharEnd.l = #PB_Default)
  IsTextSelected.i(); #True, wenn eine Selektion vorhanden ist
  SetText.i(Text.s); fügt Text an cursorposition ein, bzw. ersetzt selektion
  SetReadOnly.i(Flag.l); ReadOnly setzen oder entfernen
  SetCursorPos.i(x.l, y.l); Schreibmarke setzen
  SetWordWrap.i(Flag.l); schaltet Zeilenumbruch (standard) ein oder aus
  SelectAll.i(); Selektiert den ganzen Text
  Unselect()
  Indent.i(mm.i = 10); Einrückung in mm (nach rechts)
  Outdent.i(mm.i = 10); Ausrückung in mm (nach links)  
  ScrollToLine(line.i)
  GetParagraphAlign.l()
  GetLineSpacing.f()
  SetLineSpacing.i(vInter.f)
  IsModified.i()
  SetModified.i()
  IsLink.i()                          ;; Weil GetFontStyle nur die PB-KOnstanten unterstützt, aber für Links keine vorhanden list  
  GetWordUnderMouse.s(x.i, y.i)       ; x,y = Mouseposition relativ zum Gadget !!!
  GetCurrentWord.s()    
  Replace.i(ToReplace.s, Text.s, Flags.i = 0)
  ReplaceAll.i(ToReplace.s, Text.s, Flags.i = 0)
  SetBulleted.i()  
  GetLineCount.i()  
  IsSuperscript()
  SetSuperscript()
  IsSubscript()
  SetSubscript()
  ChangeFontSize(iDelta.i=1)
  LimitText(iLimitTo.i)
  HideSelection(bVal.i=#True)
  SetUnderlineWave()
  ClearUnderlineWave()
  Redraw()
  GetTextLength()
  GetTextColor()
  IsSmallCaps()
  SetSmallCaps(bVal.i = #True)
  IsAllCaps()
  SetAllCaps(bVal.i = #True)
  CanPaste()
  GetCursorPosition()
  GetWordAtPosition.s(Pos.i)
  GetFirstVisibleLineNumber.i()
  GetFirstVisibleLinePos.i()
  GetFirstVisibleLineText.s()
  GetLastVisibleLineNumber.i()  
  GetLastVisibleLinePos.i()
  GetLastVisibleLineText.s()  
  GetCharPosOfPreviousWord.i(Pos.i)
  GetCharPosOfNextWord.i( Pos.i )
  EmptyUndoBuffer()
  GetFirstCharPosOnLine(iLine.i)  
  GetLineLength(iLine.i)
  IsAlignLeft()
  IsAlignCenter()
  IsAlignRight()
  IsAlignJustify() 
  GetWordUnderCursorStart()
  GetWordUnderCursorEnd()
  GetScrollPosX()
  GetScrollPosY()
  SetScrollPos(x.i, y.i)
  SetLink(bVal = #True)
  SetUndoLimit(Limit.i)  
  AppendText(Text.s)   ; appends Text at the end
  
EndInterface

Structure RichEditClassTemplate
  *vTable
  ID.i
  hWnd.i
  TextInterface.ITextDocument
  RTFStreamTextResult.s; Wenn der 'RTF'-Steam in einen String gelesen werden soll
  TwipsPeSpaceUnit.f
  WordUnderCursorRange.CHARRANGE
EndStructure

ProcedureDLL.i New_RichEdit(x.l, y.l, w.l, h.l)
  Protected *obj.RichEditClassTemplate
  Protected RichEditOleObject.IRichEditOle
  
  *obj = AllocateMemory(SizeOf(RichEditClassTemplate))
  If *obj
    With *obj
      \vTable = ?vTable_RichEditClassTemplate
      \ID = EditorGadget(#PB_Any, x, y, w, h)
      \hWnd = GadgetID(\ID)
      SetGadgetColor(\ID, #PB_Gadget_BackColor, #White)
      SetGadgetFont(\ID, FontID(LoadFont(#PB_Any, "Arial", 10)))
      SendMessage_(\hWnd, #EM_SETEVENTMASK, 0, #ENM_KEYEVENTS | #ENM_MOUSEEVENTS | #ENM_SELCHANGE | #ENM_CHANGE | #ENM_LINK)      
      SendMessage_(\hWnd, #EM_SETTARGETDEVICE, 0, 0)
      SendMessage_(\hWnd, #EM_GETOLEINTERFACE, 0, @RichEditOleObject)
      SendMessage_(\hWnd, #EM_AUTOURLDETECT  , #True, 0)      
      If RichEditOleObject
        RichEditOleObject\QueryInterface(?IID_ITextDocument, @\TextInterface)
        RichEditOleObject\Release()
      EndIf
      SendMessage_(\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0) 
      SetActiveGadget(\ID)
    EndWith
  EndIf
  
  ProcedureReturn *obj
EndProcedure

Procedure RichEdit_Free(*this.RichEditClassTemplate)
  FreeGadget(*this\ID)
  FreeMemory(*this)
EndProcedure

Procedure.i RichEdit_GetID(*this.RichEditClassTemplate)
  ProcedureReturn *this\ID
EndProcedure

Procedure.i RichEdit_GethWnd(*this.RichEditClassTemplate)
  ProcedureReturn *this\hWnd
EndProcedure

Procedure.i RichEdit_GetX(*this.RichEditClassTemplate)
  ProcedureReturn GadgetX(*this\ID)
EndProcedure

Procedure.i RichEdit_GetY(*this.RichEditClassTemplate)
  ProcedureReturn GadgetY(*this\ID)
EndProcedure

Procedure.i RichEdit_GetWidth(*this.RichEditClassTemplate)
  ProcedureReturn GadgetWidth(*this\ID)
EndProcedure

Procedure.i RichEdit_GetHeight(*this.RichEditClassTemplate)
  ProcedureReturn GadgetHeight(*this\ID)
EndProcedure

Procedure.i RichEdit_GetReadOnly(*this.RichEditClassTemplate)
  Protected Style.l = GetWindowLongPtr_(*this\hWnd, #GWL_STYLE)
  If Style & #ES_READONLY : ProcedureReturn #True : EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i RichEdit_GetCursorX(*this.RichEditClassTemplate)
  Protected.CHARRANGE Range

  
  SendMessage_(*this\hWnd, #EM_EXGETSEL, 0, @Range)
  ProcedureReturn Range\cpMax - (SendMessage_(*this\hWnd, #EM_LINEINDEX, SendMessage_(*this\hWnd, #EM_EXLINEFROMCHAR, 0, Range\cpMin), 0)) + 1
EndProcedure

Procedure.i RichEdit_GetCursorY(*this.RichEditClassTemplate)
  Protected.CHARRANGE Range
  
  SendMessage_(*this\hWnd, #EM_EXGETSEL, 0, @Range)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_EXLINEFROMCHAR, 0, Range\cpMin) + 1 
EndProcedure

Procedure.s RichEdit_GetFont(*this.RichEditClassTemplate)
  Protected.CHARFORMAT2 Format
  Protected Font.s
  
  Format\cbSize = SizeOf(CHARFORMAT2)
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @Format)
  Font = PeekS(@Format\szFaceName[0])
  If Font = ""
    SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, #SCF_DEFAULT, @Format)
    Font = PeekS(@Format\szFaceName[0])
  EndIf
  ProcedureReturn Font
EndProcedure

Procedure.i RichEdit_GetFontSize(*this.RichEditClassTemplate)
  Protected.CHARFORMAT2 Format
  
  Format\cbSize = SizeOf(CHARFORMAT2)
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @Format)
  ProcedureReturn Format\yHeight / 20
EndProcedure

Procedure.l RichEdit_GetFontStyle(*this.RichEditClassTemplate)
  Protected.CHARFORMAT2 Format
  Protected Result.l = 0
  
  With Format
    \cbSize = SizeOf(CHARFORMAT2)
    \dwMask = #CFM_BOLD | #CFM_ITALIC | #CFM_STRIKEOUT | #CFM_UNDERLINE
  EndWith
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @Format)
  If Format\dwEffects & #CFM_BOLD
    Result | #PB_Font_Bold
  EndIf
  If Format\dwEffects & #CFM_ITALIC
    Result | #PB_Font_Italic
  EndIf
  If Format\dwEffects & #CFM_STRIKEOUT
    Result | #PB_Font_StrikeOut
  EndIf
  If Format\dwEffects & #CFM_UNDERLINE
    Result | #PB_Font_Underline
  EndIf

  ProcedureReturn Result
EndProcedure

Procedure.i RichEdit_GetZoom(*this.RichEditClassTemplate)
  Protected wParam.l, hParam.l, result.l
  result =  SendMessage_(*this\hWnd, #EM_GETZOOM, @wParam, @hParam)
  ProcedureReturn Int((wParam * 100) / hParam )
EndProcedure

Procedure RichEdit_Resize(*this.RichEditClassTemplate, x.l, y.l, w.l, h.l)
  ResizeGadget(*this\ID, x, y, w, h)
EndProcedure

Procedure.i RichEdit_DisableRedraw(*this.RichEditClassTemplate, bVal.i = #True)
; Description .......:  When performing several actions, or actions on text that
;                       is not currently in the visible window, or when changing
;                       selections repeatedly - an EditorGadget may flicker.
;                       Disabling the Gadget with WM_SetReDraw before taking
;                       actions, then turning enabling it after the actions have
;                       been taken can significantly improve performance..
;
; Parameter(s) ......:  bVal      - #True (default) to Disable Redraw
;                                 - #False to Enable / reenable Redraw

  ProcedureReturn SendMessage_(*this\hWnd, #WM_SETREDRAW, 1 ! bVal, 0)
EndProcedure

Procedure RichEdit_Clear(*this.RichEditClassTemplate)
  ClearGadgetItems(*this\ID)
  SendMessage_(*this\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0)
EndProcedure

Procedure.s RichEdit_GetText(*this.RichEditClassTemplate)
  ProcedureReturn GetGadgetText(*this\ID)
EndProcedure

Procedure.i RichEdit_GetRTFStreamCallback(dwCookie, *pbBuff, cb, *pcb.Long)  
  Protected *this.RichEditClassTemplate = dwCookie  
  *this\RTFStreamTextResult + PeekS(*pbBuff, cb)
  *pcb\l = cb
  ProcedureReturn 0
EndProcedure

Procedure.s RichEdit_GetRTFText(*this.RichEditClassTemplate)
  Protected stream.EDITSTREAM
  
  stream\dwCookie = *this
  stream\pfnCallback = @RichEdit_GetRTFStreamCallback()
  
  SendMessage_(*this\hWnd, #EM_STREAMOUT, #SF_RTF | #SFF_PLAINRTF, @stream)
  
  ProcedureReturn *this\RTFStreamTextResult
EndProcedure

Procedure.s RichEdit_GetSelText(*this.RichEditClassTemplate)
  Protected startpos.l, endpos.l, size.l, *mem, result.s
  
  If SendMessage_(*this\hWnd, #EM_GETSEL, @startpos, @endpos)
    size = endpos - startpos + 1
    size * SizeOf(Character)
    *mem = AllocateMemory(size)
    If *mem
      SendMessage_(*this\hWnd, #EM_GETSELTEXT, 0, *mem)
      result = PeekS(*mem)
      FreeMemory(*mem)
    EndIf
  EndIf
  
  ProcedureReturn result
EndProcedure

Procedure.i RichEdit_FindText(*this.RichEditClassTemplate, Text.s, Flags.l = #FR_DOWN)
  Protected.FINDTEXTEX StringToSearch
  Protected.l CurrentCursorPosition
  
  If Text <> ""
    SendMessage_(*this\hWnd, #EM_GETSEL, @CurrentCursorPosition, 0)
    With StringToSearch
      \chrg\cpMin = CurrentCursorPosition
      \chrg\cpMax = GetWindowTextLength_(*this\hWnd)
      \lpstrText = @Text
    EndWith
    If SendMessage_(*this\hWnd, #EM_FINDTEXTEX, Flags, @StringToSearch) <> -1
      SendMessage_(*this\hWnd, #EM_SETSEL, StringToSearch\chrgText\cpMin, StringToSearch\chrgText\cpMax)
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i RichEdit_CountWords(*this.RichEditClassTemplate)
  Protected text.s = GetGadgetText(*this\ID)
  Protected count.i = 0
  Protected lastWasWordChar.i = 0
  Protected *p.CHARACTER
  
  If Len(Trim(text)) = 0 : ProcedureReturn 0 : EndIf  
  *p = @text
  While *p\c <> 0
    If *p\c = ' ' Or *p\c = 9 Or *p\c = 10 Or *p\c = 13
      If lastWasWordChar
        If lastWasWordChar > 1
          count + 1
        EndIf
        lastWasWordChar = 0
      EndIf
    Else
      lastWasWordChar + 1
    EndIf
    
    *p + SizeOf(CHARACTER)
  Wend
  
  If Not lastWasWordChar : count - 1 : EndIf
  
  ProcedureReturn count + 1
EndProcedure

Procedure RichEdit_Cut(*this.RichEditClassTemplate)
  SendMessage_(*this\hWnd, #WM_CUT, 0, 0) 
EndProcedure

Procedure RichEdit_Copy(*this.RichEditClassTemplate)
  SendMessage_(*this\hWnd, #WM_COPY, 0, 0) 
EndProcedure

Procedure RichEdit_Paste(*this.RichEditClassTemplate)
  SendMessage_(*this\hWnd, #WM_PASTE, 0, 0) 
EndProcedure

Procedure RichEdit_BeginUndo(*this.RichEditClassTemplate)
  If *this\TextInterface
    *this\TextInterface\Undo(-9999994, 0)
  EndIf
EndProcedure

Procedure RichEdit_StopUndo(*this.RichEditClassTemplate)
  If *this\TextInterface
    *this\TextInterface\Undo(-9999995, 0)
  EndIf
EndProcedure

Procedure.i RichEdit_CanUndo(*this.RichEditClassTemplate)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_CANUNDO, 0, 0)
EndProcedure

Procedure RichEdit_Undo(*this.RichEditClassTemplate)
  SendMessage_(*this\hWnd, #EM_UNDO, 0, 0)
EndProcedure

Procedure RichEdit_Redo(*this.RichEditClassTemplate)
  SendMessage_(*this\hWnd, #EM_REDO, 0, 0)
EndProcedure

Procedure RichEdit_StreamInCallback(dwCookie, *pbBuff, cb, *pcb.Long)
  Protected length.q
  
  length = Lof(dwCookie) - Loc(dwCookie)
  If length > cb
    ReadData(dwCookie, *pbBuff, cb)
    *pcb\l = cb
  Else
    ReadData(dwCookie, *pbBuff, length)
    *pcb\l = length
  EndIf
  
  ProcedureReturn 0
EndProcedure

Procedure RichEdit_StreamOutCallback(dwCookie, *pbBuff, cb, *pcb.Long)

  WriteData(dwCookie, *pbBuff, cb)
  *pcb\l = cb
  
  ProcedureReturn 0
EndProcedure

Procedure RichEdit_LoadRTF(*this.RichEditClassTemplate, FileName.s, insert.l = #False)
  Protected.EDITSTREAM stream
  Protected Flag.l = #SF_RTF
  
  If insert : Flag | #SFF_SELECTION : EndIf
  
  With stream
    \dwCookie = ReadFile(#PB_Any, FileName)
    If \dwCookie
      \pfnCallback = @RichEdit_StreamInCallback()
      SendMessage_(*this\hWnd, #EM_STREAMIN, Flag, @stream)
      CloseFile(\dwCookie)
      SendMessage_(*this\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0) 
    EndIf
  EndWith
EndProcedure

Procedure RichEdit_LoadText(*this.RichEditClassTemplate, FileName.s, insert.l = #False)
  Protected.EDITSTREAM stream
  Protected Flag.l = #SF_TEXT
  
  If insert : Flag | #SFF_SELECTION : EndIf
  CompilerIf #PB_Compiler_Unicode : Flag | #SF_UNICODE : CompilerEndIf
  
  With stream
    \dwCookie = ReadFile(#PB_Any, FileName)
    If \dwCookie
      \pfnCallback = @RichEdit_StreamInCallback()
      SendMessage_(*this\hWnd, #EM_STREAMIN, Flag, @stream)
      CloseFile(\dwCookie)
      SendMessage_(*this\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0) 
    EndIf
  EndWith
EndProcedure

Procedure RichEdit_SaveRTF(*this.RichEditClassTemplate, FileName.s)
  Protected.EDITSTREAM stream
  
  With stream
    \dwCookie = CreateFile(#PB_Any, FileName)
    If \dwCookie
      \pfnCallback = @RichEdit_StreamOutCallback()
      SendMessage_(*this\hWnd, #EM_STREAMOUT, #SF_RTF, @stream)
      CloseFile(\dwCookie)
      SendMessage_(*this\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0) 
    EndIf
  EndWith
EndProcedure

Procedure RichEdit_SaveText(*this.RichEditClassTemplate, FileName.s)
  Protected.EDITSTREAM stream
  Protected Flag.l = #SF_TEXT
  
  CompilerIf #PB_Compiler_Unicode : Flag | #SF_UNICODE : CompilerEndIf
  
  With stream
    \dwCookie = CreateFile(#PB_Any, FileName)
    If \dwCookie
      \pfnCallback = @RichEdit_StreamOutCallback()
      SendMessage_(*this\hWnd, #EM_STREAMOUT, Flag, @stream)
      CloseFile(\dwCookie)
      SendMessage_(*this\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0) 
    EndIf
  EndWith
EndProcedure

Procedure RichEdit_Print(*this.RichEditClassTemplate, DocName.s = "pbprint", dialog.i = #False)
  Protected.PRINTDLG lppd
  Protected.RECT cRect
  Protected.FORMATRANGE FormatRange 
  Protected.Docinfo Docinfo
  Protected LastChar.l, MaxLen.l, OldMapMode.l, OffsetX.l, OffsetY.l, HorzRes.l, VertRes.l
  Protected DC.i, i.i = 1
  
  If dialog
    lppd\lStructsize = SizeOf(PRINTDLG)
    lppd\Flags = #PD_ALLPAGES | #PD_HIDEPRINTTOFILE | #PD_NOSELECTION | #PD_RETURNDC
    PrintDlg_(@lppd)
    DC = lppd\hDC
  Else
    DC = DefaultPrinter()
  EndIf
  
  Docinfo\cbSize = SizeOf(Docinfo) 
  Docinfo\lpszDocName = @DocName 

  StartDoc_(DC, Docinfo) 

  MaxLen = Len(GetGadgetText(*this\ID)) - SendMessage_(*this\hWnd, #EM_GETLINECOUNT, 0, 0) 
  OldMapMode = GetMapMode_(DC) 
  SetMapMode_(DC, #MM_TWIPS) 
  OffsetX = GetDeviceCaps_(DC, #PHYSICALOFFSETX) 
  OffsetY = - GetDeviceCaps_(DC, #PHYSICALOFFSETY) 
  HorzRes = GetDeviceCaps_(DC, #HORZRES) 
  VertRes = - GetDeviceCaps_(DC, #VERTRES) 
  SetRect_(cRect, OffsetX, OffsetY, HorzRes, VertRes) 
  DPtoLP_(DC, cRect, 2) 
  SetMapMode_(DC, OldMapMode) 
  FormatRange\hDC = DC 
  FormatRange\hdcTarget = DC 
  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 
  
  Repeat 
    StartPage_(DC) 
    FormatRange\chrg\cpMax = - 1 
    LastChar = SendMessage_(*this\hWnd, #EM_FORMATRANGE, #True, @FormatRange) 
    FormatRange\chrg\cpMin = LastChar 
    SendMessage_(*this\hWnd, #EM_DISPLAYBAND, 0, cRect) 
    i + 1 
    EndPage_(DC) 
  Until LastChar >= MaxLen Or LastChar = -1 

  EndDoc_(DC) 
  SendMessage_(*this\hWnd, #EM_FORMATRANGE, 0, 0)   
EndProcedure

Procedure.i RichEdit_SetFont(*this.RichEditClassTemplate, Name.s)
  Protected.CHARFORMAT Format
  
  With Format
    \cbSize = SizeOf(CHARFORMAT)
    \dwMask = #CFM_FACE
    PokeS(@\szFaceName[0], Name)
  EndWith
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure

Procedure.i RichEdit_SetFontSize(*this.RichEditClassTemplate, Size.l)
  Protected.CHARFORMAT Format
  
  With Format
    \cbSize = SizeOf(CHARFORMAT)
    \dwMask = #CFM_SIZE
    \yHeight = Size * 20
  EndWith
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure

Procedure RichEdit_SetFontStyle(*this.RichEditClassTemplate, Style.l = 0)
  Protected Format.CHARFORMAT
  Protected Flags.l = 0
  
  If Style & #PB_Font_Bold : Flags | #CFM_BOLD : EndIf
  If Style & #PB_Font_Italic : Flags | #CFM_ITALIC : EndIf
  If Style & #PB_Font_StrikeOut : Flags | #CFM_STRIKEOUT : EndIf
  If Style & #PB_Font_Underline : Flags | #CFM_UNDERLINE : EndIf
  
  With Format
    \cbSize = SizeOf(CHARFORMAT)
    \dwMask = #CFM_ITALIC | #CFM_BOLD | #CFM_STRIKEOUT | #CFM_UNDERLINE
    \dwEffects = Flags
  EndWith
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure

Procedure.i RichEdit_SetZoom(*this.RichEditClassTemplate, zoom.i)  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETZOOM, zoom, 100)
EndProcedure

Procedure.i RichEdit_SetAlignment(*this.RichEditClassTemplate, Flag.l = #PB_Default)
  Protected.PARAFORMAT Format
  
  Select Flag
    Case #PB_Text_Center : Flag = #PFA_CENTER
    Case #PB_Text_Right : Flag = #PFA_RIGHT
    Default : Flag = #PFA_LEFT
  EndSelect
  
  With Format
    \cbSize = SizeOf(PARAFORMAT)
    \dwMask = #PFM_ALIGNMENT
    \wAlignment = Flag
  EndWith
  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETPARAFORMAT, 0, @Format)
EndProcedure

Procedure RichEdit_SetLeftMargin(*this.RichEditClassTemplate, pixel.w)
  SendMessage_(*this\hWnd, #EM_SETMARGINS, #EC_LEFTMARGIN, $FFFF + pixel)
EndProcedure

Procedure RichEdit_SetRightMargin(*this.RichEditClassTemplate, pixel.w)
  SendMessage_(*this\hWnd, #EM_SETMARGINS, #EC_RIGHTMARGIN, $FFFF * pixel)
EndProcedure

Procedure.i RichEdit_SetCtrlBackColor(*this.RichEditClassTemplate, Color.l)
  ProcedureReturn SetGadgetColor(*this\ID, #PB_Gadget_BackColor, Color)
EndProcedure

Procedure.i RichEdit_SetTextBackColor(*this.RichEditClassTemplate, Color.l)  
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\crBackColor = Color
  SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)  
EndProcedure

Procedure.i RichEdit_SetTextColor(*this.RichEditClassTemplate, ForeColor.l, BackColor.l = #PB_Default)
  Protected.CHARFORMAT2 Format

  With Format
    \cbSize = SizeOf(CHARFORMAT2)
    \dwMask = #CFM_COLOR | #CFM_BACKCOLOR
    \crTextColor = ForeColor
    If BackColor = #PB_Default
      \crBackColor = GetGadgetColor(*this\ID, #PB_Gadget_BackColor)
    Else
      \crBackColor = BackColor      
    EndIf
  EndWith
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)
EndProcedure

Procedure.i RichEdit_GetTextBackColor(*this.RichEditClassTemplate)
  Protected retColor.i = #White  
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)  
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT,0, @format)  
  ; Is AutoColor?
  If (format\dwEffects & #CFE_AUTOBACKCOLOR) = #CFE_AUTOBACKCOLOR
    retColor = GetSysColor_(#COLOR_WINDOW)
  Else
    retColor = format\crBackColor  
  EndIf  
  ProcedureReturn retColor
EndProcedure  

Procedure.i RichEdit_ClearTextBackColor(*this.RichEditClassTemplate)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)
  format\dwMask = #CFM_BACKCOLOR
  format\dwEffects = #CFE_AUTOBACKCOLOR
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i RichEdit_SetSelection(*this.RichEditClassTemplate, LineStart.l, CharStart.l, LineEnd.l = #PB_Default, CharEnd.l = #PB_Default)
  Protected.CHARRANGE sel
  Protected.i hWnd = *this\hWnd
  
  With sel
    \cpMin = SendMessage_(hWnd, #EM_LINEINDEX, LineStart, 0) + CharStart - 1
    
    If LineEnd = #PB_Default
      LineEnd = SendMessage_(hWnd, #EM_GETLINECOUNT, 0, 0) - 1
    EndIf
    \cpMax = SendMessage_(hWnd, #EM_LINEINDEX, LineEnd, 0)
    
    If CharEnd = #PB_Default
      \cpMax + SendMessage_(hWnd, #EM_LINELENGTH, \cpMax, 0)
    Else
      \cpMax + CharEnd - 1
    EndIf
  EndWith
  ProcedureReturn SendMessage_(hWnd, #EM_EXSETSEL, 0, @sel)
EndProcedure

Procedure.i RichEdit_IsTextSelected(*this.RichEditClassTemplate)
  Protected cr.CHARRANGE
  SendMessage_(*this\hWnd, #EM_EXGETSEL, 0, @cr)
  If cr\cpMin <> cr\cpMax
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i RichEdit_SetText(*this.RichEditClassTemplate, Text.s)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_REPLACESEL, 0, Text) 
EndProcedure

Procedure.i RichEdit_SetReadOnly(*this.RichEditClassTemplate, Flag.l)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETREADONLY, Flag, 0)
EndProcedure

Procedure.i RichEdit_SetCursorPos(*this.RichEditClassTemplate, x.l, y.l)
  Protected.CHARRANGE Range
  Protected.l char, lenght
  
  char = SendMessage_(*this\hWnd, #EM_LINEINDEX, y - 1, 0)
  lenght = SendMessage_(*this\hWnd, #EM_LINELENGTH, char, 0)
  If lenght >= x - 1
    char + x - 1
  EndIf
  Range\cpMin = char
  Range\cpMax = char
  ProcedureReturn SendMessage_(*this\hWnd, #EM_EXSETSEL, 0, @Range) 
EndProcedure

Procedure.i RichEdit_SetWordWrap(*this.RichEditClassTemplate, Flag.l)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETTARGETDEVICE, 0, Flag | 1)
EndProcedure

Procedure.i RichEdit_SelectAll(*this.RichEditClassTemplate)
  ;Select the whole content of the editor gadget.  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETSEL, 0, -1)
EndProcedure

Procedure.i RichEdit_Unselect(*this.RichEditClassTemplate)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETSEL, -1, 0)
EndProcedure

Procedure.i RichEdit_Indent(*this.RichEditClassTemplate, mm.i = 10)
  Protected format.PARAFORMAT2
  format\cbSize = SizeOf(PARAFORMAT2)
  ;Read first
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT, 0, @format)
    
  format\dxStartIndent = Int(mm * (1440/25.4)); Millimeters right
  format\dwMask = #PFM_OFFSETINDENT
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETPARAFORMAT, 0, @format)
EndProcedure

Procedure.i RichEdit_Outdent(*this.RichEditClassTemplate, mm.i = 10)
  Protected format.PARAFORMAT2
  format\cbSize = SizeOf(PARAFORMAT2)
  ;Read first
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT, 0, @format)
    
  format\dxStartIndent = 0 - Int(mm * (1440/25.4))     ; Millimeters right
  format\dwMask = #PFM_OFFSETINDENT
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETPARAFORMAT, 0, @format)
EndProcedure

Procedure.i RichEdit_ScrollToLine(*this.RichEditClassTemplate, line.i)
  ProcedureReturn SendMessage_(*this\hWnd,#EM_LINESCROLL,#Null,line)
EndProcedure

Procedure.l RichEdit_GetParagraphAlign(*this.RichEditClassTemplate)
  ; Returns #PFA_LEFT   - Linksbündig
  ;         #PFA_CENTER - Zentriert
  ;         #PFA_Right  - Rechtsbündig
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  Protected bRet.i = #False
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)  
  ProcedureReturn paraf\wAlignment
EndProcedure

Procedure.i RichEdit_SetLineSpacing(*this.RichEditClassTemplate, vInter.f)
; Description .......:  Change Line-Spacing
;  
; Parameter(s) ......:  vInter.f  1.0 - Normal Line-Spacing
;                                 1.5 - 1.5 Line-Spacing
;                                 2.0 - 2.0 Line-Spacing
;                                 other values changes to custom spacing
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  If vInter >= 1.0
    If vInter = 1.0
      paraf\bLineSpacingRule = 0
    ElseIf vInter = 1.5
      paraf\bLineSpacingRule = 1
    ElseIf vInter = 2.0
      paraf\bLineSpacingRule = 2
    Else
      paraf\bLineSpacingRule = 5 ; spacing in lines
      paraf\dyLineSpacing = Int(vInter * 20)
    EndIf
    paraf\dwMask = #PFM_LINESPACING
    SendMessage_(*this\hWnd, #EM_SETPARAFORMAT,0, @paraf)    
  Else
    Debug("Editor_SetParaSpacing() - Spacing to low (< 1.0) !")
  EndIf
EndProcedure

Procedure.f RichEdit_GetLineSpacing(*this.RichEditClassTemplate)
; Description .......:  Get Line-Spacing of Selection
; Return value(s) ...:  1.0 - Normal Line-Spacing
;                       1.5 - 1.5 Line-Spacing
;                       2.0 - 2.0 Line-Spacing
;                       other values are custom spacing
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  Protected ReturnVal.f
  
  paraf\dwMask = #PFM_LINESPACING
  
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT,0, @paraf)  
  Select paraf\bLineSpacingRule
  Case 0
    ReturnVal = 1.0
  Case 1
    ReturnVal = 1.5
  Case 2
    ReturnVal = 2.0
  Default
    ReturnVal =( paraf\dyLineSpacing / 20)
  EndSelect
  
  ProcedureReturn  ReturnVal
EndProcedure

Procedure.i RichEdit_IsModified(*this.RichEditClassTemplate)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_GETMODIFY, 0, 0)
EndProcedure

Procedure.i RichEdit_IsLink(*this.RichEditClassTemplate)
  Protected cf2.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION, @cf2)
  If cf2\dwEffects &#CFM_LINK : ProcedureReturn #True : EndIf
  ProcedureReturn #False
  
  
EndProcedure

Procedure.s RichEdit_GetWordUnderMouse( *this.RichEditClassTemplate, x.i, y.i )
  ; x,y = Mouseposition relativ zum Gadget !!!
  
  Protected.TEXTRANGE TR
  Protected.s         Result
  Protected.POINT     ps
  Protected.i         Pos, Start, Length, sz
  
  ; Maybe we need somes Twips-Adjustments.
  ps\x = X  ;* GetTwipsPerPixelX()      
  ps\y = Y  ;* GetTwipsPerPixelY()
    
  ;get the Charpos at coordinates
  Pos = SendMessage_(*this\hWnd, #EM_CHARFROMPOS, 0,@ps)
  
  ;if nothing, return empty
  If pos <= 0 : ProcedureReturn ""  : EndIf
  
  Start  =     SendMessage_(*this\hWnd, #EM_FINDWORDBREAK, #WB_LEFTBREAK, Pos)
  Length =     SendMessage_(*this\hWnd, #EM_FINDWORDBREAK, #WB_RIGHTBREAK,Pos) - Start
  
  If Length<=0 : ProcedureReturn "" : EndIf
  
;   Debug("Start="+Str(Start))
;   Debug("Length="+Str(Length))


  TR\chrg\cpMin = Start
  TR\chrg\cpMax = Start+Length
    
  *this\WordUnderCursorRange\cpMin = TR\chrg\cpMin
  *this\WordUnderCursorRange\cpMax = TR\chrg\cpMax
  
  
  sz = Length * SizeOf(Character)
  TR\lpstrText = AllocateMemory(128+sz)
  
  
  SendMessage_(*this\hWnd, #EM_GETTEXTRANGE, 0, @TR)
  
  
  Result = PeekS(TR\lpstrText,Length)
  FreeMemory(TR\lpstrText)  
  
  ProcedureReturn Trim(ReplaceString(ReplaceString(ReplaceString(Result,Chr(9)," "),Chr(13)," "),Chr(10)," "))
EndProcedure

Procedure.s RichEdit_GetCurrentWord(*this.RichEditClassTemplate)
  Protected TR.TEXTRANGE
  Protected Result.s
  Protected selStart.l
  Protected selEnd.l
  
  SendMessage_(*this\hWnd, #EM_GETSEL, @selStart, @selEnd)
  
  Protected Start.i  =     SendMessage_(*this\hWnd, #EM_FINDWORDBREAK, #WB_LEFTBREAK, selStart)
  Protected Length.i =     SendMessage_(*this\hWnd, #EM_FINDWORDBREAK, #WB_RIGHTBREAK,selStart) - Start
  Protected sz.i
    
  If Length=0 : ProcedureReturn "" : EndIf
  
  TR\chrg\cpMin = Start
  TR\chrg\cpMax = Start+Length
  sz = Length* SizeOf(Character)
  TR\lpstrText = AllocateMemory(128+sz)
  
  SendMessage_(*this\hWnd, #EM_GETTEXTRANGE, 0, @TR)
  Result = PeekS(TR\lpstrText,Length)
  FreeMemory(TR\lpstrText)
  
  ProcedureReturn  Trim(ReplaceString(ReplaceString(ReplaceString(Result,Chr(9)," "),Chr(13)," "),Chr(10)," "))
EndProcedure

Procedure.i RichEdit_Replace(*this.RichEditClassTemplate, ToReplace.s, Text.s, Flags.i = 0)
; Description .......:  Replace a Word (not all in the Text!)
; Parameter(s) ......:  ToReplace.s   - Text to Replace
;                       Text.s        - New Text, Replaces the Text in 'ToReplace'
;                       Flags.i       - Search-Options:
;                                         0              - Normal
;                                         #FR_MATCHCASE  - Matchcase-Search
;                                         #FR_Wholeword  - Whole words, no subwords
; Return value(s) ...:  #True if Repaced something

  Protected Info.FINDTEXT, TextLength.i = Len(ToReplace)
  Protected Count.i, Range.CHARRANGE,Found
  Protected retVal = #False
    
  Info\lpstrText  = @ToReplace
  Info\chrg\cpMin = 0
  Info\chrg\cpMax = -1
  
  Flags|#FR_DOWN
  
  SendMessage_(*this\hWnd, #EM_SETSEL, 0, 0)
  
  Found = SendMessage_(*this\hWnd, #EM_FINDTEXT, Flags, @Info)
  If Found > -1
    Info\chrg\cpMin = Found + 1
    
    Range\cpMin = Found
    Range\cpMax = Found + TextLength
    SendMessage_(*this\hWnd, #EM_EXSETSEL, 0, @Range)
    SendMessage_(*this\hWnd, #EM_REPLACESEL, 0, @Text)
    retVal = #True
  EndIf
  ProcedureReturn retVal
EndProcedure

Procedure.i RichEdit_ReplaceAll(*this.RichEditClassTemplate, ToReplace.s, Text.s, Flags.i = 0)
; Description .......:  Replace a Word in the complete Text
; Parameter(s) ......:  ToReplace.s   - Text to Replace
;                       Text.s        - New Text, Replaces the Text in 'ToReplace'
;                       Flags.i       - Search-Options:
;                                         0              - Normal
;                                         #FR_MATCHCASE  - Matchcase-Search
;                                         #FR_Wholeword  - Whole words, no subwords
; Return value(s) ...:  Count of Replaces

  Protected Info.FINDTEXT, TextLength.i = Len(ToReplace)
  Protected Count.i, Range.CHARRANGE,Found
  
  Info\lpstrText  = @ToReplace
  Info\chrg\cpMin = 0
  Info\chrg\cpMax = -1
  
  Flags|#FR_DOWN
  
  SendMessage_(*this\hWnd, #EM_SETSEL, 0, 0)
  
  Repeat
    Found = SendMessage_(*this\hWnd, #EM_FINDTEXT, Flags, @Info)
    If Found > -1
      Info\chrg\cpMin = Found + 1
      
      Range\cpMin = Found
      Range\cpMax = Found + TextLength
      SendMessage_(*this\hWnd, #EM_EXSETSEL, 0, @Range)
      SendMessage_(*this\hWnd, #EM_REPLACESEL, 0, @Text)
      Count + 1
    Else
      ProcedureReturn Count
    EndIf
  ForEver
EndProcedure

Procedure.i RichEdit_SetBulleted(*this.RichEditClassTemplate)  
  
; Description .......:  Start / Change Slection to Bulleting

  Protected format.PARAFORMAT
  format\cbSize = SizeOf(PARAFORMAT)
  format\dwMask = #PFM_NUMBERING
  format\wNumbering = #PFN_BULLET
  ;Read first
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT, 0, @format)
  
  format\dwMask = #PFM_NUMBERING
  If format\wNumbering = #PFN_BULLET
    format\wNumbering = #Null
  Else
    format\wNumbering = #PFN_BULLET
  EndIf
  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETPARAFORMAT, 0, @format)
EndProcedure

Procedure.i RichEdit_InsertTable(*this.RichEditClassTemplate, cols, rows, cellWidth)
  Protected  i, j, rtfTable.s  
  ;initial \par adds a line feed To ensure table starts on new line.
  ;trgaph sets marginLeft in cells, in twips (here 30 twips)
 
  rtfTable = "{\par \trgaph30 "
  For i = 1 To cols
     rtfTable + "\cellx" + Str(i * cellWidth)
  Next
  
  For j = 1 To rows
     rtfTable  + "\intbl "
     For i = 1 To cols
        rtfTable + "\cell "
 
        ; If you want to insert text directly, place it right before \cell 
        ; Use following line instead of the above, to see what I mean
        ; rtfTable + "\cellx" + Str(i * cellWidth)
     Next
     rtfTable = rtfTable + "\row"
  Next
 
  rtfTable = rtfTable + "\pard}"
  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_REPLACESEL, 0, rtfTable) 
EndProcedure  

Procedure.i RichEdit_SetModified(*this.RichEditClassTemplate, state.i=#True)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETMODIFY, state ,0) 
EndProcedure  
  
Procedure.i RichEdit_GetLineCount(*this.RichEditClassTemplate)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_GETLINECOUNT, 0, 0) 
EndProcedure  

Procedure.i RichEdit_IsSuperscript(*this.RichEditClassTemplate)
  Protected cf2.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION, @cf2)
  
  If cf2\dwEffects &#CFM_SUPERSCRIPT : ProcedureReturn #True : EndIf
  ProcedureReturn #False
  
EndProcedure

Procedure.i RichEdit_SetSuperscript(*this.RichEditClassTemplate)
  Protected format.CHARFORMAT2
  Protected.i flags
  format\cbSize = SizeOf(CHARFORMAT2)
  
  ;switch
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, 1, @format)
  flags=format\dwEffects!flags
  
  format\dwMask = #CFM_SUPERSCRIPT
  format\dwEffects = flags
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i RichEdit_IsSubscript(*this.RichEditClassTemplate)
  Protected cf2.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT ,#SCF_SELECTION, @cf2)
    
  If cf2\dwEffects &#CFM_SUBSCRIPT : ProcedureReturn #True : EndIf
  ProcedureReturn #False
  
EndProcedure

Procedure.i RichEdit_SetSubscript(*this.RichEditClassTemplate)
  Protected format.CHARFORMAT2
  Protected.i flags
  
  format\cbSize = SizeOf(CHARFORMAT2)
  
  ;switch
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, 1, @format)
  flags=format\dwEffects!flags
  
  format\dwMask = #CFM_SUBSCRIPT
  format\dwEffects = flags
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i RichEdit_ChangeFontSize(*this.RichEditClassTemplate, iDelta.i=1)
; Description .......:  Increase or decrease the font size
; Parameter .........:  Delta   - Value of incrementation, Negative ==> decrementation  

  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETFONTSIZE, iDelta,0)
EndProcedure

Procedure.i RichEdit_LimitText(*this.RichEditClassTemplate, iLimitTo.i)
; Description .......:  Limit the control to N chararacters
; Parameter(s) ......:  iLimitTo - Number of characters
  Protected.i Result
  If iLimitTo > 64000
    Result = SendMessage_(*this\hWnd, #EM_EXLIMITTEXT, iLimitTo, 0)
  Else
    Result = SendMessage_(*this\hWnd, #EM_LIMITTEXT, iLimitTo, 0)
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure.i RichEdit_HideSelection(*this.RichEditClassTemplate, bVal.i=#True)
; Description .......:  Sets wheter the selection mark is visible.
; Parameter(s) ......:  bVal.i - #True to Hide, #False to Unhide
  ProcedureReturn  SendMessage_(*this\hWnd, #EM_HIDESELECTION, bVal, 0)
EndProcedure

Procedure.i RichEdit_SetUnderlineWave(*this.RichEditClassTemplate)
; Description .......:  To Mark special passages or words with a red waved
;                       underline, you can use this Procedure. 
;                       The planned usage was for Spellchecker, so it always
;                       underlines 'red'. But that is only a 'hack', and the
;                       coloring of the underline was not documented by ms.

  Protected format.CHARFORMAT2
  
  format\cbSize         = SizeOf(CHARFORMAT2)
  format\dwMask         = #CFM_UNDERLINETYPE
  format\dwEffects      = #CFE_UNDERLINE
  format\bUnderlineType = #CFU_UNDERLINEWAVE | $50

  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i Richedit_ClearUnderlineWave(*this.RichEditClassTemplate)
; Description .......:  As the Procedure above, it removes the red waved
;                       from the selcted Text.

  Protected format.CHARFORMAT2
  
  format\cbSize     = SizeOf(CHARFORMAT2)
  format\dwMask     = #CFM_UNDERLINETYPE
  format\dwEffects  = 0
  format\bUnderlineType = 0;

  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i RichEdit_Redraw( *this.RichEditClassTemplate )
; Description .......:  Sends a 'RedrawWindow()'-Message to the Gadget.
;                       Usefull after disbling/enabling the DRawing of a
;                       Gadget.
  ProcedureReturn RedrawWindow_(*this\hWnd,0,0,#RDW_UPDATENOW|#RDW_ERASE|#RDW_INVALIDATE)          
EndProcedure

Procedure.i RichEdit_GetTextLength( *this.RichEditClassTemplate )
  Protected texlen.GETTEXTLENGTHEX
  texlen\flags = #GTL_NUMCHARS | #GTL_DEFAULT
  
  ;following the MS-Doku, use 1200 for Unicode
CompilerIf #PB_Compiler_Unicode
  texlen\codepage = 1200
CompilerElse
  texlen\codepage = #CP_ACP
CompilerEndIf
  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_GETTEXTLENGTHEX, @texlen, 0)
  
EndProcedure

Procedure.i RichEdit_GetTextColor(*this.RichEditClassTemplate)
  Protected retColor.i = #White  
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)  
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT,0, @format)  

  If (format\dwEffects & #CFE_AUTOCOLOR) = #CFE_AUTOCOLOR
    retColor = GetSysColor_(#COLOR_WINDOWTEXT)
  Else
    retColor = format\crTextColor
  EndIf  
  ProcedureReturn retColor
EndProcedure  

Procedure.i RichEdit_IsSmallCaps(*this.RichEditClassTemplate)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)  
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT, #SCF_SELECTION, @format)       
  
  If format\dwEffects & #CFE_SMALLCAPS : ProcedureReturn #True : EndIf
  ProcedureReturn #False 
EndProcedure

Procedure.i RichEdit_SetSmallCaps(*this.RichEditClassTemplate, bVal.i = #True)
  ;Characters are in small capital letters. The value does not affect how
  ;the control displays the text. 
  
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)  
  format\dwMask = #CFM_SMALLCAPS
  If bVal
    format\dwEffects = #CFE_SMALLCAPS
  EndIf  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i RichEdit_IsAllCaps(*this.RichEditClassTemplate)
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)  
  
  SendMessage_(*this\hWnd, #EM_GETCHARFORMAT,#SCF_SELECTION, @format)       
  
  If format\dwEffects &#CFE_ALLCAPS : ProcedureReturn #True : EndIf
  ProcedureReturn #False
EndProcedure

Procedure.i RichEdit_SetAllCaps(*this.RichEditClassTemplate, bVal.i = #True)
  ;Characters are all capital letters. The value does not affect the way the
  ;control displays the text. This value applies only To versions earlier than
  ;Microsoft Rich Edit 3.0.
  
  Protected format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2)  
  format\dwMask = #CFM_ALLCAPS
  If bVal
    format\dwEffects = #CFE_ALLCAPS
  EndIf  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

Procedure.i RichEdit_CanPaste(*this.RichEditClassTemplate)
; Description....: Can the contents of the clipboard be pasted into the control?
;
; Remarks .......: Data in two clipboard formats can be pasted: RTF and RTF with Objects.
;                  This function determines whether data in either format is on the clipboard.

  ProcedureReturn SendMessage_(*this\hWnd, #EM_CANPASTE, 0, 0)
EndProcedure

Procedure.i RichEdit_GetCursorPosition(*this.RichEditClassTemplate)
  Protected selStart.l
  Protected selEnd.l
  SendMessage_(*this\hWnd, #EM_GETSEL, @selStart, @selEnd)
  ProcedureReturn selStart
EndProcedure

Procedure.s RichEdit_GetWordAtPosition(*this.RichEditClassTemplate, Pos.i)
  Protected TR.TEXTRANGE
  Protected Result.s
  Protected Start.i  =     SendMessage_(*this\hWnd, #EM_FINDWORDBREAK, #WB_LEFTBREAK, Pos)
  Protected Length.i =     SendMessage_(*this\hWnd, #EM_FINDWORDBREAK, #WB_RIGHTBREAK,Pos) - Start
  Protected sz.i
  
  If Length<=0 : ProcedureReturn "" : EndIf
  

  TR\chrg\cpMin = Start
  TR\chrg\cpMax = Start+Length
     
  sz = Length * SizeOf(Character)
  TR\lpstrText = AllocateMemory(128+sz)
    
  SendMessage_(*this\hWnd, #EM_GETTEXTRANGE, 0, @TR)
  

  Result = PeekS(TR\lpstrText,Length)
  FreeMemory(TR\lpstrText)  
  
  ProcedureReturn Trim(ReplaceString(ReplaceString(ReplaceString(Result,Chr(9)," "),Chr(13)," "),Chr(10)," "))
EndProcedure

Procedure.i RichEdit_GetFirstVisibleLineNumber(*this.RichEditClassTemplate)
  Protected result=SendMessage_(*this\hWnd,#EM_GETFIRSTVISIBLELINE,0 ,0)
  ProcedureReturn result
EndProcedure 

Procedure.i RichEdit_GetFirstVisibleLinePos(*this.RichEditClassTemplate)
  Protected Result.i
  Protected iTopLine.i= SendMessage_(*this\hWnd,#EM_GETFIRSTVISIBLELINE,0 ,0)
  
  ;position of 1st char in line iTopLine
  Result = SendMessage_(*this\hWnd, #EM_LINEINDEX, iTopLine ,0) 
  ProcedureReturn Result
EndProcedure 

Procedure.s RichEdit_GetFirstVisibleLineText(*this.RichEditClassTemplate)
  Protected iTopLine.i, iLineLength.i, iCharPos.i, Result.s
  iTopLine=SendMessage_(*this\hWnd, #EM_GETFIRSTVISIBLELINE, 0 ,0)
  iCharPos=SendMessage_(*this\hWnd, #EM_LINEINDEX, iTopLine ,0)
  iLineLength=SendMessage_(*this\hWnd, #EM_LINELENGTH ,iCharPos ,0)
  Result = Space(iLineLength)
  SendMessage_(*this\hWnd, #EM_GETLINE, iTopLine ,@Result)
  ProcedureReturn Result
EndProcedure 

Procedure.i RichEdit_GetLastVisibleLineNumber(*this.RichEditClassTemplate)  
  Protected iFirstLine.i, iLastLine.i
  Protected p.POINT
  
  p\x = GadgetWidth(*this\ID)
  p\y = GadgetHeight(*this\ID)
  
  iFirstLine = SendMessage_(*this\hWnd, #EM_GETFIRSTVISIBLELINE, 0 ,0)
  iLastLine  = SendMessage_(*this\hWnd, #EM_CHARFROMPOS, 0, @p)
  iLastLine   = SendMessage_(*this\hWnd, #EM_LINEFROMCHAR, iLastLine, 0)
    
  ProcedureReturn  iLastLine    
EndProcedure  

Procedure.i RichEdit_GetLastVisibleLinePos(*this.RichEditClassTemplate)
  Protected *self.RichEdit = *this  ;Zugriff auf eigene Klassenfunktionen
  Protected Result.i  
  Protected iBottomLine.i= *self\GetLastVisibleLineNumber()  
  
  Result = SendMessage_(*this\hWnd, #EM_LINEINDEX, iBottomLine+1 ,0) 
  ProcedureReturn Result
EndProcedure 

Procedure.s RichEdit_GetLastVisibleLineText(*this.RichEditClassTemplate)  
  Protected *self.RichEdit = *this  ;Zugriff auf eigene Klassenfunktionen
  Protected iLineLength.i, iCharPos.i, Result.s  
  Protected iBottomLine.i = *self\GetLastVisibleLineNumber()
      
  iCharPos=SendMessage_(*this\hWnd  , #EM_LINEINDEX, iBottomLine ,0)
  iLineLength=SendMessage_(*this\hWnd, #EM_LINELENGTH ,iCharPos ,0)
  Result = Space(iLineLength)
  SendMessage_(*this\hWnd, #EM_GETLINE, iBottomLine ,@Result)
  
  ProcedureReturn Result     
EndProcedure  

Procedure.i RichEdit_GetCharPosOfPreviousWord(*this.RichEditClassTemplate, Pos.i)
  ProcedureReturn SendMessage_( *this\hWnd, #EM_FINDWORDBREAK, #WB_MOVEWORDLEFT, pos)
EndProcedure  

Procedure.i RichEdit_GetCharPosOfNextWord(*this.RichEditClassTemplate, pos)
  ProcedureReturn SendMessage_( *this\hWnd, #EM_FINDWORDBREAK, #WB_MOVEWORDRIGHT, pos)
EndProcedure  

Procedure.i RichEdit_EmptyUndoBuffer(*this.RichEditClassTemplate)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_EMPTYUNDOBUFFER, 0, 0) 
EndProcedure

Procedure.i RichEdit_GetFirstCharPosOnLine(*this.RichEditClassTemplate, iLine.i)  
  If iLine > 0 : iLine -1 : EndIf
  ProcedureReturn SendMessage_(*this\hWnd, #EM_LINEINDEX, iLine, 0)   
EndProcedure

Procedure.i RichEdit_GetLineLength(*this.RichEditClassTemplate, iLine.i)
  Protected.RichEdit *self     = *this  ;Zugriff auf eigene Klassenfunktionen
  Protected.i        CharPos
  
  CharPos = *self\GetFirstCharPosOnLine(iLine)
  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_LINELENGTH, CharPos, 0) 
EndProcedure

Procedure.i RichEdit_IsAlignLeft(*this.RichEditClassTemplate)
  ;Prüft ob Absatz Linksbündig ausgerichtet ist
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  Protected bRet.i = #False
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)  
  If paraf\wAlignment = #PFA_LEFT : bRet = #True: EndIf  
  ProcedureReturn bRet  
EndProcedure

Procedure.i RichEdit_IsAlignCenter(*this.RichEditClassTemplate)
  ;Prüft ob Absatz Zentriert ausgerichtet ist
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  Protected bRet.i = #False
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
  If paraf\wAlignment = #PFA_CENTER : bRet = #True: EndIf  
  ProcedureReturn bRet  
EndProcedure

Procedure.i RichEdit_IsAlignRight(*this.RichEditClassTemplate)
  ;Prüft ob Absatz Rechtsbündig ausgerichtet ist
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  Protected bRet.i = #False
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
  If paraf\wAlignment = #PFA_RIGHT : bRet = #True: EndIf  
  ProcedureReturn bRet  
EndProcedure

Procedure.i RichEdit_IsAlignJustify(*this.RichEditClassTemplate)
  ;Prüft ob Absatz Rechtsbündig ausgerichtet ist
  Protected paraf.PARAFORMAT2\cbSize = SizeOf(PARAFORMAT2)
  Protected bRet.i = #False
  SendMessage_(*this\hWnd, #EM_GETPARAFORMAT ,#Null, @paraf)
  If paraf\wAlignment = #PFA_JUSTIFY : bRet = #True: EndIf  
  ProcedureReturn bRet  
EndProcedure

Procedure.i RichEdit_GetWordUnderCursorStart(*this.RichEditClassTemplate)
  ProcedureReturn *this\WordUnderCursorRange\cpMin
EndProcedure

Procedure.i RichEdit_GetWordUnderCursorEnd(*this.RichEditClassTemplate)
  ProcedureReturn *this\WordUnderCursorRange\cpMax
EndProcedure

Procedure.i RichEdit_GetScrollPosX(*this.RichEditClassTemplate)
  Protected pt.POINT
  SendMessage_(*this\hWnd, #EM_GETSCROLLPOS, 0 , @pt)  
  ProcedureReturn pt\x
EndProcedure

Procedure.i RichEdit_GetScrollPosY(*this.RichEditClassTemplate)
  Protected pt.POINT
  SendMessage_(*this\hWnd, #EM_GETSCROLLPOS, 0 , @pt)  
  ProcedureReturn pt\y
EndProcedure

Procedure.i RichEdit_SetScrollPos(*this.RichEditClassTemplate,x.i,y.i)
  Protected pt.POINT
  pt\x = x
  pt\y = y  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETSCROLLPOS, 0 , @pt)   
EndProcedure

Procedure.i RichEdit_SetLink(*this.RichEditClassTemplate, bVal.i = #True)
  Protected Format.CHARFORMAT
  With Format
    \cbSize = SizeOf(CHARFORMAT)
    \dwMask = #CFM_LINK
    If bVal        
      \dwEffects = #CFE_LINK
    EndIf    
  EndWith  
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @Format)   
EndProcedure

Procedure.i RichEdit_SetUndoLimit(*this.RichEditClassTemplate, limit.l)
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETUNDOLIMIT, limit, 0)   
EndProcedure


Procedure.i RichEdit_AppendText(*this.RichEditClassTemplate, sText.s)
	Protected.SETTEXTEX settext  
  Protected.i lineCount  = SendMessage_(*this\Hwnd, #EM_GETLINECOUNT, 0, 0)
  Protected.i lineIndex  = SendMessage_(*this\Hwnd, #EM_LINEINDEX, lineCount-1, 0)
  Protected.i lineLength = SendMessage_(*this\Hwnd, #EM_LINELENGTH, lineIndex, 0)
  
  lineLength + lineIndex
  
  SendMessage_(*this\Hwnd, #EM_SETSEL, lineLength, lineLength)
  SendMessage_(*this\Hwnd, #EM_HIDESELECTION, 0, 0)
    
  ;following the MS-Doku, use 1200 for Unicode
CompilerIf #PB_Compiler_Unicode
  settext\codepage = 1200
CompilerElse
  settext\codepage = #CP_ACP
CompilerEndIf
  
  settext\flags = #ST_SELECTION
  ProcedureReturn SendMessage_(*this\hWnd, #EM_SETTEXTEX, @settext, @sText)
EndProcedure



DataSection
  IID_ITextDocument:  ; {8CC497C0-A1DF-11ce-8098-00AA0047BE5D}
  Data.l $8CC497C0
  Data.w $A1DF, $11ce
  Data.b $80, $98, $00, $AA, $00, $47, $BE, $5D
    
  vTable_RichEditClassTemplate:
  Data.i @RichEdit_Free()
  Data.i @RichEdit_GetID()
  Data.i @RichEdit_GethWnd()
  Data.i @RichEdit_GetX()
  Data.i @RichEdit_GetY()
  Data.i @RichEdit_GetWidth()
  Data.i @RichEdit_GetHeight()
  Data.i @RichEdit_GetReadOnly()
  Data.i @RichEdit_GetCursorX()
  Data.i @RichEdit_GetCursorY()
  Data.i @RichEdit_GetFont()
  Data.i @RichEdit_GetFontSize()
  Data.i @RichEdit_GetFontStyle()
  Data.i @RichEdit_GetZoom()
  Data.i @RichEdit_Resize()
  Data.i @RichEdit_DisableRedraw()
  Data.i @RichEdit_Clear()
  Data.i @RichEdit_GetText()
  Data.i @RichEdit_GetRTFText()
  Data.i @RichEdit_GetSelText()
  Data.i @RichEdit_FindText()
  Data.i @RichEdit_CountWords()
  Data.i @RichEdit_Cut()
  Data.i @RichEdit_Copy()
  Data.i @RichEdit_Paste()
  Data.i @RichEdit_BeginUndo()
  Data.i @RichEdit_StopUndo()
  Data.i @RichEdit_CanUndo()
  Data.i @RichEdit_Undo()
  Data.i @RichEdit_Redo()
  Data.i @RichEdit_LoadRTF()
  Data.i @RichEdit_LoadText()
  Data.i @RichEdit_SaveRTF()
  Data.i @RichEdit_SaveText()
  Data.i @RichEdit_Print()
  Data.i @RichEdit_SetFont()
  Data.i @RichEdit_SetFontSize()
  Data.i @RichEdit_SetFontStyle()
  Data.i @RichEdit_SetZoom()
  Data.i @RichEdit_SetAlignment()
  Data.i @RichEdit_SetLeftMargin()
  Data.i @RichEdit_SetRightMargin()
  Data.i @RichEdit_SetCtrlBackColor()
  
  Data.i @RichEdit_SetTextBackColor()
  Data.i @RichEdit_GetTextBackColor()
  Data.i @RichEdit_ClearTextBackColor() 
  Data.i @RichEdit_SetTextColor()
  Data.i @RichEdit_SetSelection()
  Data.i @RichEdit_IsTextSelected()
  Data.i @RichEdit_SetText()
  Data.i @RichEdit_SetReadOnly()
  Data.i @RichEdit_SetCursorPos()
  Data.i @RichEdit_SetWordWrap()
  Data.i @RichEdit_SelectAll()
  Data.i @RichEdit_Unselect()
  Data.i @RichEdit_Indent()
  Data.i @RichEdit_Outdent()
  
  Data.i @RichEdit_ScrollToLine()
  Data.i @RichEdit_GetParagraphAlign()
  
  Data.i @RichEdit_GetLineSpacing()
  Data.i @RichEdit_SetLineSpacing()
  Data.i @RichEdit_IsModified()
  Data.i @RichEdit_SetModified()
  Data.i @RichEdit_IsLink()
  
  Data.i @RichEdit_GetWordUnderMouse()
  Data.i @RichEdit_GetCurrentWord()
  Data.i @RichEdit_Replace()
  Data.i @RichEdit_ReplaceAll()
  Data.i @RichEdit_SetBulleted()
  
  Data.i @RichEdit_GetLineCount()
    
  Data.i @RichEdit_IsSuperscript()
  Data.i @RichEdit_SetSuperscript()
  Data.i @RichEdit_IsSubscript()
  Data.i @RichEdit_SetSubscript()
  Data.i @RichEdit_ChangeFontSize()
  Data.i @RichEdit_LimitText()
  Data.i @RichEdit_HideSelection()
  Data.i @RichEdit_SetUnderlineWave()
  Data.i @Richedit_ClearUnderlineWave()
  Data.i @RichEdit_Redraw()
  Data.i @RichEdit_GetTextLength()
  Data.i @RichEdit_GetTextColor()
  Data.i @RichEdit_IsSmallCaps()
  Data.i @RichEdit_SetSmallCaps()
  Data.i @RichEdit_IsAllCaps()
  Data.i @RichEdit_SetAllCaps()
  Data.i @RichEdit_CanPaste()
  Data.i @RichEdit_GetCursorPosition()
  Data.i @RichEdit_GetWordAtPosition()
  Data.i @RichEdit_GetFirstVisibleLineNumber()
  Data.i @RichEdit_GetFirstVisibleLinePos()
  Data.i @RichEdit_GetFirstVisibleLineText()
  Data.i @RichEdit_GetLastVisibleLineNumber()  
  Data.i @RichEdit_GetLastVisibleLinePos()
  Data.i @RichEdit_GetLastVisibleLineText()  
  Data.i @RichEdit_GetCharPosOfPreviousWord()
  Data.i @RichEdit_GetCharPosOfNextWord()
  Data.i @RichEdit_EmptyUndoBuffer()
  Data.i @RichEdit_GetFirstCharPosOnLine()  
  Data.i @RichEdit_GetLineLength()  
  
  Data.i @RichEdit_IsAlignLeft()
  Data.i @RichEdit_IsAlignCenter()
  Data.i @RichEdit_IsAlignRight()
  Data.i @RichEdit_IsAlignJustify()
  
  Data.i @RichEdit_GetWordUnderCursorStart()
  Data.i @RichEdit_GetWordUnderCursorEnd()
  
  Data.i @RichEdit_GetScrollPosX()
  Data.i @RichEdit_GetScrollPosY()
  Data.i @RichEdit_SetScrollPos()
  Data.i @RichEdit_SetLink()
  Data.i @RichEdit_SetUndoLimit()
  
  Data.i @RichEdit_AppendText()
  
EndDataSection
Downloadpaket mit Einsteigerfreundlichem Beispiel gibt es hier:
Download

Verbesserungsvorschläge, Bugreports usw. Willkommen

Achtung: Die neueste Version befindet sich nur noch im Download-Paket,
da der Source die 60000 Zeichen Grenze sprengt :mrgreen:

Aktuell ist Version 2.3 vom 03.11.2013

Re: RichEdit Funktionen (OOP)

Verfasst: 18.07.2011 10:14
von RSBasic
Schönes Beispiel. :allright:

Re: RichEdit Funktionen (OOP)

Verfasst: 18.07.2011 12:14
von Falko
ts-soft hat geschrieben:; Other: Stolen from: freak, danilo, srod, andreas and others
:bounce:

Re: RichEdit Funktionen (OOP)

Verfasst: 18.07.2011 13:26
von Danilo
Hab hier noch ein altes MiniTool von 2003 gefunden, was ich
mir damals machte um ein paar RichEdit-Dinge zu lernen.
Wie man Bulletlisten, Tabellen, Textausrichtung, Coloring, Textstyles
usw. aufbaut.
Oben ist ein Editor zur Source-Eingabe, unten wird dann der entsprechende
RichText angezeigt. Unten Scrollen mit Mausrad.

RichText.zip (22,2k)
oder
RichText.zip (22,2k)

Bitte bedenken das es schon uralt ist. Die Exe läuft aber noch, zum
anschauen der RTF-Beispiele. Einfach mit dem Button ">> Load .RTF" reinladen und anschauen.

Re: RichEdit Funktionen (OOP)

Verfasst: 18.07.2011 18:31
von rolaf
Mein lieber Thomas eine feine Sache das... :allright:

Bulettisten? :mrgreen: danilo das klingt irgenwie nett :allright:

Re: RichEdit Funktionen (OOP)

Verfasst: 18.07.2011 20:07
von ts-soft
Danke euch erstmal für das Angucken und Danilo für sein schönes Tool, werde ich brauchen können :allright:

Noch mal ein Hinweis für Einsteiger: Lasst euch nicht durch den obigen Code abschrecken, die Nutzung ist
leichter als bei den anderen mit PB gelieferten Gadgets :wink: Um das zu sehen solltet Ihr unbedingt den Download
nutzen, der eine Art von Mini-WordPad mit nur wenigen Zeilen zeigt. Der Download ist nur wegen der mitgelieferten
Icons erforderlich.

Gruß
Thomas

//edit
Update:
Historie hat geschrieben:;======================================================================
; Historie:
; Version 1.1, July 19, 2011
; added: Redo(), GetText()
;======================================================================

Re: RichEdit Funktionen (OOP)

Verfasst: 19.07.2011 02:48
von ts-soft
Historie hat geschrieben:; Version 1.2
; added: insertflag for LoadRTF(), LoadText()
; added: better Unicode-Support for LoadText(), SaveText()
; added: GetSelText(), FindText()
; changed: SetBackColor() for better compatibility with GadgetFunctions
FindText() erwartet API-Konstanten als Flags, hab da keine passenden PB-Äquivalente gefunden.

Sollte langsam komplett sein, mir fällt nichts mehr ein :wink:

Re: RichEdit Funktionen (OOP)

Verfasst: 19.07.2011 15:33
von Danilo
ts-soft hat geschrieben:Danke euch erstmal für das Angucken und Danilo für sein schönes Tool, werde ich brauchen können :allright:
Wenn Du so selbst RTF schreiben willst, brauchst Du noch die RTF Spezifikation von Microsoft.
Links zu den verschiedenen RTF Spec Versionen gibt es HIER

Re: RichEdit Funktionen (OOP)

Verfasst: 19.07.2011 19:14
von ts-soft
Danke Danilo, aber soweit werde ich erstmal nicht einsteigen :wink:

Kleine Update:
Historie hat geschrieben:; Version 1.3
; added: SetAlignment()
Jetzt hoffe ich mal, das alles wichtige enthalten ist.

// edit
Historie hat geschrieben:; Version 1.4, July 20, 2011
; added: SetLeftMargin(), SetRightMargin()

Re: RichEdit Funktionen (OOP)

Verfasst: 20.07.2011 15:15
von ts-soft
Hier mal ein kleines Beispiel:

Code: Alles auswählen

EnableExplicit

XIncludeFile "RichEdit.pbi"

Define.RichEdit Edit
Define.s Text

Macro FE()
  While WindowEvent() : Wend
  Delay(2000)
EndMacro

OpenWindow(0, #PB_Ignore, #PB_Ignore, 400, 140, "")
Edit = New_RichEdit(0, 0, WindowWidth(0), WindowHeight(0))
Edit\SetReadOnly(#True)
Edit\SetLeftMargin(5)
Edit\SetRightMargin(5)

; adding some text
Text = #CRLF$ + "Feel the ..Pure.. Power" + #CRLF$ + #CRLF$ + "Example ©2011 by ts-soft" + #CRLF$

; format the text
Edit\SetAlignment(#PB_Text_Center)
Edit\SetFont("Comic Sans MS")
Edit\SetText(Text)
Edit\SetSelection(1, 1)
Edit\SetFontSize(16)
Edit\SetFontStyle(#PB_Font_Bold)
Edit\SetTextColor(#Blue)

FE()

; make "..Pure.." big and colored
If Edit\FindText("..Pure..")
  FE()
  Edit\SetTextColor(#Yellow, #Blue)
  Edit\SetFontSize(26)
EndIf

FE()

; make Copyright small, left align, Arial, black
If Edit\FindText("Example ©2011 by ts-soft")
  FE()
  Edit\SetFont("Arial")
  Edit\SetFontSize(8)
  Edit\SetFontStyle()
  Edit\SetTextColor(#Black)
  Edit\SetCursorPos(1, 4)
  
  FE()
  Edit\SetAlignment()
EndIf

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
Bild

Update:
Historie hat geschrieben:; Version 1.5
; added: GetFont(), GetFontSize(), GetFontStyle()
Example.pb wurde auch angepaßt

Gruß

Thomas
Alle Zeiten sind UTC+02:00
Seite 1 von 5

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de