PureBoard

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

EditorGadget mit Rightclick PopUp und Load,Save Styles etc

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

Seite 1 von 1

EditorGadget mit Rightclick PopUp und Load,Save Styles etc

Verfasst: 12.07.2010 11:01
von hjbremer
Hallo, liebe PBler

Übers EditorGadget wurde wohl schon fast alles gesagt und geschrieben, aber auch ich möchte mich einreihen in die vielen sinnvollen Beiträge :mrgreen:

Da es standardmäßig kein PopUp Menu gibt, wenn man die rechte Maustaste drückt, habe ich dem mit folgendem Code Abhilfe geschaffen. Und wie es so ist, man packt immer mehr Funktionen in das ehemals sooooo kleine Tool. Manches ist Unsinn, anderes nicht.

Wichtig: Die Auswirkung einiger Funktionen sieht man sofort, andere nur, wenn Text markiert wurde oder weiter geschrieben wird. Auch durch das andauernde Ändern, können sich Fehler eingeschlichen haben. Bitte melden.

Was ich gerne hätte, aber nicht geschafft habe, ist bei \rgxTabs die Möglichkeiten von z.B. Right-aligned tab und Dotted leader etc. Entweder habe ich eine zu alte RichText DLL oder ich bin zu blöd.

Anregungen und vor allem Verbesserungen sind sehr Willkommen !

Hier die Include

Code: Alles auswählen

;Editorgadget mit PopUp bei Rightclick mit Load, Save Styles etc
;
;HJBremer Juli - 2010 PB 4.50 x86 - Windows XP x86 32 Bit
;
;Quellen 
;Microsoft SDK
;http://msdn.microsoft.com/en-us/library/bb787873(VS.85).aspx
;http://www.purebasic.fr/english/viewtopic.php?t=6666
;http://www.rsbasic.de/
;http://www.purearea.net/pb/german/index.htm

EnableExplicit
 
Enumeration
   #egmTextKill
   #egmTextLoad
   #egmTextSave
   #egmTextPrint
   #egmModeToRtf
   
   #egmFarbe
   #egmFarbeRot
   #egmFarbeBlau
   #egmFarbeGruen
   #egmFarbeMagenta
   #egmFarbeSchwarz
   #egmFarbeAuswahl
   #egmFarbeEnde
   
   #egmFontwahl
      
   #egmFontSize
   #egmFontSizeEnde = #egmFontSize + 20   ;20 MenuEinträge reserviert
   
   #egmFontStyle
   #egmFontStyleBold
   #egmFontStyleItalic
   #egmFontStyleUnderline
   #egmFontStyleStrikeout
   #egmFontStyleSubScript
   #egmFontStyleSuperScript   
   #egmFontStyleEnde
   
   #egmAlignment   
   #egmAlignmentLeft   
   #egmAlignmentRight   
   #egmAlignmentCenter
   #egmAlignmentOffsetR
   #egmAlignmentOffsetL
   #egmAlignmentRandLksOn
   #egmAlignmentRandLksOff
   #egmAlignmentLineSpaceOn
   #egmAlignmentLineSpaceOff
   #egmAlignmentTabGross
   #egmAlignmentTabNormal
   #egmAlignmentReturnOn
   #egmAlignmentReturnOff
   #egmAlignmentEnde
   
   #egmNumbering
   #egmNumbering0
   #egmNumbering1
   #egmNumbering2
   #egmNumbering3
   #egmNumbering4
   #egmNumbering5
   #egmNumbering6
   #egmNumberingEnde
   
   ;weitere Menu Konstanten bei Bedarf
   
   #egmMenuEnde
EndEnumeration

;Menutext für Anzeige und Auswertung
#egmFarbeMenuTextRot = "rot"
#egmFarbeMenuTextBlau = "blau"
#egmFarbeMenuTextGruen = "grün"
#egmFarbeMenuTextMagenta = "magenta"
#egmFarbeMenuTextSchwarz = "schwarz"
#egmFarbeMenuTextAuswahl = "Auswahl"

Define egm_menunr, egm_itemnr, egm_lastfile.s

; Diverses 
Procedure.i Twips(mm) ;falls es jemand braucht   
   ProcedureReturn mm / (25.4/1440)
EndProcedure

Procedure.i TwipsMM(twips) 
   ProcedureReturn twips * (25.4/1440) 
EndProcedure

; EditorGadget - Set-Proceduren

Procedure.i EditGadgetSetAutoUrl(pbnr)
   
   ; muss vor SetGadgettext() benutzt werden
   
   Protected id = GadgetID(pbnr)
   Protected mask = SendMessage_(id, #EM_GETEVENTMASK, 0, 0)
   SendMessage_(id, #EM_SETEVENTMASK, 0, mask | #ENM_LINK)
  
   SendMessage_(id, #EM_AUTOURLDETECT, #True, 0)
  
EndProcedure

Procedure.i EditGadgetSetAutoUrlCB(hwnd, msg, wparam, lparam)
   
   Static hyperlink.s{#MAX_PATH} ;260 Bytes
   Protected *enlink.ENLINK
   
   If msg = #WM_NOTIFY 
      *enlink = lparam 
      If *enlink\nmhdr\code = #EN_LINK  ;1803
         If *enlink\wparam    ;0=Maus berührt Text; 1=Leftclick; 2=Rightclick
            SendMessage_(*enlink\nmhdr\hwndfrom, #EM_EXSETSEL, 0, *enlink\chrg) 
            SendMessage_(*enlink\nmhdr\hwndfrom, #EM_GETSELTEXT, 0, @hyperlink) 
            RunProgram(hyperlink) 
         EndIf 
      EndIf 
   EndIf 
   
EndProcedure

Procedure.i EditGadgetSetModeRTF(pbnr = -1)     
         
   If pbnr = -1: pbnr = GetActiveGadget(): EndIf
   
   Protected id = GadgetID(pbnr)
   Protected mode = SendMessage_(id, #EM_GETTEXTMODE, 0, 0) 
      
   If mode & #TM_RICHTEXT: ProcedureReturn: EndIf ;ist schon RTF
   
   ;auf RTF umstellen
   If mode & #TM_PLAINTEXT
      Protected rg.CharRange
      SendMessage_(id, #EM_EXGETSEL, 0, rg)        ;select save
      SendMessage_(id, #WM_SETREDRAW, #False, 0)   ;redraw aus
      Protected text.s = GetGadgetText(pbnr)       ;inhalt save
      mode & ~ #TM_PLAINTEXT                       ;flag löschen
      mode | #TM_RICHTEXT                          ;flag setzen
      SetGadgetText(pbnr, "")                      ;inhalt löschen !!
      SendMessage_(id, #EM_SETTEXTMODE, mode, 0)   ;rtfmode setzen
      SetGadgetText(pbnr, text)                    ;text zurück
      SendMessage_(id, #WM_SETREDRAW, #True, 0)    ;redraw ein
      SendMessage_(id, #EM_SETSEL, rg\cpMin, rg\cpMax) 
   EndIf

EndProcedure

Procedure.i EditGadgetSetColorVg(mp)

   Shared egm_menunr 
      
   Protected color
   Protected menutext.s = GetMenuItemText(egm_menunr, mp)  
   
   Select menutext
      Case #egmFarbeMenuTextRot: color = #Red
      Case #egmFarbeMenuTextBlau: color = #Blue
      Case #egmFarbeMenuTextGruen: color = #Green
      Case #egmFarbeMenuTextMagenta: color = #Magenta
      Case #egmFarbeMenuTextSchwarz: color = #Black
      Case #egmFarbeMenuTextAuswahl: color = -1
   EndSelect
   
   ;ColorRequester() aufrufen
   If color = -1
      color = ColorRequester()
   EndIf  
   
   ;ColorRequester() abgebrochen ?
   If color = -1: ProcedureReturn: EndIf           
   
   Protected id = GadgetID(GetActiveGadget())
   Protected charformat.CharFormat2
   charformat\cbSize      = SizeOf(CharFormat2)
   charformat\dwMask      = #CFM_COLOR 
   charformat\crTextColor = color
     
   SendMessage_(id, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
   
   Protected charrange.CharRange 
   SendMessage_(id, #EM_EXGETSEL, 0, charrange) 
   SendMessage_(id, #EM_SETSEL, charrange\cpMax, charrange\cpMax) 
   
EndProcedure

Procedure.i EditGadgetSetFontsize(mp)
   
   Shared egm_menunr 
      
   Protected id = GadgetID(GetActiveGadget())
   Protected charformat.CharFormat2
   charformat\cbSize  = SizeOf(CharFormat2)
   charformat\dwMask  = #CFM_SIZE 
   charformat\yHeight = Val(GetMenuItemText(egm_menunr, mp)) * 20
   
   SendMessage_(id, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
   
   ;Protected charrange.CharRange 
   ;SendMessage_(id, #EM_EXGETSEL, 0, charrange) 
   ;SendMessage_(id, #EM_SETSEL, charrange\cpMax, charrange\cpMax) 
   
EndProcedure

Procedure.i EditGadgetSetFontstyle(mp)
   
   ;#CFM_LINK = $20: #CFE_LINK = $20 
   #CFM_SUBSCRIPT = $30000:   #CFE_SUBSCRIPT = $10000
   #CFM_SUPERSCRIPT = $30000: #CFE_SUPERSCRIPT = $20000
      
   Protected id = GadgetID(GetActiveGadget())
   Protected format.CharFormat2\cbSize = SizeOf(CharFormat2)
   
   With format
      
      \dwMask = #CFM_BOLD
      \dwMask | #CFM_ITALIC
      \dwMask | #CFM_UNDERLINE
      \dwMask | #CFM_STRIKEOUT
      \dwMask | #CFM_SUBSCRIPT 
      \dwMask | #CFM_SUPERSCRIPT 
      
      SendMessage_(id, #EM_GETCHARFORMAT, #SCF_SELECTION, format)  
      
      If mp > -1
         
         Protected charflag
         
         Select mp
            Case #egmFontStyleBold:       charflag = #CFE_BOLD
            Case #egmFontStyleItalic:     charflag = #CFE_ITALIC
            Case #egmFontStyleUnderline:  charflag = #CFE_UNDERLINE
            Case #egmFontStyleStrikeout:  charflag = #CFE_STRIKEOUT 
            Case #egmFontStyleSubScript:  charflag = #CFE_SUBSCRIPT 
            Case #egmFontStyleSuperScript:charflag = #CFE_SUPERSCRIPT 
         EndSelect
           
         If \dwEffects & charflag     ;wenn flag vorhanden
            \dwEffects & ~ charflag   ;dann löschen
         Else
            \dwEffects | charflag     ;sonst setzen
         EndIf         
               
         SendMessage_(id, #EM_SETCHARFORMAT, #SCF_SELECTION, format)
      
      Else  ;nur für PopUp Menu
         
         Shared egm_menunr, egm_itemnr    
         
         ;Haken setzen wenn flag vorhanden
         
         If \dwEffects & #CFE_BOLD: SetMenuItemState(egm_menunr, egm_itemnr + #egmFontStyleBold, 1): EndIf
         If \dwEffects & #CFE_ITALIC: SetMenuItemState(egm_menunr, egm_itemnr + #egmFontStyleItalic, 1): EndIf
         If \dwEffects & #CFE_UNDERLINE: SetMenuItemState(egm_menunr, egm_itemnr + #egmFontStyleUnderline, 1): EndIf
         If \dwEffects & #CFE_STRIKEOUT: SetMenuItemState(egm_menunr, egm_itemnr + #egmFontStyleStrikeout, 1): EndIf
         If \dwEffects & #CFE_SUBSCRIPT: SetMenuItemState(egm_menunr, egm_itemnr + #egmFontStyleSubScript, 1): EndIf
         If \dwEffects & #CFE_SUPERSCRIPT: SetMenuItemState(egm_menunr, egm_itemnr + #egmFontStyleSuperScript, 1): EndIf
         
      EndIf
      
   EndWith
   
EndProcedure

Procedure.i EditGadgetSetFont()     
         
   Protected name.s, size, farbe, style
   
   Protected id = GadgetID(GetActiveGadget())
   Protected charformat.CharFormat2  
   
   charformat\cbSize = SizeOf(CharFormat2)
   
   ;get Font
   charformat\dwMask = #CFM_FACE | #CFM_SIZE | #CFM_COLOR   
   SendMessage_(id, #EM_GETCHARFORMAT, #SCF_SELECTION, @charformat)
   
   name = PeekS(@charformat\szFaceName)
   size = charformat\yHeight / 20
   farbe = charformat\crTextColor
   
   ;get styles
   charformat\dwMask | #CFM_BOLD
   charformat\dwMask | #CFM_ITALIC
   charformat\dwMask | #CFM_UNDERLINE
   charformat\dwMask | #CFM_STRIKEOUT   
   
   SendMessage_(id, #EM_GETCHARFORMAT, #SCF_SELECTION, @charformat)
   
   If charformat\dwEffects & #CFE_BOLD: style | #PB_Font_Bold: EndIf
   If charformat\dwEffects & #CFE_ITALIC: style | #PB_Font_Italic: EndIf
   If charformat\dwEffects & #CFE_UNDERLINE: style | #PB_Font_Underline: EndIf
   If charformat\dwEffects & #CFE_STRIKEOUT: style | #PB_Font_StrikeOut: EndIf
   
   If Not FontRequester(name, size, #PB_FontRequester_Effects, farbe, style)
      ProcedureReturn
   EndIf   
     
   ;set Font   
   PokeS(@charformat\szFaceName, SelectedFontName()) ;kopieren nach \szFaceName.c[32]
   charformat\yHeight = SelectedFontSize() * 20
   charformat\crTextColor = SelectedFontColor()
   
   ;set Styles, erst Flags löschen ist einfacher
   charformat\dwEffects & ~ #CFE_BOLD   
   charformat\dwEffects & ~ #CFE_ITALIC   
   charformat\dwEffects & ~ #CFM_UNDERLINE   
   charformat\dwEffects & ~ #CFM_STRIKEOUT 
   
   ;nun Flags setzen
   style = SelectedFontStyle()
   If style & #PB_Font_Bold: charformat\dwEffects | #CFE_BOLD: EndIf
   If style & #PB_Font_Italic: charformat\dwEffects | #CFE_ITALIC: EndIf
   If style & #PB_Font_Underline: charformat\dwEffects | #CFM_UNDERLINE: EndIf
   If style & #PB_Font_StrikeOut: charformat\dwEffects | #CFM_STRIKEOUT: EndIf
      
   SendMessage_(id, #EM_SETCHARFORMAT, #SCF_SELECTION, @charformat)
  
EndProcedure

Procedure.i EditGadgetSetAlignment(mp)
   
   Protected j
   Protected id = GadgetID(GetActiveGadget())
   Protected format.ParaFormat2\cbSize = SizeOf(ParaFormat2)   
      
   With format
      
      Select mp
         Case #egmAlignmentLeft:       \dwMask = #PFM_ALIGNMENT: \wAlignment = #PFA_LEFT
         Case #egmAlignmentRight:      \dwMask = #PFM_ALIGNMENT: \wAlignment = #PFA_RIGHT
         Case #egmAlignmentCenter:     \dwMask = #PFM_ALIGNMENT: \wAlignment = #PFA_CENTER
         Case #egmAlignmentOffsetR:    \dwMask = #PFM_OFFSETINDENT: \dxStartIndent = 150  
         Case #egmAlignmentOffsetL:    \dwMask = #PFM_OFFSETINDENT: \dxStartIndent = -150
         Case #egmAlignmentRandLksOn:  \dwMask = #PFM_STARTINDENT:  \dxStartIndent = 150
         Case #egmAlignmentRandLksOff: \dwMask = #PFM_STARTINDENT:  \dxStartIndent = 0
         Case #egmAlignmentLineSpaceOn: \dwMask = #PFM_LINESPACING: \dyLineSpacing = 25: \bLineSpacingRule = 5
         Case #egmAlignmentLineSpaceOff: \dwMask = #PFM_LINESPACING: \dyLineSpacing = 0: \bLineSpacingRule = 0
            
         Case #egmAlignmentTabGross, #egmAlignmentTabNormal
            \dwMask = #PFM_TABSTOPS
            \cTabCount = 31                  ;#MAX_TAB_STOPS -1
            For j = 0 To 31
               \rgxTabs[j] = (j + 1) * 1000  ;oder * Twips()
               If mp = #egmAlignmentTabNormal: \rgxTabs[j] = 0: EndIf
            Next
            
         Case #egmNumbering To #egmNumberingEnde
            Select mp
               Case #egmNumbering1: \wNumbering = 1   ;Bullet
               Case #egmNumbering2: \wNumbering = 2   ;2 = 1..2..3
               Case #egmNumbering3: \wNumbering = 3   ;3 = a..b..c
               Case #egmNumbering4: \wNumbering = 4   ;4 = A..B..C
               Case #egmNumbering5: \wNumbering = 5   ;5 = i..ii..iii 
               Case #egmNumbering6: \wNumbering = 6   ;6 = I..II..III
            EndSelect
            
            \dwMask = #PFM_NUMBERING | #PFM_NUMBERINGSTART
            \dwMask | #PFM_NUMBERINGSTYLE | #PFM_NUMBERINGTAB
            \wNumberingStart = 1    ; erster Wert
            \wNumberingStyle = $200 ; 0 = A) $100 = (A) $200 = A. $300 = A 
            \wNumberingTab = 250    ; Abstand in twips   
            
         Case #egmAlignmentReturnOn: SendMessage_(id, #EM_SETTARGETDEVICE, 0, 0): ProcedureReturn
         Case #egmAlignmentReturnOff: SendMessage_(id, #EM_SETTARGETDEVICE, 0, -1): ProcedureReturn
            
      EndSelect
      
      SendMessage_(id, #EM_SETPARAFORMAT, 0, format)
      
   EndWith

EndProcedure

; EditorGadget - PopUp Main-Proceduren

Procedure.i EditGadgetPopUpCreate(mode)
      
   Protected subid, j, k 
   
   Shared egm_menunr, egm_itemnr    

   egm_menunr = CreatePopupMenu(#PB_Any)
   ;egm_menunr = CreatePopupImageMenu(#PB_Any, #PB_Menu_ModernLook)
   
   MenuItem(egm_itemnr + #egmTextKill,  "&Neu")
   MenuItem(egm_itemnr + #egmTextLoad,  "Ö&ffnen")
   MenuItem(egm_itemnr + #egmTextSave,  "&Speichern")
   MenuItem(egm_itemnr + #egmTextPrint, "&Drucken")
   
   If mode & #TM_RICHTEXT
      
      MenuBar()      
      MenuItem(egm_itemnr + #egmFontwahl, "Fontwahl")
     
      subid = OpenSubMenu("Fontsize")
      
         k = 0
         For j = 6 To 12
            k + 1: MenuItem(egm_itemnr + #egmFontsize + k, Str(j))
         Next
         
         k + 1: AppendMenu_(subid, #MF_MENUBREAK, egm_itemnr + #egmFontsize + k, "14") 
         
         For j = 16 To 26 Step 2
            k + 1: MenuItem(egm_itemnr + #egmFontsize + k, Str(j))
         Next
         CloseSubMenu()
            
         If k > #egmFontSizeEnde - #egmFontsize: Debug "#egmFontSizeEnde zu klein": End: EndIf      
      
      OpenSubMenu("Fontfarbe")
         MenuItem(egm_itemnr + #egmFarbeRot, #egmFarbeMenuTextRot)
         MenuItem(egm_itemnr + #egmFarbeBlau, #egmFarbeMenuTextBlau)
         MenuItem(egm_itemnr + #egmFarbeGruen, #egmFarbeMenuTextGruen)
         MenuItem(egm_itemnr + #egmFarbeMagenta, #egmFarbeMenuTextMagenta)
         MenuItem(egm_itemnr + #egmFarbeSchwarz, #egmFarbeMenuTextSchwarz)
         MenuBar()
         MenuItem(egm_itemnr + #egmFarbeAuswahl, #egmFarbeMenuTextAuswahl)
         CloseSubMenu()
         
      OpenSubMenu("Fontstyle")
         MenuItem(egm_itemnr + #egmFontStyleBold, "Fett")
         MenuItem(egm_itemnr + #egmFontStyleItalic, "Kursiv")
         MenuItem(egm_itemnr + #egmFontStyleUnderline, "Unterstreichen")
         MenuItem(egm_itemnr + #egmFontStyleStrikeout, "Durchstreichen")
         MenuItem(egm_itemnr + #egmFontStyleSubScript, "Tiefstellen")
         MenuItem(egm_itemnr + #egmFontStyleSuperScript, "Hochstellen")
         
         CloseSubMenu()
   
         EditGadgetSetFontStyle(-1)   
         
      MenuBar()
      
      OpenSubMenu("Format")
         MenuItem(egm_itemnr + #egmAlignmentLeft, "Absatz linksbündig")
         MenuItem(egm_itemnr + #egmAlignmentRight, "Absatz rechtsbündig")
         MenuItem(egm_itemnr + #egmAlignmentCenter, "Absatz mittig")
         MenuBar()
         MenuItem(egm_itemnr + #egmAlignmentOffsetR, "Absatz nach rechts")
         MenuItem(egm_itemnr + #egmAlignmentOffsetL, "Absatz nach links")
         MenuBar()
         MenuItem(egm_itemnr + #egmAlignmentRandLksOn, "Linker Rand ein")
         MenuItem(egm_itemnr + #egmAlignmentRandLksOff, "Linker Rand aus")
         MenuBar()
         MenuItem(egm_itemnr + #egmAlignmentLinespaceOn, "Zeilenabstand groß")
         MenuItem(egm_itemnr + #egmAlignmentLinespaceOff, "Zeilenabstand normal")
         MenuBar()
         MenuItem(egm_itemnr + #egmAlignmentTabGross, "Tab groß")
         MenuItem(egm_itemnr + #egmAlignmentTabNormal, "Tab normal")
         MenuBar()
         MenuItem(egm_itemnr + #egmAlignmentReturnOn, "Return auto ein")
         MenuItem(egm_itemnr + #egmAlignmentReturnOff, "Return auto aus")
         
         CloseSubMenu()
                  
      OpenSubMenu("Number")
         MenuItem(egm_itemnr + #egmNumbering1, "Bullet")
         MenuItem(egm_itemnr + #egmNumbering2, "1..2..3")
         MenuItem(egm_itemnr + #egmNumbering3, "a..b..c")
         MenuItem(egm_itemnr + #egmNumbering4, "A..B..C")
         MenuItem(egm_itemnr + #egmNumbering5, "i..ii..iii")
         MenuItem(egm_itemnr + #egmNumbering6, "I..II..III")
         CloseSubMenu()
         
   EndIf
   
   If mode & #TM_PLAINTEXT
      MenuBar()
      MenuItem(egm_itemnr + #egmModeToRtf, "RTF-Mode ein")
   EndIf
   
EndProcedure

Procedure.i EditGadgetPopUpDisplay()
   
   Shared egm_menunr
   
   If Not IsGadget(GetActiveGadget()): ProcedureReturn: EndIf  ;!!!
   
   If GadgetType(GetActiveGadget()) <> #PB_GadgetType_Editor
      ProcedureReturn      
   EndIf
   
   Protected id = GadgetID(GetActiveGadget())
   
   ;get Textmode
   Protected mode = SendMessage_(id, #EM_GETTEXTMODE, 0, 0)
      
   EditGadgetPopUpCreate(mode) ;erstellt PopUp und setzt egm_menunr
   
   ;get Caret Pos
   Protected point.Point, rect.Rect
   Protected charrange.CharRange
   
   GetCursorPos_(point) 
   GetWindowRect_(id, rect)   
   If PtInRect_(rect, point\x | (point\y << 32))
      ;SendMessage_(id, #EM_EXGETSEL, 0, charrange)
      ;SendMessage_(id, #EM_POSFROMCHAR, point, charrange\cpMax)
      ;ClientToScreen_(id, point)
      ;point\x + 10: point\y + 10
      DisplayPopupMenu(egm_menunr, WindowID(GetActiveWindow()), point\x, point\y)
      SetCursorPos_(point\x, point\y)   
   EndIf 

EndProcedure

Procedure.i EditGadgetPopUpMenuItemNr(menuitemstartnr)
   
   ;diese Proc wird nur benötigt, wenn es mehrere Menus gibt
   ;denn dann muß dem EditgadgetPopUp die MenuItemStartnr 
   ;mitgeteilt werden und gibt die Anzahl Menunummern zurück.
   
   Shared egm_itemnr   
   egm_itemnr = menuitemstartnr
   
   ProcedureReturn #egmMenuEnde
   
EndProcedure

; EditorGadget - StreamIn/Out Proceduren

Procedure.i EditGadgetStreamInCB(hFile, pbBuff, cb, pcb) 
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0) ! 1 
EndProcedure 

Procedure.i EditGadgetStreamOutCB(hFile, pbBuff, cb, pcb) 
  ProcedureReturn WriteFile_(hFile, pbBuff, cb, pcb, 0) ! 1 
EndProcedure 

Procedure.i EditGadgetStream(pbnr, datname.s, iomode) 
   
   Protected id       = GadgetID(pbnr)   
   Protected mode
   Protected textmode = #TM_PLAINTEXT
   Protected datamode = #SF_TEXT
   Protected endung$  = LCase(GetExtensionPart(datname))
   
   Protected dnr, bytes
   Protected isrtf.s = "{\rtf1\"        ;"{\rtf1\ansi\"     ;Startchar in einer RTF Datei
   Protected check.s = Space(Len(isrtf))  ;Memory reservieren
      
   If endung$ = "rtf"
      textmode = #TM_RICHTEXT
      datamode = #SF_RTF
      ;ist es eine RTF Datei ?
      If iomode = #EM_STREAMIN 
         dnr = ReadFile(#PB_Any, datname)
         If dnr
            ReadData(dnr, @check, Len(isrtf))
            If check <> isrtf
               textmode = #TM_PLAINTEXT
               datamode = #SF_TEXT
            EndIf         
            CloseFile(dnr)
         EndIf   
      EndIf      
   EndIf
      
   If iomode = #EM_STREAMIN 
      ;Vorsicht Falle, nicht vergessen bei StreamIn
      SendMessage_(id, #WM_SETTEXT, 0, "")   ;oder SetGadgetText(pbnr, "") 
   EndIf

   ;Textmode setzen
   mode = SendMessage_(id, #EM_GETTEXTMODE, 0, 0) ;mode holen
   mode & ~ #TM_RICHTEXT                          ;flag löschen
   mode & ~ #TM_PLAINTEXT                         ;flag löschen
   mode | textmode                                ;mode setzen
   SendMessage_(id, #EM_SETTEXTMODE, mode, 0) 
   
   Protected eds.EditStream 
   
   If iomode = #EM_STREAMIN      
      eds\pfnCallback = @EditGadgetStreamInCB() 
      dnr = ReadFile(#PB_Any, datname)      
   ElseIf iomode = #EM_STREAMOUT      
      eds\pfnCallback = @EditGadgetStreamOutCB()
      dnr = CreateFile(#PB_Any, datname)      
   Else
      ProcedureReturn -1 ;falscher Parameter
   EndIf
   
   If dnr    
      eds\dwCookie = FileID(dnr)  ;Dateihandle für CB  
      bytes = SendMessage_(id, iomode, datamode, @eds) 
      CloseFile(dnr) 
   Else
      ProcedureReturn -2 ;Datei-Fehler
   EndIf
   
ProcedureReturn bytes   
EndProcedure

; EditorGadget - Datei Proceduren

Procedure.i EditGadgetTextKill()
   SetGadgetText(GetActiveGadget(), "")
EndProcedure

Procedure.i EditGadgetTextLoad(datname.s = "", pbnr = -1)
   
   Shared egm_lastfile.s
   
   If pbnr = -1: pbnr = GetActiveGadget(): EndIf
   
   If datname = ""
      
      Protected file.s = egm_lastfile 
      Protected patt.s = "Rtf-Text (*.rtf)|*.rtf;|Text (*.txt)|*.txt;|Alle Dateien (*.*)|*.*"
      
      file = OpenFileRequester("", file, patt, 0)
      
      If Not file: ProcedureReturn: EndIf
      
      egm_lastfile = file
            
   Else
      egm_lastfile = datname      
   EndIf
         
   Protected bytes = EditGadgetStream(pbnr, egm_lastfile, #EM_STREAMIN)
   
ProcedureReturn bytes
EndProcedure

Procedure.i EditGadgetTextSave(datname.s = "", pbnr = -1)
   
   Shared egm_lastfile.s
   
   If pbnr = -1: pbnr = GetActiveGadget(): EndIf
   
   If datname = ""
      
      Protected file.s = egm_lastfile
      Protected patt.s = "Rtf-Text (*.rtf)|*.rtf;|Text (*.txt)|*.txt;|Alle Dateien (*.*)|*.*"
   
      file = SaveFileRequester("", file, patt, 0)
      
      If Not file: ProcedureReturn: EndIf
      egm_lastfile = file
            
   Else
      egm_lastfile = datname      
   EndIf
   
   Protected bytes = EditGadgetStream(pbnr, egm_lastfile, #EM_STREAMOUT)
   
ProcedureReturn bytes
EndProcedure

Procedure.i EditGadgetTextPrint(datname.s = "", pbnr = -1)
      
   If Not datname Or pbnr > -1
      If pbnr = -1: pbnr = GetActiveGadget(): EndIf
      If Not IsGadget(pbnr): ProcedureReturn: EndIf  ;falls pbnr ungültig
      If GadgetType(pbnr) <> #PB_GadgetType_Editor: ProcedureReturn: EndIf
      If Not datname
         datname = "_Dummy.rtf"     
         EditGadgetStream(pbnr, datname, #EM_STREAMOUT)
      EndIf
   EndIf
   
   RunProgram("WordPad", "/p " + datname, "", #PB_Program_Hide)
      
   ;mir bekannte Parameter von WordPad
   ;/p TextFileName
   ;/pt TextFileName PrinterName [ DriverName [ PortName ] 
         
EndProcedure
   
; EditorGadget - Events

Procedure.i EditGadgetEvents(event)
   
   Shared egm_itemnr 
   
   If event = #WM_RBUTTONDOWN  ;516
       
      EditGadgetPopUpDisplay()
              
   ElseIf event = #PB_Event_Menu
       
      Protected menuitem = EventMenu() - egm_itemnr 
       
      Select menuitem
         Case #egmTextKill:  EditGadgetTextKill()
         Case #egmTextLoad:  EditGadgetTextLoad()
         Case #egmTextSave:  EditGadgetTextSave()
         Case #egmTextPrint: EditGadgetTextPrint()

         Case #egmFontwahl:  EditGadgetSetFont()
         Case #egmModeToRtf: EditGadgetSetModeRTF(): EditGadgetPopUpDisplay()                         
            
         Case #egmFarbe To #egmFarbeEnde: EditGadgetSetColorVg(menuitem)
         Case #egmFontSize To #egmFontSizeEnde: EditGadgetSetFontsize(menuitem)
         Case #egmFontStyle To #egmFontStyleEnde: EditGadgetSetFontstyle(menuitem)
         Case #egmAlignment To #egmAlignmentEnde: EditGadgetSetAlignment(menuitem)            
         Case #egmNumbering To #egmNumberingEnde: EditGadgetSetAlignment(menuitem)            
      EndSelect
      
   EndIf     
   
EndProcedure
Und ein Testcode

Code: Alles auswählen

; -Test-------------------------------------

Procedure CallBack(hwnd, msg, wparam, lparam) 
Protected result = #PB_ProcessPureBasicEvents 

   EditGadgetSetAutoUrlCB(hwnd, msg, wparam, lparam)
   
ProcedureReturn result 
EndProcedure  

Enumeration 
   #window
   #editor1
   #editor2
   #button1
EndEnumeration

#winbr = 850
#winhh = 600
#wrand = 8
#edix  = #wrand
#ediy  = #wrand
#edibr = #winbr - #wrand - #wrand
#edihh = #winhh - #wrand - #wrand - 150

Define flags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
   
OpenWindow(#window, 0, 0, #winbr, #winhh, "EditorGadget", flags)
      
EditorGadget(#editor1, #edix, #ediy, #edibr, #edihh) 
EditorGadget(#editor2, #edix, #ediy + #edihh + 10, #edibr, 110) 

ButtonGadget(#button1, 10, #winhh - 30, 200, 20, "Load sdk\readme.txt")

;wenn Web Adressen erkannt werden sollen
;EditGadgetSetAutoUrl(#editor1) ;aufrufen bevor Text geladen wird !
;SetWindowCallback(@Callback()) ;hier nur für AutoUrlDetect

;Datei gleich laden
EditGadgetTextLoad(#PB_Compiler_Home + "Examples\Sources\File.txt", #editor1)

;oder mit AddGadgetItem() Text zuweisen

;falls es mehrere Menus gibt, dann Startitemnr übergeben
;Debug EditGadgetSetPopUpItemNr(111)   

; -Event Schleife-------------------------------------

Repeat
   Define event = WaitWindowEvent()
   
   EditGadgetEvents(event) ; für Eventverarbeitung PopUp !!!
   
   If event = #PB_Event_Gadget
       
      Define wB = EventGadget()       
      Select wb 
         Case #button1: EditGadgetTextLoad(#PB_Compiler_Home + "sdk\readme.txt", #editor2)
            
      EndSelect
               
   EndIf    
    
Until event = #PB_Event_CloseWindow

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 12.07.2010 15:43
von STARGÅTE
Danke fürs posten, ist eine gute Grundlage zum schreiben eines Editors.

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 14.07.2010 12:17
von hjbremer
Wenn Microsoft Word einen RTF Text in die Finger bekommt und wieder abspeichert, dann wird er aufgepustet
und damit mein Code den Text als RTF erkennt, muß die Kennung, die ich benutzt habe verkleinert werden.

aus "{\rtf1\ansi\" wird "{\rtf1\", das habe ich oben geändert

und noch ein Hinweis: wer vorhat den Style CFE_LINK zu benutzen, der mag es tun aber die Information wird nicht mit abgespeichert. So das beim nächsten Laden die Formatierung verloren ist. Dieser Style ist also für die Katz. :mrgreen: Schuld hat wie immer Mickelsoft

Hinweis: vor CreateMenu, sollte noch ein Freemenu hingesetzt werden

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 18.07.2010 15:26
von neotoma
Erstmal danke für den Code.
Ich hatte bisher angenommen, das man die Römischen Zahlen nicht einsetzen kann, weil PB zur falschen RichEdit-Dll linkt. Einiges funktioniert also doch....
hjbremer hat geschrieben:Was ich gerne hätte, aber nicht geschafft habe, ist bei \rgxTabs die Möglichkeiten von z.B. Right-aligned tab und Dotted leader etc. Entweder habe ich eine zu alte RichText DLL oder ich bin zu blöd.
Ich denke, wie oben angedeutet, das du selbst die RichEdit-Dll ansprechen musst.
im MSDN werden die DLLs und die RichEdit-Version erklärt: url]http://msdn.microsoft.com/en-us/library ... 85%29.aspx[/url]

Du kannst mit OpenLibrary selbst die entsprechende Dll anziehen : http://www.purebasic.fr/english/viewtop ... ched20.dll

Gruß,
Mike

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 18.07.2010 20:08
von hjbremer
Danke für die Hinweise :allright:

Habe mal Suchen lassen und es gibt zwei Versionen auf meinem Rechner

in Windows\system32 eine riched20.dll mit 422 kb vom 04.08.2004
und in Programme\gemeinsame Dateien eine mit 513 kb vom 03.03.2006

wenn ich das richtig sehe benutzt PB die ältere DLL ???

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 18.07.2010 20:12
von ts-soft
Ich würde mal vermuten, das PB das RichEdit über COM ohne Versionsangabe lädt, somit immer die
neueste Version geladen wird. Wie gesagt: vermuten!

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 19.07.2010 19:03
von neotoma
ts-soft hat geschrieben:Ich würde mal vermuten, das PB das RichEdit über COM ohne Versionsangabe lädt, somit immer die
neueste Version geladen wird. Wie gesagt: vermuten!
Ich weiß nicht, ob es überhaupt über COM geladen wird. In jedem Falle ist es schade, das man die Version nicht abfragen kann.

Da andere Programme auf dem selben System mit dem RichEdit-Control sachen anstellen, auf die das Editor-Gadget von PB nicht reagiert, vermute ich, das die Version irgendwo festgelegt wurde, oder es eben ein Problem mit dem verlinken ist.
(Lasse mich aber gerne eines besseren belehren... :-) )

Gruß,
Mike

Re: EditorGadget mit Rightclick PopUp und Load,Save Styles e

Verfasst: 19.07.2010 22:03
von Mok
Sehr toll :D
Kommt gleich bei Skriva rein
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de