Page 98 of 98 FirstFirst ... 488895969798
Results 3,881 to 3,888 of 3888

Thread: CommonControls (Replacement of the MS common controls)

  1. #3881

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,514

    Re: CommonControls (Replacement of the MS common controls)

    Update released.

    Major performance improvement of the .ListItemIndices property in the LvwGroup class. (comctl version 6.1 [Vista+]; 6.0 remains slow [XP])
    Included the .ListItemCount property in the LvwGroup class. (comctl version 6.1 [Vista+] only)

  2. #3882
    Addicted Member
    Join Date
    Jan 2008
    Posts
    153

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by jpbro View Post
    You are returning the result of the SendMessage/EM_FORMATRANGE call in GetRichTextHeight, which I believe is the number of characters printed. Instead your should return fr.rc.bottom to get the height of the text in twips (or 0 if fr.rc.bottom = &H7FFFFFFF).
    Ok and Thanks jpbro, but I tested with ChatGPT and there has been no way to make it work, there is this that does work but without taking into account images or objects:
    Code:
    Private Function GetTotalTextHeight(rtbHwnd As Long, rtbFont As StdFont, Text As String) As Long
        Dim iPT1 As POINTAPI
        Dim iPt2 As POINTAPI
        Dim iCharPos As Long
        Dim lTotalHeight As Long
    
        ' Get the position of the first character (start of the text)
        SendMessageAnyAny rtbHwnd, EM_POSFROMCHAR, iPT1, ByVal CLng(0)
    
        ' Get the index of the first character of the last line
        Dim lastLineIndex As Long
        lastLineIndex = SendMessage(rtbHwnd, EM_LINEFROMCHAR, Len(Text) - 1, 0&)
        
        ' Get the position of the first character of the last line
        iCharPos = SendMessage(rtbHwnd, EM_LINEINDEX, ByVal lastLineIndex, 0&)
        
        ' Get the position of the last line
        If iCharPos > -1 Then
            SendMessageAnyAny rtbHwnd, EM_POSFROMCHAR, iPt2, ByVal iCharPos
            ' Calculate the total height of the text
            lTotalHeight = iPt2.Y - iPT1.Y
    
            ' Ensure to add the font height if necessary
            If Not IsNull(rtbFont.Size) Then
                lTotalHeight = lTotalHeight + ScaleY(rtbFont.Size, vbPoints, vbPixels)
            End If
        End If
    
        ' Return the total height in pixels
        GetTotalTextHeight = lTotalHeight
    End Function
    And I cannot understand why in years an RTBTotalHeight property or something similar has not been added, because in many cases if you want to show all the content of the RTB, it is important to know the height of everything in the RTB... For example for put in a ToolTip with RichTextBox - a very good tooltip -, is necessary know the total height of the content of the RTB...

    I haven't checked by looking at the subclassed vertical scroll bar, I have to try to look there...

    At the moment I'm finishing treating the text as simple html, that is, with bold, italic, underline, and font color and font size, I've added 2 properties:
    HtmlDefColor (The color you want to set by default to the Text)
    HtmlText (true or false)

    And I am finishing the code for manage this codes... It works for my needs, because Krool's RTB doesn't seem to support the \b \b0 style codes (At least I've tried and it doesn't recognize them)...

    And I understand that Krool doesn't tell me anything, what a job he's done, ufff!!! And what a good job he's done with all these ocx with Unicode, excellent work to give it away for free too...
    Last edited by James Reynolds; Nov 1st, 2024 at 09:59 AM.

  3. #3883
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,513

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by James Reynolds View Post
    Ok and Thanks jpbro, but I tested with ChatGPT and there has been no way to make it work
    There is a way to make it work. Take your original ChatGPT code, put Option Explicit at the top and try running it. It won't work because there are missing bits (SendMessage and other API declarations, RECT definition, EM_FORMATRANGE constant, etc...). Add all the missing bits as necessary, until it runs. Once it will run, change the GetRichTextHeight = result line to:

    Code:
    GetRichTextHeight = IIf(fr.rc.Bottom = &H7FFFFFFF, 0, fr.rc.Bottom)
    And GetRichTextHeight will now return the height of the RTF content (including images and whatever else might be there).

  4. #3884
    Addicted Member
    Join Date
    Jan 2008
    Posts
    153

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by jpbro View Post
    There is a way to make it work. Take your original ChatGPT code, put Option Explicit at the top and try running it. It won't work because there are missing bits (SendMessage and other API declarations, RECT definition, EM_FORMATRANGE constant, etc...). Add all the missing bits as necessary, until it runs. Once it will run, change the GetRichTextHeight = result line to:

    Code:
    GetRichTextHeight = IIf(fr.rc.Bottom = &H7FFFFFFF, 0, fr.rc.Bottom)
    And GetRichTextHeight will now return the height of the RTF content (including images and whatever else might be there).
    So simple!!!

    And that's it, ChatGPT may have excellent AI for those who use it, but the one they give to normal people is very bad!!!

    It is very useful for consulting things, and very simple codes, but as soon as something gets complicated, just a little, little by little, ChatGPT gets complicated, and more than helping, it wastes time, as soon as I see that it is going to mess things up, I say goodbye, and I go look for myself here...

    And what danger does it have for the future...

    Thanks jpbro, you have helped me a lot, and couldn't ChatGPT know that simple code? Incredible...

  5. #3885
    Addicted Member
    Join Date
    Jan 2008
    Posts
    153

    Re: CommonControls (Replacement of the MS common controls)

    [QUOTE=jpbro;5661220]There is a way to make it work. Take your original ChatGPT code, put Option Explicit at the top and try running it. It won't work because there are missing bits (SendMessage and other API declarations, RECT definition, EM_FORMATRANGE constant, etc...). Add all the missing bits as necessary, until it runs. Once it will run, change the GetRichTextHeight = result line to:

    Code:
    Private Function GetRichTextHeight(rtbHwnd As Long, rtbFont As StdFont, Text As String, rtbWidth As Long) As Long
        Dim fr As FORMATRANGE
        Dim rcDrawTo As RECT
        Dim rcPage As RECT
        Dim iPT1 As POINTAPI
        Dim lTotalHeight As Long
        Dim hdc As Long
    
        ' Get a device context for the entire screen
        hdc = GetDC(0)
    
        ' Initialize the FORMATRANGE structure
        With fr
            ' Use the same device context for measuring and rendering
            .hdc = hdc
            .hdcTarget = hdc
    
            ' Set up the print area dimensions (rcPage) and the drawing area dimensions (rcDrawTo)
            rcPage.Left = 0
            rcPage.Top = 0
            rcPage.Right = rtbWidth
            rcPage.Bottom = 20000
    
            rcDrawTo.Left = 0
            rcDrawTo.Top = 0
            rcDrawTo.Right = rtbWidth
            rcDrawTo.Bottom = &H7FFFFFFF
    
            .rc = rcDrawTo
            .rcPage = rcPage
    
            ' Set the range of characters to format
            .chrg.cpMin = 0
            .chrg.cpMax = Len(Text)
    
            ' Send EM_FORMATRANGE message to measure the content
            SendMessage rtbHwnd, EM_FORMATRANGE, True, ByVal VarPtr(fr)
    
            ' Release the device context
            ReleaseDC 0, hdc
        End With
    
        ' Return the height of the RTF content
        GetRichTextHeight = IIf(fr.rc.Bottom = &H7FFFFFFF, 0, fr.rc.Bottom)
    End Function
    But not work well...
    Last edited by James Reynolds; Nov 1st, 2024 at 11:30 AM.

  6. #3886
    Addicted Member
    Join Date
    Jan 2008
    Posts
    153

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by jpbro View Post
    There is a way to make it work. Take your original ChatGPT code, put Option Explicit at the top and try running it. It won't work because there are missing bits (SendMessage and other API declarations, RECT definition, EM_FORMATRANGE constant, etc...). Add all the missing bits as necessary, until it runs. Once it will run, change the GetRichTextHeight = result line to:

    Code:
    GetRichTextHeight = IIf(fr.rc.Bottom = &H7FFFFFFF, 0, fr.rc.Bottom)
    And GetRichTextHeight will now return the height of the RTF content (including images and whatever else might be there).
    Well, this appear to be work well:

    Code:
    Private Function GetRichTextHeight(rtbHwnd As Long, rtbFont As StdFont, Text As String, rtbWidth As Long) As Long
        ' Declare required variables
        Dim fr As FORMATRANGE
        Dim rcDrawTo As RECT, rcPage As RECT
        Dim hdcPrinter As Long
        Dim result As Long
    
        ' Get the device context for the display
        hdcPrinter = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    
        ' Set up the FORMATRANGE structure
        fr.hdc = hdcPrinter
        fr.hdcTarget = hdcPrinter
    
        ' Define the printable area (relative to page size)
        With rcPage
            .Left = 0
            .Top = 0
            .Right = rtbWidth ' Use the provided width of the RichTextBox/UserControl
            .Bottom = &H7FFFFFFF ' Set the bottom to maximum to measure the height
        End With
    
        ' Define the drawing area on the page (same as the printable area)
        rcDrawTo = rcPage
    
        ' Set up FORMATRANGE with page and drawing area
        fr.rcPage = rcPage
        fr.rc = rcDrawTo
        fr.chrg.cpMin = 0 ' Start of the text
        fr.chrg.cpMax = -1 ' End of the text
    
        ' Send EM_FORMATRANGE message to measure the text without rendering
        result = SendMessage(rtbHwnd, EM_FORMATRANGE, False, fr)
    
        ' Return the height of the formatted text
        GetRichTextHeight = IIf(fr.rc.Bottom = &H7FFFFFFF, 0, fr.rc.Bottom)
    
        ' Release resources
        DeleteDC hdcPrinter
        SendMessage rtbHwnd, EM_FORMATRANGE, False, ByVal CLng(0)
    End Function

  7. #3887
    Addicted Member
    Join Date
    Jan 2008
    Posts
    153

    Re: CommonControls (Replacement of the MS common controls)

    And I don't know if there is any way to know how many visible lines there are in Krool's RTB - it is possible perhaps that by mixing some methods this data can be obtained, but I prefer to have it in a direct property, more than anything to easily go to the end of the text or to the beginning -, I have done this and it works for me, and in case it is useful to someone, I think it is also an important piece of data to know, how many lines are visible:

    Code:
    Public Property Get GetLinesVisibles() As Long
        GetLinesVisibles = GetLinesVisiblesFunc(richTextBoxHandle)
    End Property
    
    Private Function GetLinesVisiblesFunc(rtbHwnd As Long) As Long
        Dim firstVisibleLine As Long
        Dim totalLines As Long
        Dim clientHeight As Long
        Dim lineIndex As Long
        Dim charIndex As Long
        Dim linePos As POINTAPI
        Dim nextLinePos As POINTAPI
        Dim visibleLines As Long
        Dim cumulativeHeight As Long
        Dim prevLinePosY As Long
        Dim rc As RECT
        
        ' Get the index of the first visible line
        firstVisibleLine = SendMessage(rtbHwnd, EM_GETFIRSTVISIBLELINE, 0, ByVal 0&)
        
        ' Get the total number of lines
        totalLines = SendMessage(rtbHwnd, EM_GETLINECOUNT, 0, ByVal 0&)
        
        ' Get the height of the RichTextBox client area
        GetClientRect rtbHwnd, rc
        clientHeight = rc.Bottom - rc.Top
        
        ' Initialize variables
        lineIndex = firstVisibleLine
        cumulativeHeight = 0
        visibleLines = 0
        
        ' Iterate over the lines starting from the first visible one
        Do While lineIndex < totalLines
            ' Get the character index of the current line
            charIndex = SendMessage(rtbHwnd, EM_LINEINDEX, lineIndex, ByVal 0&)
            
            ' Get the character's position in client coordinates
            If SendMessage(rtbHwnd, EM_POSFROMCHAR, VarPtr(linePos), ByVal charIndex) = -1 Then
                Exit Do
            End If
            
            ' Get the position of the next line
            If lineIndex + 1 < totalLines Then
                Dim nextCharIndex As Long
                nextCharIndex = SendMessage(rtbHwnd, EM_LINEINDEX, lineIndex + 1, ByVal 0&)
                If SendMessage(rtbHwnd, EM_POSFROMCHAR, VarPtr(nextLinePos), ByVal nextCharIndex) = -1 Then
                    Exit Do
                End If
            Else
                ' If it's the last line, estimate the line height
                nextLinePos.Y = linePos.Y + (linePos.Y - prevLinePosY)
            End If
            
            ' Calculate the height of the line
            Dim lineHeight As Long
            lineHeight = nextLinePos.Y - linePos.Y
            
            ' Handle possible zero or negative line heights
            If lineHeight <= 0 Then
                ' Use an average line height if necessary
                lineHeight = clientHeight / (visibleLines + 1)
            End If
            
            ' Add the line height to the cumulative total
            cumulativeHeight = cumulativeHeight + lineHeight
            
            ' Check if the cumulative total exceeds the client area height
            If cumulativeHeight > clientHeight Then
                Exit Do
            End If
            
            ' Increment the visible lines counter
            visibleLines = visibleLines + 1
            
            ' Save the previous Y position
            prevLinePosY = linePos.Y
            
            ' Prepare for the next iteration
            lineIndex = lineIndex + 1
        Loop
        
        ' Display the number of visible lines
        GetLinesVisiblesFunc = visibleLines
    End Function
    Now if I want to go to the last line starting with text that is visible, I do this:
    Code:
    RichTextBox1.ScrollToLine RichTextBox1.GetLineCount - RichTextBox1.GetLinesVisibles + 1
    Although I still need to check if the first visible line is a VbCrLf or VbCr or VbLf, because it would be better if that line was skipped...

    Maybe it can be done with what the Krool RTB already has, but I would like to know the content of each line, it must be easy...

    One GetTextLine method passing the parameter of the line you want to know, it would be interesting...

    Greetings...
    Last edited by James Reynolds; Nov 2nd, 2024 at 08:37 AM.

  8. #3888
    Addicted Member
    Join Date
    Jan 2008
    Posts
    153

    Re: CommonControls (Replacement of the MS common controls)

    Well, here is the Krool RichTextBox user control with my additions, it accepts basic html text (<font name, font color, font size, bold, italic, underline)

    It is semi-transparent capturing from the container's hdc, I can know the total height of the content of the Krool RichTextBox Unicode Utf8, I can know the text of each line, and maybe I'm forgetting something else, but for my needs it is almost complete, when I consider it checked and complete, I will upload it to the CodeBank:


    Greetings...

Page 98 of 98 FirstFirst ... 488895969798

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width