PureBasic Forums - English

Posted: **Sun Jun 25, 2006 4:57 pm**

Code updated For 5.20+

I just put it into my font example so you could test it.
Use C and P buttons to cut and paste it using the buffer.

Code: Select all

    ; --------------------------------------------------------
    ; 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

    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

    #Editor = 0
    #Button = 1

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

    EditorGadget(#Editor,0,0,200,180)
    ButtonGadget(#Button,0,180,160,20,"Change font")
    ButtonGadget(2,160,180,20,20,"C")
    ButtonGadget(3,180,180,20,20,"P")

    Global Font_Name.s = "Arial", Font_Size.l = 12, Font_Style.l, Font_Color.l

    Procedure SetFont()
      Editor_FontName(#Editor,Font_Name)
      Editor_FontSize(#Editor,Font_Size)
      Editor_FontStyle(#Editor,Font_Style)
      Editor_FontColor(#Editor,Font_Color)
    EndProcedure

    Global RTFLength

    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()

    Define *Buffer = AllocateMemory(1)

    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 2 ;copy
              *Buffer = ReAllocateMemory(*Buffer,GetRTFLen(#Editor))
              GetRTF(#Editor,*Buffer)
              ClearGadgetItems(#Editor)
            Case 3 ;paste
              SetGadgetText(#Editor,PeekS(*Buffer))
            Case #Button
              If FontRequester(Font_Name,Font_Size,#PB_FontRequester_Effects,Font_Color)
                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
               
                SetFont()
                SetActiveGadget(#Editor)
              EndIf
          EndSelect
      EndSelect
    ForEver

I did much testing, even with large files (75kb).
And here cb never returns 0, and if it does it should enough to just copy that to *pcb and it will end properly.
Maybe you need the Result = 1 stuff on other computers but I didn't need it.
But it's all there commented away if you need it.

Read more about the stuff here:
http://msdn.microsoft.com/library/defau ... llback.asp

PureBasic Forums - English

Copy EditorGadget RTF into a buffer, and write it back

Copy EditorGadget RTF into a buffer, and write it back