Edit & RichEdit Controls for experiments[Windows]

[RASHAD]

'Nico' raised some bug with MS RichEdit Control (EditorGadget) when using it for plain text
It is MS bug not PB

Code: Select all

Global HwndEditText,HwndEditText1

Global RTFPtr.l,a.s 

Procedure StreamFileInCallback(dwCookie, pbBuff, cb, pcb) 
  result = 0 
  If RTFPtr>=?RTFEnd 
    cb = 0 
    result = 1 
  ElseIf RTFPtr+cb>=?RTFEnd 
    cb = ?RTFEnd-RTFPtr 
  EndIf 
  CopyMemory(RTFPtr, pbBuff, cb) 
  RTFPtr+cb 
  PokeL(pcb, cb) 
  ProcedureReturn result 
EndProcedure 

Procedure SendStream() 
  RTFPtr=?RTFStart 
  uFormat = #SF_RTF    ;#SF_TEXT 
  edstr.EDITSTREAM 
  edstr\dwCookie = 0 
  edstr\dwError = 0 
  edstr\pfnCallback = @StreamFileInCallback() 
  SendMessage_(HwndEditText1, #EM_STREAMIN, uFormat, edstr) 
EndProcedure 


Procedure CreateEditText() 

  hInstance = GetModuleHandle_(0) 
  HwndEditText  = CreateWindowEx_(#WS_EX_STATICEDGE,"EDIT","", #WS_VISIBLE | #WS_CHILDWINDOW | #ES_AUTOHSCROLL  | #WS_VSCROLL | #ES_MULTILINE | #ES_WANTRETURN |#ES_NOHIDESEL, 50,50,300,300,WindowID(0),200,hInstance,0) 
  
  If OpenLibrary(0,"msftedit.dll")
    Class_Name$ = "RichEdit50W"
  ElseIf OpenLibrary(0,"Riched20.dll") And Class_Name$ = ""
    Class_Name$ = "RichEdit20W"
  ElseIf OpenLibrary(0,"Riched32.dll") And Class_Name$ = ""
    Class_Name$ = "RichEdit"
  Else
    MessageRequester("Error","Sorry ,RichEdit Can not be created",#MB_ICONWARNING)
  EndIf  
  HwndEditText1 = CreateWindowEx_(#WS_EX_STATICEDGE,Class_Name$,"", #WS_VISIBLE | #WS_CHILDWINDOW | #ES_AUTOHSCROLL  | #WS_VSCROLL | #ES_MULTILINE | #ES_WANTRETURN |#ES_NOHIDESEL, 500,50,300,300,WindowID(0),300,hInstance,0) 
  
EndProcedure


If OpenWindow(0,0,0,900,600,"Basic Text Control",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CreateEditText()
  If CreatePopupMenu(0)
      MenuItem(1, "Undo")
      MenuItem(2, "Cut")
      MenuItem(3, "Copy")
      MenuItem(4, "Paste")
      MenuBar()
      OpenSubMenu("Options")
        MenuItem(5, "Window...")
        MenuItem(6, "Gadget...")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "Quit")
  EndIf

  ;SendMessage_(HwndEditText1,#EM_SETREADONLY, 1, 0)                      ;Edit OFF
  ;SendMessage_(HwndEditText1,#EM_SETREADONLY, 0, 0)                      ;Edit ON
  SendMessage_(HwndEditText,#EM_SETTARGETDEVICE,0, 0)                     ;WordWrap ON
  ;SendMessage_(HwndEditText1, #EM_SETTARGETDEVICE, 0, 1)                 ;WordWrap OFF
  SendMessage_(HwndEditText1,#EM_SETTARGETDEVICE,0, 0)
  ButtonGadget(1,50,500,80,24,"Paste")
  
   EndIf
   
   Text$="Line :"+Str(i)+Chr(13)+Chr(10)
   For i = 1 To 31
     SendMessage_(HwndEditText,#EM_REPLACESEL,0,Text$)
   Next
   
     ;SendMessage_(HwndEditText1, #EM_SETTEXTMODE, #TM_PLAINTEXT, 0)     ;Plain Text
     ;SendMessage_(HwndEditText1, #EM_SETTEXTMODE, #TM_RICHTEXT, 0)      ;RTF Format
     
     ;********************************* ( Send RTF direct )***********************************************
     a.s="{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}{\colortbl ;\red255\green0\blue0;\red0\green0\blue0;}"
     a=a+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20 Hello, this is \cf1\b\fs32 RTF\cf2\b0\fs20 direct!\cf0\par}"
     *MemoryBuffer = AllocateMemory(Len(a.s)+1)
     PokeS(*MemoryBuffer, a.s, Len(a.s)+1,#PB_Ascii)  
     SendMessage_(HwndEditText1,#EM_REPLACESEL,0,PeekS(*MemoryBuffer ,Len(a.s)+1,#PB_Unicode))     
     ;****************************************************************************************************
     
     ;***************************************( Send Stream RTF )******************************************
     ;SendStream()               ;For Test.rtf
     ;****************************************************************************************************
     Repeat
      Select WaitWindowEvent()
      
        Case #PB_Event_CloseWindow
          Q = 1
      
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
                  SetFocus_(HwndEditText1)
                  SendMessage_(HwndEditText1,#WM_PASTE,0,0)
                  SendMessage_(HwndEditText1,#EM_REPLACESEL,0,#CRLF$)
                  
          EndSelect
                  
        Case #PB_Event_Menu
      
          Select EventMenu()  ; To see which menu has been selected
              
              Case 1
                  SendMessage_(GetFocus_(),#WM_UNDO,0,0)

              Case 2
                  SendMessage_(GetFocus_(),#WM_CUT,0,0)
    
              Case 3
                  SendMessage_(GetFocus_(),#WM_COPY,0,0)
    
              Case 4
                  SendMessage_(GetFocus_(),#WM_PASTE,0,0)
    
              Case 7
                Q = 1

               
            EndSelect
            
          Case #WM_RBUTTONDOWN
            DisplayPopupMenu(0, WindowID(0))
            
      EndSelect
    Until Q = 1
    CloseLibrary(0)
  End  
    
DataSection 
  RTFStart: 
  IncludeBinary "test.rtf"    ; change this path to you own file!
  RTFEnd: 
EndDataSection

[Kwai chang caine]

Hello RASHAD
I have an error, on the END line 137

And i have not really understand what your code do

[Vitor_Boss®]

This code is to see a colored/formated text.

I will try fix it cause i use this in a VB6 application and I'm porting to PB.

Thank you very much.

[RASHAD]

Sorry KCC
I was and still very busy
- Open WoprdPad and write any formatted text with different font name,font size,font color
- Save the file as 'Test.rtf' in the same dir of this code

I was testing a bug with the scrollbar of the EditorGadget as 'Nico' mentioned
Beside now you can use RichEdit Control Ver 3.0 if you like to do that
And you can use Edit Control for Plain Text w/o any problem

Sorry again KCC

and have a good day sir

[Vitor_Boss®]

Code: Select all

PokeS(*MemoryBuffer, a.s, Len(a.s)+1,#PB_Ascii)  
     SendMessage_(HwndEditText1,#EM_REPLACESEL,0,PeekS(*MemoryBuffer ,Len(a.s)+1,#PB_Unicode)) 

This lines have a mismatch, first you call PokeS with #PB_Ascii flag and after you call PeekS with #PB_Unicode flag. Are you sure of that?

[RASHAD]

Hi Vitor

Compile the next code as Unicode
And do what you want to do with it and see the difference

Code: Select all

Global HwndEditText,HwndEditText1

Procedure CreateEditText() 

  hInstance = GetModuleHandle_(0) 
  HwndEditText  = CreateWindowEx_(#WS_EX_STATICEDGE,"EDIT","", #WS_VISIBLE | #WS_CHILDWINDOW | #ES_AUTOHSCROLL  | #WS_VSCROLL | #ES_MULTILINE | #ES_WANTRETURN |#ES_NOHIDESEL, 50,50,300,300,WindowID(0),200,hInstance,0) 
  
  If OpenLibrary(0,"msftedit.dll")
    Class_Name$ = "RichEdit50W"
  ElseIf OpenLibrary(0,"Riched20.dll") And Class_Name$ = ""
    Class_Name$ = "RichEdit20W"
  ElseIf OpenLibrary(0,"Riched32.dll") And Class_Name$ = ""
    Class_Name$ = "RichEdit"
  Else
    MessageRequester("Error","Sorry ,RichEdit Can not be created",#MB_ICONWARNING)
  EndIf  
  HwndEditText1 = CreateWindowEx_(#WS_EX_STATICEDGE,Class_Name$,"", #WS_VISIBLE | #WS_CHILDWINDOW | #ES_AUTOHSCROLL  | #WS_VSCROLL | #ES_MULTILINE | #ES_WANTRETURN |#ES_NOHIDESEL, 500,50,300,300,WindowID(0),300,hInstance,0) 
  
EndProcedure


If OpenWindow(0,0,0,900,600,"Basic Text Control",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CreateEditText()
  If CreatePopupMenu(0)
      MenuItem(1, "Undo")
      MenuItem(2, "Cut")
      MenuItem(3, "Copy")
      MenuItem(4, "Paste")
      MenuBar()
      OpenSubMenu("Options")
        MenuItem(5, "Window...")
        MenuItem(6, "Gadget...")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "Quit")
  EndIf

  ;SendMessage_(HwndEditText1,#EM_SETREADONLY, 1, 0)                      ;Edit OFF
  ;SendMessage_(HwndEditText1,#EM_SETREADONLY, 0, 0)                      ;Edit ON
  SendMessage_(HwndEditText,#EM_SETTARGETDEVICE,0, 0)                     ;WordWrap ON
  ;SendMessage_(HwndEditText1, #EM_SETTARGETDEVICE, 0, 1)                 ;WordWrap OFF
  SendMessage_(HwndEditText1,#EM_SETTARGETDEVICE,0, 0)
  ButtonGadget(1,50,500,80,24,"Paste")
  
   EndIf
   
   Text$="Line :"+Str(i)+Chr(13)+Chr(10)
   For i = 1 To 31
     SendMessage_(HwndEditText,#EM_REPLACESEL,0,Text$)
   Next
   
     ;SendMessage_(HwndEditText1, #EM_SETTEXTMODE, #TM_PLAINTEXT, 0)     ;Plain Text
     ;SendMessage_(HwndEditText1, #EM_SETTEXTMODE, #TM_RICHTEXT, 0)      ;RTF Format
     
     ;********************************* ( Send RTF direct )***********************************************
     a.s="{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\fswiss\fcharset0 Arial;}}{\colortbl ;\red255\green0\blue0;\red0\green0\blue0;}"
     a=a+"{\*\generator Msftedit 5.41.15.1503;}\viewkind4\uc1\pard\f0\fs20 Hello, this is \cf1\b\fs32 RTF\cf2\b0\fs20 direct!\cf0\par}"
     *MemoryBuffer = AllocateMemory(Len(a.s)+1)
     PokeS(*MemoryBuffer, a.s, Len(a.s)+1,#PB_Ascii)  
     SendMessage_(HwndEditText1,#EM_REPLACESEL,0,PeekS(*MemoryBuffer ,Len(a.s)+1,#PB_Unicode))     
     ;****************************************************************************************************
     
    Repeat
      Select WaitWindowEvent()
      
        Case #PB_Event_CloseWindow
          Q = 1
      
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
                  SetFocus_(HwndEditText1)
                  SendMessage_(HwndEditText1,#WM_PASTE,0,0)
                  SendMessage_(HwndEditText1,#EM_REPLACESEL,0,#CRLF$)
                  
          EndSelect
                  
        Case #PB_Event_Menu
      
          Select EventMenu()  ; To see which menu has been selected
              
              Case 1
                  SendMessage_(GetFocus_(),#WM_UNDO,0,0)

              Case 2
                  SendMessage_(GetFocus_(),#WM_CUT,0,0)
    
              Case 3
                  SendMessage_(GetFocus_(),#WM_COPY,0,0)
    
              Case 4
                  SendMessage_(GetFocus_(),#WM_PASTE,0,0)
    
              Case 7
                Q = 1

               
            EndSelect
            
          Case #WM_RBUTTONDOWN
            DisplayPopupMenu(0, WindowID(0))
            
      EndSelect
    Until Q = 1
    CloseLibrary(0)
  End  

and have a nice day

[Kwai chang caine]

@Vitor_Boss®
Thanks for explain to KCC

Sorry again KCC

I'm already so happy, you have take the time to answer me

and have a good day sir

Thanks for your explanation, and very good day to you

[Vitor_Boss®]

It works now, thanks.

I think what I need is more hard. I need add a line in the control with code only. Look my example on VB6:

Code: Select all

Public Sub AddMessages(RICHTEXT As Object, ByVal Color As Long, Message As String, Optional Bold As Boolean)
    With RICHTEXT
        .SelStart = Len(.Text) 'Move to end of RTB.
        .SelFontName = "Tahoma" 'Set font.
        .SelFontSize = 8.5 'Set font size.
        .SelBold = Bold
        .SelItalic = False
        .SelUnderline = False
        .SelColor = Color
        .SelText = Message & vbCrLf
    End With
End Sub

PB equivalent.

Well, the Bold, Italic I know how reproduce in that example, but the color is the problem.

This return only Chinese characters, how fix it?
Any Idea?

[Vitor_Boss®]

Hi guys, after many tries I've make it work.

This code add a text to editor gadget with color, size and format.

Code: Select all

Procedure.s IIFs(Expression,TruePart$,FalsePart$)
  If is(Expression) >= #True
    ProcedureReturn TruePart$
  EndIf
  ProcedureReturn FalsePart$
EndProcedure
Procedure Split(Array Result.s(1), Expression.s, Delimiter.s,Limit.l=-1)
  Protected.i i, ii, C
  Protected.l Length, Size, Position
  ii = CountString(Expression, Delimiter)
  If ii=0
    ReDim Result(0)
    Result(0) = Expression
  Else
    If Limit > 0 And ii > Limit-1
      ii = Limit-1
    EndIf
    ReDim Result(ii)
    If Len(Delimiter)>1
      Size = Len(Delimiter)
      Position = 1
      For C = 0 To ii-1
        Length = FindString(Expression, Delimiter, Position) - Position
        Result(C) = Mid(Expression, Position, Length)
        Position + Length + Size
      Next
      Result(C) = Mid(Expression, Position)
    Else
      For C = 0 To ii - 1
        Result(C) = StringField ( Expression, C+1, Delimiter )
        i + Len(Result(C)) + Len(Delimiter)
      Next
      Result(C) = Mid(Expression, i+1)
    EndIf
  EndIf
EndProcedure
Procedure.s AddMessages(Gadget.l,Message.s,Color.l=-1,Bold.b=#False,Italic.b=#False,Size.i=-1)
  ;{ Declarations
  Protected.s Temp, Original, Output
  Protected.l i, Pos, ColorCounter
  Protected Dim TempArray.s(0)
  Protected Dim TempColors.s(0)
  Protected Dim Colors.l(0)
  Protected *Buffer = AllocateMemory(GetRTFLen(Gadget) + 1)
  ;}
 *Buffer = AllocateMemory(GetRTFLen(Gadget) + 1)
  ReplaceString(Message, #CRLF$, #CR$)
  ReplaceString(Message, #LF$, #CR$)
  ReplaceString(Message, #CR$, #CRLF$)
  ;{-Format Text
  GetRTF(Gadget,*Buffer)
  Original = PeekS(*Buffer,StringByteLength(PeekS(*Buffer)),#PB_Ascii)
  If Color <> -1
    Split(TempArray(), Original, "}")
    If FindString(Original,"{\colortbl ;",1)
      Split(TempArray(),TempArray(ArraySize(TempArray())-2),";")
      ColorCounter=ArraySize(TempArray())
      ReDim Colors(ColorCounter+1)
      While Pos < ColorCounter-1
        Split(TempColors(),TempArray(Pos+1),"\")
        Colors(Pos)=RGB(Val(Right(TempColors(0),Len(TempColors(0))-3)),Val(Right(TempColors(1),Len(TempColors(1))-5)),Val(Right(TempColors(2),Len(TempColors(2))-4)))
        If Color <> -1 And Color = Colors(Pos)
          Temp + "\cf"+Str(Pos)
        EndIf
        Pos+1
      Wend
      If Len(Temp)=0
        i = FindString(Original,TempArray(ArraySize(TempArray())-1),1) + Len(TempArray(ArraySize(TempArray())-1))+1
        Original = Left(Original,i-1) + "\red"+Str(Red(Color)) + "\green"+Str(Green(Color)) + "\blue"+Str(Blue(Color))+";" + Right(Original,Len(Original)-i+1)
        Temp + "\cf"+Str(Pos+1)
      EndIf
    Else
      i = FindString(Original,";}}", 1) + 3
      Original = Left(Original,i-1) + Chr(13) + "{\colortbl ;"+"\red"+Str(Red(Color)) + "\green"+Str(Green(Color)) + "\blue"+Str(Blue(Color))+";}" + Mid(Original, i+1)
      Temp + "\cf1"
    EndIf
  EndIf
  If Size <>-1
    Temp + "\fs" + Str(Size)
  EndIf
  If Bold=#True
    Temp + "\b"
  EndIf
  If Italic=#True
    Temp + "\i"
  EndIf
  If (Right(Message,2) = #CRLF$)
    Temp + " " + Left(Message,Len(Message)-2)
  Else
    Temp + " " + Message
  EndIf
  If Bold=#True
    Temp + "\b0"
  EndIf
  If Italic=#True
    Temp + "\i0"
  EndIf
  If (Right(Message,2) = #CRLF$)
    Temp + "\par"
  EndIf  ;}
  Split(TempArray(), Temp, #CRLF$)
  Temp = TempArray(0) +"\par"
  For i = 1 To ArraySize(TempArray())
    Temp + TempArray(i) +"\par"
  Next
  i = FindString(Original,"\cf0\",1)-1
  Pos = FindString(Original,"\cf1\f0\fs",1)
  If i > 0
    Original = Left(Original,i) + IIFs((Pos>0), "\cf1\f0\fs"+Temp, Temp) + Mid(Original,i+1)
  Else
    i = FindString(Original,"\par"+#CRLF$+"}",1)-1
    Original = Left(Original,i+4) + Temp + Mid(Original,i+5)
  EndIf  
  *Buffer = ReAllocateMemory(*Buffer, StringByteLength(Original))
  PokeS(*Buffer, Original, -1, #PB_Ascii)
  SetGadgetText(Gadget, PeekS(*Buffer,Len(Original),#PB_Unicode))
EndProcedure

I need help with one thing, after a TON of lines the debugger crash.

[Vitor_Boss®]

Working example:

Code: Select all

Enumeration
  #Window_0
EndEnumeration
Enumeration
  #Button_0
  #Button_1
  #Button_2
  #String_0
  #Editor_0
EndEnumeration
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 371, 30, 474, 263, "New window ( 0 )",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
      ButtonGadget(#Button_0, 365, 105, 100, 40, "Blue")
      ButtonGadget(#Button_1, 365, 5, 100, 40, "Red")
      ButtonGadget(#Button_2, 365, 55, 100, 40, "Green")
      StringGadget(#String_0, 5, 5, 355, 20, "Test Text")
      EditorGadget(#Editor_0, 5, 30, 355, 230)      
  EndIf
EndProcedure
Open_Window_0()

  Repeat ; Start of the event loop
    Define Event = WaitWindowEvent() ; This line waits until an event is received from Windows
    Define WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
    Define EventType = EventType() ; The event type
    
    Select Event
      Case #PB_Event_Gadget
        Define GadgetID = EventGadget() ; Is it a gadget event?
        Select EventType
        Case #PB_EventType_LeftClick
          If GadgetID = #Button_0
            AddMessages(#Editor_0, GetGadgetText(#String_0), RGB(0,0,$FF),0,1,48)
          ElseIf GadgetID = #Button_1
            AddMessages(#Editor_0, GetGadgetText(#String_0), RGB($FF,0,0),1,0,20)
          ElseIf GadgetID = #Button_2
            AddMessages(#Editor_0, GetGadgetText(#String_0), RGB(0,$FF,0),1,1,36)
          EndIf
          SendMessage_(GadgetID(#Editor_0),#EM_SETSEL, GetRTFLen(#Editor_0), GetRTFLen(#Editor_0))
      EndSelect
    EndSelect  
   Until (Event = #PB_Event_CloseWindow)

Any idea?