VB6 - how add unicode on Richtextbox?

[joaquim]

heres my actual code on my usercontrol:

Option Explicit

Private Const CP_UNICODE = 1200
Private Const ST_DEFAULT = 0
Private Const WM_USER = &H400
Private Const EM_SETTEXTEX = WM_USER + 97
Private Const WM_PASTE = &H302
Private Const EM_SETTARGETDEVICE = (&H400 + 72)
Private Const EM_REPLACESELW = &HC2
Private Const EM_EXGETSEL = (WM_USER + 52)
Private Const EM_EXSETSEL = (WM_USER + 53)
Private Const ST_SELECTION = &H1
Private Const ST_KEEPUNDO = 2
Private Const EM_REPLACESEL = &HC2
Private Const EM_SETSEL = &HB1


Private Type SETTEXTEX
    flags As Long
    codepage As Long
End Type

Private Type CHARRANGE
    cpMin As Long
    cpMax As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function SendMessageW Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Any, _
    lParam As Any) As Long

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    wParam As Any, _
    lParam As Any) As Long

' Guarda o estado atual numa variável interna do UserControl
Private m_WordWrap As Boolean

Public Sub SetRtfUnicode(rtb As Object, ByVal unicodeText As String)
    Dim udtSetText As SETTEXTEX
    
    ' Configura a API para injetar texto em formato UTF-16 (Unicode do Windows)
    udtSetText.flags = ST_DEFAULT
    udtSetText.codepage = CP_UNICODE
    
    ' CORREÇÃO: Passamos o ponteiro da estrutura (VarPtr) convertido para Long
    SendMessageW rtb.hwnd, EM_SETTEXTEX, ByVal VarPtr(udtSetText), ByVal StrPtr(unicodeText)
End Sub

Private Sub UserControl_Resize()
    RichTextBoxUnicode.Width = UserControl.ScaleWidth
    RichTextBoxUnicode.Height = UserControl.ScaleHeight

End Sub



Public Property Get WordWrap() As Boolean
    WordWrap = m_WordWrap
End Property

Public Property Let WordWrap(ByVal Activar As Boolean)
    RichTextBoxUnicode.RightMargin = 0
    m_WordWrap = Activar
    
    If Activar Then
        SendMessageLong RichTextBoxUnicode.hwnd, EM_SETTARGETDEVICE, 0&, 0&
    Else
        SendMessageLong RichTextBoxUnicode.hwnd, EM_SETTARGETDEVICE, 0&, 1&
    End If
    
    RichTextBoxUnicode.Refresh
End Property


Public Property Get SelText() As String
    Dim cr As CHARRANGE
    Dim fullText As String
    
    ' Obtém as posições (em caracteres) da seleção atual
    SendMessage RichTextBoxUnicode.hwnd, EM_EXGETSEL, 0, cr
    
    If cr.cpMax > cr.cpMin Then
        ' Reaproveita o teu Text (já devolve Unicode correto via EM_GETTEXTEX/CP_UNICODE)
        fullText = Me.Text
        SelText = Mid$(fullText, cr.cpMin + 1, cr.cpMax - cr.cpMin)
    Else
        SelText = ""
    End If
End Property

Public Property Let SelText(ByVal unicodeText As String)
    Dim cr As CHARRANGE
    Dim udtSetText As SETTEXTEX
    Dim resultado As Long
    
    ' 1) Lê a seleção atual diretamente da janela
    SendMessage RichTextBoxUnicode.hwnd, EM_EXGETSEL, 0, cr
    
    ' 2) Reimpõe essa mesma seleção via API, para garantir que o RichEdit
    '    está sincronizado com o que acabámos de ler (elimina desfasamento)
    SendMessage RichTextBoxUnicode.hwnd, EM_EXSETSEL, 0, cr
    
    ' 3) Substitui só a seleção
    udtSetText.flags = ST_SELECTION
    udtSetText.codepage = CP_UNICODE
    
    resultado = SendMessage(RichTextBoxUnicode.hwnd, EM_SETTEXTEX, udtSetText, ByVal StrPtr(unicodeText))
    
    Debug.Print "cpMin=" & cr.cpMin & " cpMax=" & cr.cpMax & " resultado=" & resultado
End Property

Public Property Get Text() As String
    ' CORREÇÃO: O nome da variável de retorno tem de ser igual ao nome da propriedade (Text)
    Text = RichTextBoxUnicode.Text
End Property

Public Property Let Text(ByVal unicodeText As String)
     Dim udtSetText As SETTEXTEX
    
    ' Configure the API to use Unicode (UTF-16)
    udtSetText.flags = ST_DEFAULT
    udtSetText.codepage = CP_UNICODE
    
    ' Send the message directly to the control's window handle
    SendMessage RichTextBoxUnicode.hwnd, EM_SETTEXTEX, udtSetText, ByVal StrPtr(unicodeText)
End Property

Public Property Get TextRTF() As String
    ' CORREÇÃO: O nome da variável de retorno tem de ser igual ao nome da propriedade (Text)
    TextRTF = RichTextBoxUnicode.TextRTF
End Property

Public Property Let TextRTF(ByVal unicodeText As String)
     RichTextBoxUnicode.TextRTF = unicodeText
End Property

Public Sub LoadUnicodeFile(filePath As String)
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    
    stream.Type = 2 ' adTypeText
    stream.Charset = "utf-8" ' Usa "unicode" se o ficheiro for UTF-16 (gerado pelo Bloco de Notas)
    stream.Open
    stream.LoadFromFile filePath
    
    ' Agora sim! Chamamos a nossa nova função bypass
    SetRtfUnicode RichTextBoxUnicode, stream.ReadText
    
    stream.Close
End Sub

Public Sub Paste()
    RichTextBoxUnicode.SetFocus
    SendMessageW RichTextBoxUnicode.hwnd, WM_PASTE, 0&, ByVal 0&
End Sub

' Devolve o valor atual para o painel de propriedades do IDE
Public Property Get ScrollBars() As RichTextLib.ScrollBarsConstants
    ScrollBars = RichTextBoxUnicode.ScrollBars
End Property

' Aplica o valor escolhido ao RichTextBox interno
Public Property Let ScrollBars(ByVal New_ScrollBars As RichTextLib.ScrollBarsConstants)
    RichTextBoxUnicode.ScrollBars = New_ScrollBars
    PropertyChanged "ScrollBars"
End Property

PS: the comments are in Portuguese(my language).

the Text property works fine.. but i can't put to work the SelText
objective:
1 - using the property Text;
2 - update it for use the SelText(change text or add it on cursor position).
what i'm doing wrong on SeltText() property?

[Eduardo-]

Did you try with the Krool's replacement?

[joaquim]

thanks for all

[joaquim]

ps: is here anything that make possible use unicode on IDE? thanks

[Elroy]

ps: is here anything that make possible use unicode on IDE? thanks

That's a broad statement, but, generally, NO! Code editing window is ANSI; properties display window is ANSI; BAS, FRM, & CLS files are saved as ANSI. Those limitations provide pretty high hurdles to overcome.

[anycoder]

Traditionally, the charset is configured based on the user's language in the Regional and Language Settings on pc. This allows non-Unicode applications to support a single additional charset. However, Windows allows you to choose UTF-8 to enable full Unicode support, but the easy way to build a control that supports Unicode is by using Uniscribe lib that handles text both logically and visually..