Замена richTextBox'у

[13GHOST]

Как известно RichTextBox не может держать длину более 32000 символов. Вот хотел узнать существует ли какая перспектива RichTextBox'у? Что бы он мог держать большую длину, или вообще какаие либо лучшие замены ему
заранее спасибо...

[GSerg]

Как известно RichTextBox не может держать длину более 32000 символов.

Откуда сия глупость?

[13GHOST]

нуу.... как откуда из опыта!
вы попробуйте - программа просто зависнет если длина сиволов превысит данное число

[alibek]

Драйвера надо переустановить.

[13GHOST]

alibek драйвера? и они тут причем?
просто я пишу чат, и он всегда зависал при превышении длины, причем не только у меня!

[GSerg]

Я открыл мегабайтную текстовую книгу в риче только что.

Рассмотрите вариант измерения коэффициента кривизны рук, использованного при написании того самого чата, пожалуйста...

[13GHOST]

создал пустой проект с Richtextbox'ом - все нормально, а там виснет! с чем это может быть связано?

[Konst_One]

телепаты в отпуске

[13GHOST]

нашел причину - виснет вот из-за этой строчки:
POS = SendMessage(rch.hwnd, EM_CHARFROMPOS, 0&, pt) если длина больше 32000
мне эта строчка нужна для опредиления слова над которым находится курсор

[Konst_One]

типы данных какие и как объявлена SendMessage
pt?
POS?

Код: Выделить всё

Form1, add RichTextBox
Option Explicit
Private Declare Function SendMessageAny Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Const EM_CHARFROMPOS& = &HD7

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim pt As POINTAPI, lSelStart As Long

    GetCursorPos pt
    ScreenToClient RichTextBox1.hWnd, pt
    lSelStart = SendMessageAny(RichTextBox1.hWnd, EM_CHARFROMPOS, 0&, pt)
    Caption = lSelStart
End Sub

[13GHOST]

Код: Выделить всё

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Dim pt As POINTAPI
    Dim POS As Long

код работает корректно на длине менее 32000

[13GHOST]

кароче вот вся процерура по опредилению слова под курсором:

Код: Выделить всё

Public Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String
    Dim pt As POINTAPI
    Dim POS As Long
    Dim start_pos As Integer
    Dim end_pos As Integer
    Dim ch As String
    Dim Txt As String
    Dim txtlen As Integer
    Dim i As Integer, j As Integer
   
    pt.X = X \ Screen.TwipsPerPixelX
    pt.Y = Y \ Screen.TwipsPerPixelY

    On Error Resume Next
    POS = SendMessage(rch.hwnd, EM_CHARFROMPOS, 0&, pt)
   
    If POS <= 0 Or POS >= Len(rch.Text) Then
        RichWordOver = ""
        Exit Function
    End If
   
    Txt = ""
    For i = POS To 1 Step -1
        ch = Mid(rch.Text, i, 1)
        If ch = " " Or _
           ch = "," Or _
           ch = """" Or _
           ch = "'" Or _
           ch = Chr(9) Then
            start_pos = i
            GoTo haha
        End If
    Next i
haha:
    Txt = ""
    For i = POS To Len(rch.Text)
        ch = Mid(rch.Text, i, 1)
        If ch = " " Or _
           ch = "," Or _
           ch = """" Or _
           ch = "'" Or _
           ch = Chr(9) Then
            end_pos = i
            Exit For
        End If
    Next i
   
    If end_pos > Len(rch.Text) Or end_pos <= 0 Then end_pos = Len(rch.Text)
   
    RichWordOver = RightR(Replace(Mid(rch.Text, start_pos, end_pos - start_pos), Chr(13), ""), 1)
End Function

[Konst_One]

On Error Resume Next

убери, что возвращается в POS?

[13GHOST]

в POS длина символов до того где находится курсор.
убрал On Error Resume Next все стало нормально работать

[Konst_One]

значит проблема дальше где-то