The developers of Notepad probably did something similar. Would have been nice if Controls came out of the box with these things set. Oh well. World isn't perfect.
Printable View
I cannot replicate this bug. Can you provide a demo ?
Your true. I don't know why I added those hardcoded 0&. And also calling twice on StreamFileIn.
Can you make a test and just remove all those red lines in the code and test if everything is OK ? If you report success I will initiate an update. Thanks
Code:Private Function StreamStringIn(ByVal Value As String, ByVal Flags As Long) As Long
If RichTextBoxHandle <> 0 Then
[...]
If (Flags And SF_RTF) <> 0 Then SendMessage RichTextBoxHandle, EM_EXLIMITTEXT, 0, ByVal 0&
StreamStringIn = SendMessage(RichTextBoxHandle, EM_STREAMIN, Flags, ByVal VarPtr(REEDSTR))
If (Flags And SF_RTF) <> 0 Then SendMessage RichTextBoxHandle, EM_EXLIMITTEXT, 0, ByVal PropMaxLength
Call RtfStreamStringInCleanUp
End If
End Function
Private Function StreamFileIn(ByVal FileName As String, ByVal Flags As Long) As Long
If RichTextBoxHandle <> 0 Then
[...]
If (Flags And SF_RTF) <> 0 Then SendMessage RichTextBoxHandle, EM_EXLIMITTEXT, 0, ByVal 0&
StreamFileIn = SendMessage(RichTextBoxHandle, EM_STREAMIN, Flags, ByVal VarPtr(REEDSTR))
If (Flags And SF_RTF) <> 0 Then SendMessage RichTextBoxHandle, EM_EXLIMITTEXT, 0, ByVal 0&
CloseHandle hFile
End If
End If
End Function
Update released.
Removal of EM_EXLIMITTEXT (Flags = SF_RTF) in internal StreamStringIn/StreamFileIn in the RichTextBox control.
It was probably put there by error or by misunderstanding of the MSDN documentation.
I could not find any reason why it should be in that function... strange.. However, now it's erased..
I tested the new update (.25) of the RichTextBox control with text files in several sizes using this code:
14,6 MB -> OKCode:10 rtfTest.LoadFile sFilePath, RtfLoadSaveFormatText
20 rtfTest.SelStart = 0
30 rtfTest.SelLength = Len(rtfTest.Text)
40 rtfTest.SelColor = vbBlack
50 rtfTest.SelLength = 0
17,2 MB -> OK
20,0 MB -> OK
32,0 MB -> OK
68,0 MB -> loading ok, but "no memory" error at line 30
after removing line 20 to 50 everything is working well:
109 MB -> OK
172 MB -> OK
Loading the files is very fast.
Should i use the command .clear before loading a file to reset the current style of the RTB?
Retrieving the Text makes again an stream out. And when you do it in the IDE the memory limit is quickly hit.
Better is just to extract the length, e.g.
Code:Dim Length As Long, REGTLEX As REGETTEXTLENGTHEX
REGTLEX.Flags = GTL_PRECISE Or GTL_NUMCHARS
REGTLEX.CodePage = CP_UNICODE
Length = SendMessage(RichTextBoxHandle, EM_GETTEXTLENGTHEX, VarPtr(REGTLEX), ByVal 0&)
SOME TIMES ,I ONLY NEED TextboxW CONTROL,IT'S maked 210kb
TextboxW.OCX
only use listview control,it's used 1MB
VBCCR16.OCX 5mb size
The overall volume of an OCX is a bit larger. It is very difficult to disassemble the various controls to reduce the size of the compiled EXE.
Thanks a TON for the update. And, once again, thanks a TON for your beautiful and immensely beneficial controls.
One observation, my dear krool, regarding CoolBars.
Inside any Band of a CoolBar control:
--
Case 1. If I have a FrameW in the Band and if I place a normal Label or LabelW(yours) inside that FrameW, the labels do not display their ToolTipText.
Case 2. If I have a Frame or Picture in the band and if I place a normal Label or LabelW(yours) inside that Picture/Frame, the labels do display their ToolTipText. No issues.
--
If my observation in Case 1 is correct, then, what should I do to have the ToolTipText get displayed by Label and LabelW in Case 1.
If my observation in Case 1 is incorrect, then, what mistake am I doing? Kindly guide me.
Kind regards.
Krool had written to me on the above as early as 2017 itself. Since that time, I have been waiting to see whether anyone can come with a solution for the quirk mentioned in the 2nd point.
Anyway, based on Krool's valuable advice (as in his 1st point), I always remember to set my RichTextBox controls' MaxLength to 2147483647 (the maximum limit) so that I do not ever need to worry about the text length limits of my RichTextBoxes. I also set the ScrollBar to Vertical (in order to address one issue, which I am not able to recall, as of now).
And, reg. the 2nd point, after writing very many lines of code of my own, to somehow take care of the issues related to vbCrLf (but eventually unable to take care of the issues 100% correctly), I finally decided to drop all those lines of code and just do the following alone so that I need not have to worry about those vbCrLF-related issues at all ever after. What I did was:
In the function "Private Function StreamStringOut(ByRef Value As String, ByVal Flags As Long) As Long", I made the following changes
--
'''''Value = StrConv(RtfStreamStringOut(), vbUnicode)
Value = Replace$(StrConv(RtfStreamStringOut(), vbUnicode), vbCrLf, vbCr)
'''''Value = RtfStreamStringOut()
Value = Replace$(RtfStreamStringOut(), vbCrLf, vbCr)
--
In other words, in the abovementioned function, I commented out two lines (as shown above) and replaced them with my own lines (as above). In effect, I just replaced all vbCrLf with vbCr. For my freeware's requirements, dealing with VbCr alone was not any big problem. So, with the above changes, for the past 4 years, the vbCrLf-related issues are not present.
Just thought of sharing the above info so that it is of help to someone. Nothing else.
Thanks Krool once again, for your monumental efforts and such a stupendous service to the world society.
Kind Regards.
Thanks a TON for your prompt reply, Krool. At present, as a workaround, I am placing the Labels again inside another Picture or Frame control (normal one).
Kind Regards.
In connection with the experience I have shared above, I was just wondering whether a new property can be added to the RichTextBox control (say, "Only vbCr") so that based on its value, you can include my lines of code too in the StreamStringOut function. Thanks, Krool.
Kind Regards.
Hi Krool,
Sorry for the late reply.
1) Tes, I can confirm that the Aug 10th update fixes the amount of text allowed issues (including where changing scrollbars would reset).
2) Regarding the internal only CR's, it's just a giant pain - it irritates me to no end that MS made that change starting with RichEdit 2.0 without considering the ramifications of doing so. Anyway I've worked around it (in a different way to softv but similar idea - I just did the reverse where I kept the control as-is but created a string copy of the text with only CR's to use for figuring things out. Horribly inefficient but the easiest way for me to deal with with my particular situation. I do think having an option like softv mentions could be helpful.
3) I have a new 3rd issue for you. The margin settings are set incorrectly in the CreatePrintJob sub.
The code you have as:
should instead beCode:
.Left = PhysOffsetCX + LeftMargin
.Right = PhysOffsetCX + PhysCX - RightMargin
.Top = PhysOffsetCY + TopMargin
.Bottom = PhysOffsetCY + PhysCY - BottomMargin
The bottom one SHOULD be the commented out lines in theory I believe where .top is subtracted also, but in practice there must be some other issue going on with the PhysCY or PhysOffsetCY that doesn't also happen with PhysCX or PhysOffsetCX because subtracting the top offset (margin) doesn't work like it does for the right offset and is only correct when NOT subtracting the top offset.Code:If (LeftMargin - PhysOffsetCX) > 0 Then
.Left = LeftMargin - PhysOffsetCX
Else
.Left = PhysOffsetCX
End If
If (RightMargin - PhysOffsetCX) > 0 Then
.Right = (PhysCX - .Left) - (RightMargin - PhysOffsetCX)
Else
.Right = (PhysCX - .Left) - PhysOffsetCX
End If
If (TopMargin - PhysOffsetCY) > 0 Then
.Top = TopMargin - PhysOffsetCY
Else
.Top = PhysOffsetCY
End If
If (BottomMargin - PhysOffsetCY) > 0 Then
'.Bottom = (PhysCY - .Top) - (BottomMargin - PhysOffsetCY)
.Bottom = PhysCY - (BottomMargin - PhysOffsetCY)
Else
'.Bottom = (PhysCY - .Top) - PhysOffsetCY
.Bottom = PhysCY - PhysOffsetCY
End If
In any event, the original margin calculations were incorrect and resulted in noticeably wrong printed margins.
Thanks again for all your hard work with these! :)
VBCCR 1.7.25
I use the ListView control (report mode) with 6 columns and need to detect double clicks on ListSubItems.
I can do this with the function "HitTest" but all the DblClick-events dont provide the necessary X/Y coordinates for the HitTest-function.
Can you add the missing X/Y coordinates to all DblClick-events?
I can't due to compatibility. But it's easy doable as below code.
Code:Private Declare Function GetMessagePos Lib "user32" () As Long
Dim Pos As Long
Pos = GetMessagePos()
Debug.Print Get_X_lParam(Pos) & "/" & Get_Y_lParam(Pos)
Public Function Get_X_lParam(ByVal lParam As Long) As Long
Get_X_lParam = lParam And &H7FFF&
If lParam And &H8000& Then Get_X_lParam = Get_X_lParam Or &HFFFF8000
End Function
Public Function Get_Y_lParam(ByVal lParam As Long) As Long
Get_Y_lParam = (lParam And &H7FFF0000) \ &H10000
If lParam And &H80000000 Then Get_Y_lParam = Get_Y_lParam Or &HFFFF8000
End Function
Yes, its in pixel, same as GetCursorPos.
But the X/Y-coordinates are wrong after multiplying the return values from your function with Screen.TwipsPerPixelX/Y.
I only get the correct X/Y-coordinates using GetCursorPos & ScreenToClient & multiplying with Screen.TwipsPerPixelX/Y.
Thanks for this report.
I checked this topic and come to following formula which works on my end. Can you confirm ?
Code:.Left = LeftMargin - PhysOffsetCX
.Top = TopMargin - PhysOffsetCY
.Right = (PhysCX - RightMargin) + PhysOffsetCX
.Bottom = (PhysCY - BottomMargin) + PhysOffsetCY
Update released.
Bugfix for RichTextBox done concerning wrong calculated margins in the internal CreatePrintJob method.
Hi Krool,
Thanks! I am sorry for late response and I see you issued an update. Okay, first things first. In testing again today, I see that I made a stupid mistake when I was previously testing. I was actually feeding the sub swapped right and top values. So my assertion before that it was "wildly off" wasn't quite right - it was "wildly off" because I was stupid. lol
However, the old code still was not correct. My replacement code above also was not correct - the .Right calculations in my code was wrong.
Your new code is better, but I think there is still a mistake in the .Right and .Bottom. I believe you should be subtracting the PhysOffsetCX and PhysOffsetCY instead of adding them.
In other words it should now be:
This is basically the way my old code that I've used for years was doing it.Code:.Left = LeftMargin - PhysOffsetCX
.Top = TopMargin - PhysOffsetCY
.Right = (PhysCX - RightMargin) - PhysOffsetCX
.Bottom = (PhysCY - BottomMargin) - PhysOffsetCY
Note however that this code does not take into account either if the margins are less than the offsets or if the margins are not specified. I've seen printers that have .5 inch offsets (or a little less but you get the idea). This code would fail on that if they specified a margin say of .30 inches because it would give a negative number. That is why I did the If/Then's. It's not pretty, but it solves this problem. I also think you should not be setting the default values to 0. If margins aren't specified (they are optional in PrintDoc) then it's almost guaranteed not to be right. Taking everything together, I believe something like the following is probably best:
This only sets based on the margins if the margins that were set are greater than the offsets, otherwise or if no margins were set at all, will set a default.Code:With .RC
If (LeftMargin - PhysOffsetCX) > 0 Then
.Left = LeftMargin - PhysOffsetCX
Else
.Left = PhysOffsetCX
End If
If (TopMargin - PhysOffsetCY) > 0 Then
.Top = TopMargin - PhysOffsetCY
Else
.Top = PhysOffsetCY
End If
If (RightMargin - PhysOffsetCX) > 0 Then
.Right = (PhysCX - RightMargin) - PhysOffsetCX
Else
.Right = PhysCX - PhysOffsetCX
End If
If (BottomMargin - PhysOffsetCY) > 0 Then
.Bottom = (PhysCY - BottomMargin) - PhysOffsetCY
Else
.Bottom = PhysCY - PhysOffsetCY
End If
End With
Thanks again for all your work with all of these!! :) I appreciate you! This stuff gets complicated and I think there was some wrong MS documentation/examples on this margin stuff too.
[Edit: Updated to fix a silly mistake in my code where I originally was setting default values for RCPage and not RC]
According to MS (https://docs.microsoft.com/en-us/win...-edit-controls) the cxPhysOffset/cyPhysOffset is added for right/bottom. (thus correct with my new code)
(keeping aside the extra margins which are ignored by MS, but for the principle)
Code:// Set the rendering rectangle to the pintable area of the page.
fr.rc.left = cxPhysOffset;
fr.rc.right = cxPhysOffset + cxPhys;
fr.rc.top = cyPhysOffset;
fr.rc.bottom = cyPhysOffset + cyPhys;
Hi Krool,
I found a problem with the FrameW control. The Caption font is not rendered properly if the application runs with GDIScaling.
This is most notable if one uses a TrueType font as the ClearType/AntiAliasing is not working.
I was able to narrow the problem down to the way the FrameW uses its Picture property in the DrawFrame function:
.Cls
Set .Picture = Nothing
...
Set .Picture = .Image
Interestingly the font is smooth if the DrawText API is used instead of the DrawThemeText version.
I have a small test project in case you have a Windows 10 maschine...
Also I think there are some control which leak FontHandles. The following handles are not deleted on UserControl_Terminate:
DTPickerCalendarFontHandle
LinkLabelUnderlineFontHandle
ProgressBarFontHandle
Is it possible to maybe cache fonts? As far as I understand each call to CreateGDIFontFromOLEFont creates a new font handle...
Its not terrible but its the last place where you "waste" GID Handles.
I think most people are using more controls than they use different fonts.
But again most probably not worth any effort :)
Thank you very much and keep up the good work
I understand and certainly MS is certainly the ones to generally follow for guidance, but I've seen that code before and I'm almost certain it is wrong. Adding the physical width offset to the physical width for a right margin means they are saying the printing extends into the offset area that the printer can't print. That code from MS basically says that the place to stop printing on the right is equal to the entire width PLUS the offset that the printer can't print. That's wrong - it should be subtracted from it in saying that the place to stop printing on the right is physical width (which includes the offset area) MINUS the offset so that the total area to print is only the part the printer can actually print in. Further, their code there is horrible anyway because it doesn't even take into account any margin area at all. Whoever coded that whipped that up but certainly weren't using it to actually print anything - it looks to me like a theoretical piece of code someone threw together but they certainly never used it to actually print anything. I just double-checked and the code I used for 20+ years has the offset subtracted and not added and in those 20 years I never heard anyone tell me of any printing issues. So I'm pretty sure it is supposed to be subtracted. These days, because many printers have pretty small offsets, it's probably not a huge deal either way, but I think the correct mode is to subtract. Microsoft failed. I wish they hadn't removed all their comments they used to have on their pages some years back because many times people would comment the flaws with their api or example code and those could be helpful in situations like this.
explanation would be maybe that the viewport of the printer is not 0, 0. I saw some code where it actually get substracted.
Maybe that's why in the ms doc it's added at right/bottom ?Code:// offset by printing offset
printDC.SetViewportOrg (-printDC.GetDeviceCaps (PHYSICALOFFSETX),
-printDC.GetDeviceCaps (PHYSICALOFFSETY));
Hmm, maybe, tho I wonder why anyone would want to do that.
Hi Krool,
do you have any news on the GDIScaling problem of the FrameW?
I do understand you call Set .Picture = .Image because of the transparency of the frame.
But is it not enough to call a simple Refresh to update the persistent graphics as AutoRedraw = true?
Problem is that the GDI Scaler rescales the persistent graphics. I attached screenshots taken at 144 DPI.
Setting the picture:
Attachment 182284
Calling refresh:
Attachment 182285
Any help would be greatly appreciated
Hi Krool,
Ive been using the RichTextBox from ActiveX control Version 1.7. (win 10 64 bit)
In the MS version of rtb i could set
and then compare equal would be trueCode:rtb.selstart = Len(rtb.text)
however, with this rtb its behavior is different fromCode:If rtb.SelStart = Len(rtb.Text) Then '<-- = True
the MS version.
Ive done some investigating and it appears the Len(rtb.Text) includes CR-LF per line in length
but rtb.SelStart doesnt not include calculations for CR-LF line endings.
Below is a screenshot showing results of test. Would it be possible to get the same behavior as MS control?
Regards,
Lewis
(not sure why its so small)
here is link to image: https://imgur.com/a/eFrOmRB
Attachment 182554
I hate this quirk and it was discussed several times already.
So, to sum up. We have SelStart and SelLength and SelText (using the EM_GETSELTEXT, rich edit message only) all ignoring CR-LF and just uses CR.
The only "annyoing" part is the Text property which will use EM_STREAMOUT. And this EM_STREAMOUT put out CR-LF.
So, I could "fix" the Text property by using EM_GETTEXTEX which only returns CR (unless GT_USECRLF is used).
However, additional quirk is that EM_STREAMOUT does not output "hidden" text. This could be fixed additionally by using GT_NOHIDDENTEXT flag. (but this exists only as of rich edit version 4, thus leaving 2 and 3 in the dark...)
So, all in all it's a shame...
Or I replace all CR-LF to CR only within EM_STREAMOUT.. However, this would be an additional memory allocation exchange for the text.
Edit: the MS rtb uses the v1 which uses CR+LF internally.
Hi Krool,
Thanks for your reply. Sorry I wasnt aware others had brought it up already, I thought I was reporting a good bug LOL. Its fine if the behavior is an unintended consequence of upgrading to new api.
I Fixed my problem by using API to get Text length to compare to SelStart and it works very well.
Maybe a non-standard function like .GetTextLength(optional param,optional param) would be a solution?
regards,
lewis
Ok, so EM_STREAMOUT will not respect hidden text on richedit20.dll.
Upon Msftedit.dll it will exclude hidden text, that's why introduced GT_NOHIDDENTEXT.
However, it is not possible to calculate via EM_GETTEXTLENGTHEX w/o hidden text as no flag exists...
So, my conclusion will then be to not bother with GT_NOHIDDENTEXT, so that a potential new Text property will be equal with a new TextLength property..
Krool Thanks for your insight, sorry to bother you again but this just may be something Im doing wrong....
In the event LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal LinkStart As Long, ByVal LinkEnd As Long)
I cant seem to get the hyperlink from text using LinkStart and LinkEnd.
Private Sub rtb_LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal LinkStart As Long, ByVal LinkEnd As Long)
Dim Link As String
If wMsg = 514 And wParam = 0 Then
Link = Mid$(rtb.Text, LinkStart, (LinkEnd + 1) - LinkStart)
End If
End Sub
The return value 'Link' is something from a random place in the text and not even close to a hyperlink.
Is this something Im doing wrong or is it maybe related to the hidden text problem?
Regards,
Lewis
Update released.
Finally fixed the mismatch of the RichTextBox Text property concerning CrLf and the internal Cr only.
The RichTextBox control now uses EM_GETTEXTEX/EM_SETTEXTEX instead of EM_STREAMOUT/EM_STREAMIN for the Text property.
Included the UseCrLf property to control whether or not to apply GT_USECRLF/GTL_USECRLF on EM_GETTEXTEX.
It defaults to False and thus makes a compatibility break to the previous VBCCR which used EM_STREAMOUT (always CrLf)
Also included the TextLength property in the TextBoxW and RichTextBox control to conveniently get the length of text w/o the need of allocating memory for the Text. (like in .net)
The OCX VBCCR17 was also updated. The internal type lib version is now 1.1.
Code:Object={7020C36F-09FC-41FE-B822-CDE6FBB321EB}#1.1#0; VBCCR17.OCX
Hi,
Here is a sample project that reproduces the error for me. the screenshot shows the result above after clicking the highlighted link.
Attachment 182601
Here is the solution for your problem:
Attachment 182606
Code:Option Explicit
Private Const WM_USER = &H400
Private Const EM_GETTEXTRANGE = (WM_USER + 75)
Private Declare Function SendMessageW Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type CHARRANGE
cpMin As Long
cpMax As Long
End Type
Private Type TEXTRANGE
chrg As CHARRANGE
lpstrText As String
End Type
Private Type SETTEXTEX
flags As Long
codepage As Integer
End Type
Private Sub Form_Load()
rtb.LoadFile App.Path & "\test.rtf", RtfLoadSaveFormatRTF, False
rtb.SelStart = 3500
rtb.ScrollToCaret
' Me.Show
' DoEvents
' MsgBox "click on nightbot links", vbInformation
End Sub
Private Sub rtb_LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal LinkStart As Long, ByVal LinkEnd As Long)
If wMsg = 514 And wParam = 0 Then
lblLink.Caption = GetLinkText(LinkStart, LinkEnd)
End If
End Sub
Private Function GetLinkText(ByVal LinkStart As Long, ByVal LinkEnd As Long) As String
Dim tdCharRange As CHARRANGE
Dim tdTextRange As TEXTRANGE
tdCharRange.cpMin = LinkStart
tdCharRange.cpMax = LinkEnd
tdTextRange.chrg = tdCharRange
tdTextRange.lpstrText = Space$(256)
Call SendMessageW(rtb.hWnd, EM_GETTEXTRANGE, 0&, ByVal tdTextRange)
GetLinkText = tdTextRange.lpstrText
End Function