PureBoard

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

RTF Requester Problem Effekte

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

Seite 1 von 1

RTF Requester Problem Effekte

Verfasst: 17.10.2014 09:47
von Velindos
Hallo Leute,
hab wieder mal mit RTF rumgespielt. Nun wenn ich den Requester aufrufe und er das Format aufnimmt, muss ich immer auf "Effekt" + "Durchgestrichen" oder "Unterstrichen" achten, da er diese nicht nimmt.

Code: Alles auswählen

; --------------------------------------------------------
; RTF Format aufnehmen und setzen per Button
; Rel. 0001 from 17.10.2014

; About:
; Change the font in a editor gadget using a font requester
; And copy RTF encoding into a buffer, and write it to any editor gadget
;
; Author:   Joakim L. Christiansen
; Homepage: http://www.myhome.no/jlc_software
; --------------------------------------------------------

EnableExplicit
;- Constnten
Enumeration
  #Editor
  #ButtonChange
  #ButtonFormat
  #ButtonCopy
  #ButtonPaste
  #CFM_BACKCOLOR    = $4000000 ; sollte am Schluss stehen
EndEnumeration
Global RTFLength
Global FormatMerker
Global Font_Name.s = "Arial", Font_Size.l = 12, Font_Style.l, Font_Color.l, Font_BackColor, Font_Mask, Font_Effects, Font_Style
Global cf.CHARFORMAT2

Define *Buffer = AllocateMemory(1)

Procedure Editor_FontAufnehmen(Gaddget)
  Protected format.CHARFORMAT2
  format.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(GadgetID(Gaddget), #EM_GETCHARFORMAT ,#SCF_SELECTION, @format)
  If format
    ;get Font
    Font_Name  = PeekS(@format\szFaceName)
    Font_Size  = format\yHeight / 20
    Font_Color = format\crTextColor
    
    If format.CHARFORMAT2\dwEffects & #CFE_BOLD: Font_Style | #PB_Font_Bold: EndIf
    If format.CHARFORMAT2\dwEffects & #CFE_ITALIC: Font_Style | #PB_Font_Italic: EndIf
    If format.CHARFORMAT2\dwEffects & #CFE_UNDERLINE: Font_Style | #PB_Font_Underline: EndIf
    If format.CHARFORMAT2\dwEffects & #CFE_STRIKEOUT: Font_Style | #PB_Font_StrikeOut: EndIf
  EndIf
EndProcedure
Procedure Editor_FontSetzen(Gaddget)
  Protected format.CHARFORMAT
  ; Ab hier einstelllen
  Font_Name = SelectedFontName()
  Font_Size = SelectedFontSize()
  Font_Style = SelectedFontStyle()
  Font_Color = SelectedFontColor()
  If Font_Style < 256 ;normal
  ElseIf Font_Style < 512 ;bold
    Font_Style - 256
    Font_Style + 1
  ElseIf Font_Style < 768 ;italic
    Font_Style - 512
    Font_Style + 2
  ElseIf Font_Style >= 768 ;both
    Font_Style - 768
    Font_Style + 3
  EndIf
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName,Font_Name)
  SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format) ;#SCF_DEFAULT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = Font_Size * 20
  SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Font_Style
  SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Font_Color
  SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  SetActiveGadget(Gaddget)
EndProcedure

Procedure Editor_FontRequester(Gaddget)
  Protected format.CHARFORMAT2
  
  
  format.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(GadgetID(Gaddget), #EM_GETCHARFORMAT ,#SCF_SELECTION, @format)
  
  If format
    ;get Font
    ;     Font_Name  = PeekS(@format\szFaceName)
    ;     Font_Size  = format\yHeight / 20
    ;     Font_Color = format\crTextColor
    
    Font_Name.s         = PeekS(@format\szFaceName)
    Font_Style          = format\dwMask
    Font_Size           = format\yHeight/20
    Font_Color.l        = format\crTextColor
    Font_BackColor.l    = format\crBackColor
    
    ; Effects
    format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
    Font_Flags = format\dwEffects
    
;     If format.CHARFORMAT2\dwEffects & #CFE_BOLD: Font_Style | #PB_Font_Bold: EndIf
;     If format.CHARFORMAT2\dwEffects & #CFE_ITALIC: Font_Style | #PB_Font_Italic: EndIf
;     If format.CHARFORMAT2\dwEffects & #CFE_UNDERLINE: Font_Style | #PB_Font_Underline: EndIf
;     If format.CHARFORMAT2\dwEffects & #CFE_STRIKEOUT: Font_Style | #PB_Font_StrikeOut: EndIf
    
    ; Ab hier Font einstellen
    
    If FontRequester(Font_Name ,Font_Size, #PB_FontRequester_Effects, Font_Color, Font_Flags);Font_Style
      ; Requester übernehmen
      Font_Name = SelectedFontName()
      Font_Size = SelectedFontSize()
      Font_Style = SelectedFontStyle()
      Font_Color = SelectedFontColor()
      ; Effekts
      If Font_Style < 256 ;normal
      ElseIf Font_Style < 512 ;bold
        Font_Style - 256
        Font_Style + 1
      ElseIf Font_Style < 768 ;italic
        Font_Style - 512
        Font_Style + 2
      ElseIf Font_Style >= 768 ;both
        Font_Style - 768
        Font_Style + 3
      EndIf
      ; Ab hier einstelllen
      ; Face
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_FACE
      PokeS(@format\szFaceName,Font_Name)
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      ; Size
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_SIZE
      format\yHeight = Font_Size * 20
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      ; Style
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
      format\dwEffects = Font_Style
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      ; Color
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_COLOR
      format\crTextColor = Font_Color
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      SetActiveGadget(Gaddget)
    EndIf   
  EndIf
EndProcedure


Procedure Editor_FontRequesterOld(Gaddget)
  Protected format.CHARFORMAT2
  format.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(GadgetID(Gaddget), #EM_GETCHARFORMAT ,#SCF_SELECTION, @format)
  If format
    ;get Font
    Font_Name  = PeekS(@format\szFaceName)
    Font_Size  = format\yHeight / 20
    Font_Color = format\crTextColor
    
    If format.CHARFORMAT2\dwEffects & #CFE_BOLD: Font_Style | #PB_Font_Bold: EndIf
    If format.CHARFORMAT2\dwEffects & #CFE_ITALIC: Font_Style | #PB_Font_Italic: EndIf
    If format.CHARFORMAT2\dwEffects & #CFE_UNDERLINE: Font_Style | #PB_Font_Underline: EndIf
    If format.CHARFORMAT2\dwEffects & #CFE_STRIKEOUT: Font_Style | #PB_Font_StrikeOut: EndIf
    
    ; Ab hier Font einstellen
    
    If FontRequester(Font_Name ,Font_Size, #PB_FontRequester_Effects, Font_Color, Font_Style)
      ;If FontRequester(RTF_Font_Name,Font_Size,#PB_FontRequester_Effects,Font_Color)
      
      ; Ab hier einstelllen
      Font_Name = SelectedFontName()
      Font_Size = SelectedFontSize()
      Font_Style = SelectedFontStyle()
      Font_Color = SelectedFontColor()
      
      If Font_Style < 256 ;normal
      ElseIf Font_Style < 512 ;bold
        Font_Style - 256
        Font_Style + 1
      ElseIf Font_Style < 768 ;italic
        Font_Style - 512
        Font_Style + 2
      ElseIf Font_Style >= 768 ;both
        Font_Style - 768
        Font_Style + 3
      EndIf
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_FACE
      PokeS(@format\szFaceName,Font_Name)
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_SIZE
      format\yHeight = Font_Size * 20
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
      format\dwEffects = Font_Style
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      format\cbSize = SizeOf(CHARFORMAT)
      format\dwMask = #CFM_COLOR
      format\crTextColor = Font_Color
      SendMessage_(GadgetID(Gaddget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
      SetActiveGadget(Gaddget)
    EndIf   
  EndIf
EndProcedure
Procedure Editor_SetBackColor(editor , backColor)
  Protected cf.CHARFORMAT2
  If backColor <> -1     
    cf\cbSize      = SizeOf(CHARFORMAT2)               
    cf\dwMask      = #CFM_BACKCOLOR
    cf\crBackColor   = backColor
    SendMessage_(GadgetID(editor) , #EM_SETCHARFORMAT , #SCF_SELECTION , cf)     
  EndIf
EndProcedure
Procedure Editor_FontName(Gadget.l,FontName.s)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName,FontName)
  SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format) ;#SCF_DEFAULT
EndProcedure
Procedure Editor_FontSize(Gadget.l,Fontsize.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
EndProcedure
Procedure Editor_FontStyle(Gadget.l,Flags.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
EndProcedure
Procedure Editor_FontColor(Gadget.l,Color.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Color
  SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
EndProcedure

;- Window
OpenWindow(0,0,0,200,200,"Change font example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

EditorGadget(#Editor,0,0,200,180,#PB_Editor_WordWrap)
ButtonGadget(#ButtonChange,0,180,140,20,"Change font")
ButtonGadget(#ButtonFormat,140,180,20,20,"F", #PB_Button_Toggle    )
ButtonGadget(#ButtonCopy,160,180,20,20,"C")
ButtonGadget(#ButtonPaste,180,180,20,20,"P")


Procedure SetFont()
  Editor_FontName(#Editor,Font_Name)
  Editor_FontSize(#Editor,Font_Size)
  Editor_FontStyle(#Editor,Font_Style)
  Editor_FontColor(#Editor,Font_Color)
EndProcedure
Procedure.l GetRTFCallback(dwCookie.l,pbBuff.l,cb.l,*pcb.LONG)
  ;Protected Result.l
  ;If cb = 0
  ;Result = 1
  ;Else
  CopyMemory(pbBuff,dwCookie+RTFLength,cb)
  RTFLength + cb
  ;EndIf
  *pcb\l = cb
  ProcedureReturn 0;Result
EndProcedure
Procedure.l GetRTFLenCallback(dwCookie.l,pbBuff.l,cb.l,*pcb.LONG)
  RTFLength + cb
  *pcb\l = cb
  ProcedureReturn 0
EndProcedure
Procedure GetRTF(Gadget.l,Adress.l)
  Protected Stream.EDITSTREAM
  Stream\dwCookie = Adress
  Stream\pfnCallback = @GetRTFCallback()
  RTFLength = 0
  SendMessage_(GadgetID(Gadget),#EM_STREAMOUT,#SF_RTF,@Stream)
EndProcedure
Procedure.l GetRTFLen(Gadget.l)
  Protected Stream.EDITSTREAM
  Stream\pfnCallback = @GetRTFLenCallback()
  RTFLength = 0
  SendMessage_(GadgetID(Gadget),#EM_STREAMOUT,#SF_RTF,@Stream)
  ProcedureReturn RTFLength
EndProcedure

SetFont()


Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #ButtonFormat; Format aufnehmen/setzen(Pinsel)
          If FormatMerker = 0
            Editor_FontAufnehmen(#Editor)
            FormatMerker = 1
          Else
            Editor_FontSetzen(#Editor)
            FormatMerker = 0
          EndIf
          
        Case #ButtonCopy;copy
          *Buffer = ReAllocateMemory(*Buffer,GetRTFLen(#Editor))
          GetRTF(#Editor,*Buffer)
          ClearGadgetItems(#Editor)
          
        Case #ButtonPaste ;paste
          SetGadgetText(#Editor,PeekS(*Buffer))
          
        Case #ButtonChange;- Font Aufnehmen
          Editor_FontRequester(#Editor)
      EndSelect
  EndSelect
ForEver
Hat mal jemand einen Tipp!

Gruss ... Velindos

ÄNDERUNG SOURCE: Neue Procedure, Editorgadget mit #PB_Editor_WordWrap

Re: RTF Requester Problem Effekte

Verfasst: 27.10.2014 10:32
von nicolaus
...."Durchgestrichen" oder "Unterstrichen" achten, da er diese nicht nimmt.
Wie genau meinst du das? Wenn ich deinen Code teste und in den Fonteinstellungen Durchgestrichen und Unterstrichen wähle wird dies bei mir genommen.
Getestet mit PB 5.30

Re: RTF Requester Problem Effekte

Verfasst: 28.10.2014 08:47
von Velindos
Hallo,
die Sache läuft wie folgt:
1) Programmstart + Eingabe von Text zB."aaaaaaa bbbb ccccccc"

2) Nun die "aaaaaaa " markieren und den Requester aufrufen; Font Fett, Unterstrichen, Durchgestrichen markieren und Ok.

3) Nun auf "ccccccc" setzen und Requester öffnen; nun siehst du, das Unterstrichen+Durchgestrichen noch gesetzt sind!
Neue Variante
Nun habe ich eine Neue Variante eingearbeitet mit Font_Flags die ich den Requester übergebe.

Funktioniert auch nicht den dann setzt er den Schriftschnitt(im Requester) nicht mehr?



Gruss ... Velindos

Siehe ÄNDERUNG SOURCE: Neue Procedure, Editorgadget mit #PB_Editor_WordWrap
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de