-
Oct 31st, 2024, 12:19 PM
#3881
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)
-
Nov 1st, 2024, 08:18 AM
#3882
Addicted Member
Re: CommonControls (Replacement of the MS common controls)
Originally Posted by jpbro
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.
-
Nov 1st, 2024, 09:35 AM
#3883
Re: CommonControls (Replacement of the MS common controls)
Originally Posted by James Reynolds
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).
-
Nov 1st, 2024, 10:04 AM
#3884
Addicted Member
Re: CommonControls (Replacement of the MS common controls)
Originally Posted by jpbro
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...
-
Nov 1st, 2024, 11:21 AM
#3885
Addicted Member
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.
-
Nov 1st, 2024, 12:00 PM
#3886
Addicted Member
Re: CommonControls (Replacement of the MS common controls)
Originally Posted by jpbro
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
-
Nov 2nd, 2024, 08:28 AM
#3887
Addicted Member
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.
-
Nov 2nd, 2024, 09:34 AM
#3888
Addicted Member
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...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|