Проблема с Region

[Joo]

У объекта Graphics есть замечательная функция MeasureCharacterRanges, которая ворачивает регионы символов.
Так вот вопрос, допусти я получил регион определенного участка текста, есть у меня определенная координата X,Y, нужно проверить, входит ли эта координата в заданный регион. Как это сделать? Может кто знает?

[Joo]

Извиняюсь.... Я мегаспамер )))
Нашел выход:

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

    Public Function PointOnRegion(ByVal p As Point, ByVal r As Region) As Boolean
        Dim rs() As RectangleF = r.GetRegionScans(New Drawing2D.Matrix)
        For i As Integer = 0 To rs.Length - 1
            If p.X >= rs(i).Left And p.X <= rs(i).Right _
                And p.Y >= rs(i).Top And p.Y <= rs(i).Bottom _
                Then Return True
        Next
        Return False
    End Function

[MIT]

Шож мне нравятся подобные темы - задал вопрос и тут же сам на него ответил...

По теме: как вариант можешь заюзать

Public Function Contains(ByVal pt As System.Drawing.PointF) As Boolean
Member of System.Drawing.RectangleF

[Joo]

Шож мне нравятся подобные темы - задал вопрос и тут же сам на него ответил...

По теме: как вариант можешь заюзать

Public Function Contains(ByVal pt As System.Drawing.PointF) As Boolean
Member of System.Drawing.RectangleF

Чтож Пасибки )

[Joo]

Прикольная штука получается с помощью MeasureCharacterRanges я могу получить регион, описывающий некий участок текста, из региона с помощью функции GetRegionScans могу получить прямоугольники, составляющие регион и описывающие блоки участка текста, но знаете, что я НЕ могу? Смешно получается, если попытаться эти блоки текста вывести с помощью DrawString, указав в качестве рабочей области наши прямоугольники из региона, то выходит что некоторые блоки текста тупо в них не влезают, и естественно не выводятся :shock: скажите мне это как так?

Пример (в примере не удаеться отобразить одну строку, так как высота прямоугольника по каким-то своим пречинам на еденицу меньше чем нужно):

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

    Private Sub TestForm_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        Dim TestString As String = "Visual Basic имеет много новых и улучшенных возможностей языка, " & _
                                    "которые делают его мощным языком объектно-ориентированного " & _
                                    "программирования. Эти возможности включают наследование, " & _
                                    "интерфейсы и перегрузку. Разработчик Visual Basic может " & _
                                    "теперь создавать действительные многопоточные приложения. " & _
                                    "Среди других новых языковых возможностей Visual Basic 2008 " & _
                                    "включает структурированную обработку исключений, настраиваемые " & _
                                    "атрибуты и совместимость спецификации CLS."
        Dim DrawFont As New Font("Tahoma", 8.0F)

        Dim LayoutArea As New RectangleF(0, 0, 200, 300)

        Dim ChrRngs(0) As CharacterRange
        ChrRngs(0) = New CharacterRange(0, TestString.Length)

        Dim StrFrm As StringFormat = StringFormat.GenericTypographic
        StrFrm.FormatFlags = StringFormatFlags.LineLimit Or StringFormatFlags.MeasureTrailingSpaces
        StrFrm.SetMeasurableCharacterRanges(ChrRngs)

        With e.Graphics
            .TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
            .DrawString(TestString, DrawFont, Brushes.Black, LayoutArea, StrFrm)
            Dim TextRegion As Region = .MeasureCharacterRanges(TestString, DrawFont, LayoutArea, StrFrm)(0)
            .FillRegion(New SolidBrush(Color.FromArgb(50, Color.Red)), TextRegion)
            .TranslateTransform(220, 0)
            Dim Rects() As RectangleF = TextRegion.GetRegionScans(New Drawing2D.Matrix)
            Dim i As Integer = 0
            Dim Count As Integer = 0
            For i = 0 To Rects.Length - 1
                Debug.Print(Rects(i).ToString)
                .MeasureString(TestString, DrawFont, Rects(i).Size, StrFrm, Count, Nothing)
                .DrawString(Strings.Left(TestString, Count), DrawFont, Brushes.Black, Rects(i), StrFrm)
                TestString = TestString.Substring(Count)
            Next
        End With
    End Sub


Лично я такого поведения не понимаю.

Может кто-то предложит свой вариант? Нужна НЕБОЛЬШАЯ процедура, которая будет ПРАВИЛЬНО, т.е. с нормальным переносом строк, выводить текст в определенную область и выделять другим цветом ссылки и только. Нужно для программы Stickers. Могу положить свой вариант, построенный по вышеуказанному принципу, хотя он и подсвечивает ссылки и даже они клюкаются, но как я уже описал текст иногда местами не выводиться.

[MIT]

Я правильно понял, что у тебя трабл с MeasureString?
Если да - не парься, эта функция всегда "немного" ошибалась, так что юзай MeasureCharacterRanges. Я в парсере тоже об это споткнулся, решение - отказ от MeasureString, и, как видишь, стало заметно лучше.

[Joo]

Я правильно понял, что у тебя трабл с MeasureString?
Если да - не парься, эта функция всегда "немного" ошибалась, так что юзай MeasureCharacterRanges. Я в парсере тоже об это споткнулся, решение - отказ от MeasureString, и, как видишь, стало заметно лучше.

Ага, в какой - то момент она неверно говорит сколько символов помещается.

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

    Private Sub TestForm_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        'Строка
        Dim TestString As String = "Visual Basic имеет много новых и улучшенных возможностей языка, " & _
                                    "которые делают его мощным языком объектно-ориентированного " & _
                                    "программирования. Эти возможности включают наследование, " & _
                                    "интерфейсы и перегрузку. Разработчик Visual Basic может " & _
                                    "теперь создавать действительные многопоточные приложения. " & _
                                    "Среди других новых языковых возможностей Visual Basic 2008 " & _
                                    "включает структурированную обработку исключений, настраиваемые " & _
                                    "атрибуты и совместимость спецификации CLS. http://www.microsoft.com" & _
                                    " - сайт разработчика VB. Пример создал Scarabey (http://www.sbgroup.kz)"
        'Шрифт
        Dim DrawFont As Font = Me.Font

        'Рабочая область
        Dim LayoutArea As New RectangleF(20, 20, 460, 1000)

        'Настройка позиций блоков текста
        Dim ChrRngs(0) As CharacterRange
        ChrRngs(ChrRngs.Length - 1).First = 0

        'Выдергиваем ссылки
        Try
            Dim RegexObj As New Regex("\b((?:https?|ftp|file)://[-A-Z0-9+&@#/%?=~_|!:,.;]*[-A-Z0-9+&@#/%=~_|])", RegexOptions.IgnoreCase)
            Dim MatchResults As Match = RegexObj.Match(TestString)
            While MatchResults.Success
                'Закончил блок
                ChrRngs(ChrRngs.Length - 1).Length = MatchResults.Index - ChrRngs(ChrRngs.Length - 1).First

                'Добовляем новый
                ReDim Preserve ChrRngs(ChrRngs.Length)
                ChrRngs(ChrRngs.Length - 1).First = MatchResults.Index
                ChrRngs(ChrRngs.Length - 1).Length = MatchResults.Length

                'Начинаем  новый
                ReDim Preserve ChrRngs(ChrRngs.Length)
                ChrRngs(ChrRngs.Length - 1).First = MatchResults.Index + MatchResults.Length
                MatchResults = MatchResults.NextMatch()
            End While
        Catch ex As ArgumentException
        End Try
        'Заканчиваем последний
        ChrRngs(ChrRngs.Length - 1).Length = TestString.Length - ChrRngs(ChrRngs.Length - 1).First

        'Настройка формата вывод
        Dim StrFrm As StringFormat = StringFormat.GenericTypographic
        StrFrm.FormatFlags = StringFormatFlags.NoClip Or StringFormatFlags.MeasureTrailingSpaces
        StrFrm.Trimming = StringTrimming.Character
        StrFrm.SetMeasurableCharacterRanges(ChrRngs)

        'Выводим
        With e.Graphics
            .TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
            Dim i = 0, j = 0, Count As Integer = 0
            Dim Rects() As RectangleF
            Dim TextRegions() As Region = .MeasureCharacterRanges(TestString, DrawFont, LayoutArea, StrFrm)
            Dim TextBrush As Brush = New SolidBrush(Color.Black)
            For j = 1 To TextRegions.Length
                Rects = TextRegions(j - 1).GetRegionScans(New Drawing2D.Matrix)
                If j / 2 = j \ 2 Then
                    TextBrush = New SolidBrush(Color.Blue)
                    .FillRegion(New SolidBrush(Color.FromArgb(50, Color.Green)), TextRegions(j - 1))
                Else
                    TextBrush = New SolidBrush(Color.Black)
                    .FillRegion(New SolidBrush(Color.FromArgb(50, Color.Red)), TextRegions(j - 1))
                End If
                For i = 0 To Rects.Length - 1
                    .MeasureString(TestString, DrawFont, Rects(i).Size, StrFrm, Count, Nothing)
                    .DrawString(Strings.Left(TestString, Count), DrawFont, TextBrush, Rects(i), StrFrm)
                    TestString = TestString.Substring(Count)
                Next
            Next
        End With
    End Sub

Вся бага в том месте где я пытаюсь получить кол-во символов которое входит в прямоугольник, прямоугольники определил функцией MeasureCharacterRanges... Я злой, кто писал этот гребаный фрамеворк.

[MIT]

Я злой, кто писал этот гребаный фрамеворк.

Ну, "фрамеворк" тут не причем: MeasureString - это API, причем почти без "украшательств".
Вообще то, MeasureString определяет прямоугольник несколько больший, чем MeasureCharacterRanges: примерно по 2px влево и вправо и 1px вверх, но в общем работает верно. Запусти этот проектик, работает правильно:

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

Public Class Form1
    Dim r As Rectangle
    Dim t As String
    Dim sf As SizeF

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        t = "text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text"
End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        With e.Graphics
            Dim ch, ln As Integer
            Dim h As Integer = Me.Font.Height
            sf = .MeasureString(t, Me.Font, New SizeF(r.Width, IIf(Not r.Height Mod h, r.Height - h, r.Height)), System.Drawing.StringFormat.GenericDefault, ch, ln)
            If t.Length > ch Then
                .DrawString(Mid(t, 1, ch - 6) & " . . .", Me.Font, Brushes.Black, r)
                .DrawRectangle(Pens.Red, r)
            Else
                .DrawString(t, Me.Font, Brushes.Black, r)
                .DrawRectangle(Pens.Blue, r)
            End If
        End With
    End Sub
Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        r = New Rectangle(10, 10, Width - 25, Height - 45)
        Me.Invalidate()
End Sub
End Class

В данном тобой коде вроде все верно (за исключением 2ой ссыли), а чего тебя не устраивает-то?

P.S. Мне ну очень понравилось сравнение j / 2 = j \ 2

[Joo]

В данном тобой коде вроде все верно (за исключением 2ой ссыли), а чего тебя не устраивает-то?

Я нашел камень преткновения. Смотри, как - то странно MeasureString на пробелы реагирует, т.е. пробелы функция не учитывает

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

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        'Настройка формата вывод
        Dim StrFrm As StringFormat = StringFormat.GenericTypographic
        StrFrm.FormatFlags = StringFormatFlags.NoClip Or StringFormatFlags.MeasureTrailingSpaces
        StrFrm.Trimming = StringTrimming.Character

        Dim Count As Integer = 0
        e.Graphics.MeasureString("мама                                                                                                                                    папа", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-пробелы-текст: " & Count.ToString)
        e.Graphics.MeasureString("мамаммамамамамамаммамамамамамамамамамамамамамамамамаммамамамамамамамамамамаммамамамаммамамамамамамаммамамамамамамаммамамаммаммамамамамамммам", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-текст-текст: " & Count.ToString)
    End Sub

У меня результат:
Текст-пробелы-текст: 136
Текст-текст-текст: 24
Как сделать чтобы все пробелы тоже учитывались? Даже если шрифт фиксированный Courier New, результат не лучше.

P.S. Мне ну очень понравилось сравнение j / 2 = j \ 2

Можно еще так j Mod 2 = 0 Ты не думай, я не совсем ламер

[MIT]

Можно еще так j Mod 2 = 0 Ты не думай, я не совсем ламер

Да я не про ламерство, просто красиво выглядит. Если хочешь, что можно еще круче if j Mod 2 then

пробелы функция не учитывает

Учитывает, причем в нижеследующем коде даже правильно (получается, что без вордврапа все верно):

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

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        'Настройка формата вывод
        Dim StrFrm As StringFormat = StringFormat.GenericTypographic
        'StrFrm.FormatFlags = StringFormatFlags.NoClip Or StringFormatFlags.MeasureTrailingSpaces
        'StrFrm.Trimming = StringTrimming.Character

        Dim Count As Integer = 0
        e.Graphics.MeasureString("мамапапа", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-текст-текст: " & Count.ToString)
        e.Graphics.MeasureString("мама        папа", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-пробелы-текст: " & Count.ToString)
        e.Graphics.MeasureString("мамапапа        ", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-текст-пробелы: " & Count.ToString)
        e.Graphics.MeasureString("        мамапапа", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("пробелы-текст-текст: " & Count.ToString)
        e.Graphics.MeasureString("        мамапапа        ", Me.Font, New SizeF(153, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("пробелы-текст-пробелы: " & Count.ToString)
    End Sub

Но когда я делал парсер, у меня тоже по началу были проблемы с пробелами: то они не учитывались, то учитывался только один вместо 20.

[Joo]

Не работает.
Ты удлинни строки, чтобы они не вмещались, по идее, в прямоугольник.
Вот мои строки и ширина прямоугольника 50 пикселей
Результаты:
Текст-текст-текст: 8 <- тут ясно он культурно по символам обрезал, вот столько должно влазить 8
Текст-пробелы-текст: 114
Текст-текст-пробелы: 118
пробелы-текст-текст: 114
пробелы-текст-пробелы: 50 <- тут только дойдя до текста по серединке он понял что переборщил на 40+ символов ))

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

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        'Настройка формата вывод
        Dim StrFrm As StringFormat = StringFormat.GenericTypographic
        'StrFrm.FormatFlags = StringFormatFlags.NoClip Or StringFormatFlags.MeasureTrailingSpaces
        'StrFrm.Trimming = StringTrimming.Character

        Dim Count As Integer = 0
        e.Graphics.MeasureString("мамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамамама", Me.Font, New SizeF(50, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-текст-текст: " & Count.ToString)

        e.Graphics.MeasureString("мама                                                                                                              мама", Me.Font, New SizeF(50, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-пробелы-текст: " & Count.ToString)

        e.Graphics.MeasureString("мама                                                                                                                  ", Me.Font, New SizeF(50, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("Текст-текст-пробелы: " & Count.ToString)

        e.Graphics.MeasureString("                                                                                                                  мама", Me.Font, New SizeF(50, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("пробелы-текст-текст: " & Count.ToString)

        e.Graphics.MeasureString("                                                  мамамама                                                            ", Me.Font, New SizeF(50, Me.Font.Height), StrFrm, Count, Nothing)
        Debug.Print("пробелы-текст-пробелы: " & Count.ToString)
    End Sub


[MIT]

И правда. Странно. Так вот, ты (да и я, впрочем, тоже) не первый столкнулся с этой проблемой. Полного и корректного решения пока не существует.

According to the help a few overloads of the method take a StringFormatFlags argument, the description of the field MeasureTrailingSpaces suggests that this field needs to be set in your case.

However I must say that the method approximate the textlength fairly, I often encountered though that the method predict the length of the texts often too long. Implementing a deletion routine by boxselecting my test users find text not deleted though they selected the text by box. MeasureString I used to calculate the text length, which seems to be predicted too long at certain scales. If your program doesn't scale that often as my graphics program does you probably will not have this problem.

Anyway there is no other way then MeasureString(), and perhaps some future version will be better in its length estimation, which is after all a tricky point.

[Joo]

Ишожеделать

[MIT]

Попробовать подойти к проблеме с другой стороны.
Опиши свою идею, входные данные и необходимый результат - помозгуем

[Nord777]

Ребят не гадайте
MeasureString расчитана под рендеринг в TextBox именно поэтому она прибавляет к обеим краям определенное расстояние.

[Joo]

Ребят не гадайте
MeasureString расчитана под рендеринг в TextBox именно поэтому она прибавляет к обеим краям определенное расстояние.

Не-не-не, у нас нет лишних пробелов, у нас просто они не учитываются

Я сейчас задачу ссформулирую, или даже положу исходник и скажу что там не так

Добавлено:
В общем вот програмка и исходник, ясна идея, нужно сделать автодетект ссылок , по которым можно кликать.

Пример не работает как надо, поексперементируйте. Попробуйте после ссылок наставить пробелов (просто после ссылок легче попасть в конец прямоугольника), эти пробелы не отобразяться, но начнеться смешение, т.к. неверно определяется кол-во символов которое помещается в прямоугольник

p.s. Можно сделать проще, у меня есть полностью рабочий вариант, но там нет нормального вордврапа

[MIT]

Не знаю, может тебе поможет, поэксперементируй

'Тут несколько перегрузок
Public Shared Function MeasureText(ByVal text As String, ByVal font As System.Drawing.Font) As System.Drawing.Size
Member of System.Windows.Forms.TextRenderer

Кстати себе я вордврап сделал (работает процентах в 70 случаев, но работает!)... попозже в теме (про парсер) отпишусь.

[Joo]

Не знаю, может тебе поможет, поэксперементируй

'Тут несколько перегрузок
Public Shared Function MeasureText(ByVal text As String, ByVal font As System.Drawing.Font) As System.Drawing.Size
Member of System.Windows.Forms.TextRenderer

Кстати себе я вордврап сделал (работает процентах в 70 случаев, но работает!)... попозже в теме (про парсер) отпишусь.

Короче я решил все таки от этой идеи откзаться и сделать подругому, всем спасибо за участие )