Just replace the OLEGuids.tlb with the latest version to your syswow64 folder.Quote:
Originally Posted by chosk
Printable View
Just replace the OLEGuids.tlb with the latest version to your syswow64 folder.Quote:
Originally Posted by chosk
Super. This fix it.Quote:
Originally Posted by Krool
Thank you.
Hi Krool,
I'm using the ListView in Report-mode with a relatively high icon, which would allow at least 3 lines for the label. However, even when I set LabelWrap to True, the label is displayed on one line, centered in the middle of the icon, and is cut off when it's too long for the available space.
Am I missing something, or is what I'm looking for simply not possible?
Thanks,
Erwin
No, the ListView is "SingleLine" in report-mode.Quote:
Originally Posted by Erwin69
The only way is the tile view mode where the sub-items are each separate lines. But it's similar to icon view.. so no report-mode style.
Any solution/suggestions, for the above two issues, Krool?Quote:
Originally Posted by softv
Just a gentle reminder only, Krool. Otherwise, I do understand your time constraints.
Kind Regards.
softv, thranks for bringing this up again.
Should be fixed now.
Hello!
As a late reply to my post #3393 (right margin in richtext) I want to share my solution for that issue with the forum.
As mentioned earlier, the right margin in the microsoft control behaves different from the right margin in the replacement control.
Here is my solution
Maybe the lines can be placed in then source of the control; I put them in my advanced usercontrol in my RightMargin Property.Code:nHdc = CreateDC("Display", "", 0, 0)
SendMessage hwnd, EM_SETTARGETDEVICE, nHdc, ByVal mnRightMargin - LeftMargin
DeleteDC nHdc
Krool, if this was your intention when you mentioned the printer margin output - I got you wrong, sorry.
Anyway, I now can take full advantage of the improved control in my app.
Thanks and bye for now
Hi Krool and thanks for your project!
I have developed for year an editing program for decoder channel list and used listview to show all data like channel, transponder, etc, i've implemented a OLE drag and drop for all listview to order manually the items and it works without no problem, setting OLEDragMode as vbOLEDragAutomatic and OLEDropMode as vbOLEDropManual. Event OLEDragDrop are raised and in OLEDragOver I can select the item over the mouse cursor. A strange problem appear when I substituted the ListView with your, version 1.7.37, using ocx control for IDE on Win 10 64. When i drag an item over the same control the cursor change do deny, Effect in OLEDragOver remain at 0 and the event OLEDragDrop are not raised, but this appens only when the property View is List or Report. I've tried to change the setting in controls demo in all mode possible but the problems remain, the correct behaviour happens only when drag an item from another control. In ListBox and TreeView instead all works properly. It's not possible with ListView to dragdrop an item in the same control when is in list or report mode? I hope that is a simple problem to solve and wait for your replay.
Thank you.
Thanks a LOT, as always, for the update, dear Krool.Quote:
Originally Posted by Krool
Kind Regards.
Thanks. Should be fixed now.Quote:
Originally Posted by cecelife
Ok, but EM_SETTARGETDEVICE should'nt be for margins at all. Why are you passing the margin at lParam ? It's suppossed to be a line width...Quote:
Originally Posted by Seniorchef
So that's what I understood from MS's documentation here https://docs.microsoft.com/en-us/win...ettargetdevice. The linewidth is the width between left and right margin. When the left margion is 0 that makes the right margin the linewidth.
The code in my snippet sets the linewidth and all text in the control is wrapped at that mark, like in the MS control in my sample.
Greetings
You seem right. The MS RichTextBox doesn't use EM_SETMARGINS, it only uses EM_SETTARGETDEVICE.Quote:
Originally Posted by Seniorchef
So, how shall we proceed?
My proposal would be to keep using EM_SETMARGINS and just call EM_SETTARGETDEVICE and each change of either left or right margin property.
The LineWidth is correctly the RightMargin minus LeftMargin (in Twips always)
Alsoseems to be the correct usage. So it also works on multiple monitors.Code:CreateDC(TEXT("DISPLAY"),NULL,NULL,NULL)
EDIT: If RightMargin minus LeftMargin results in 0 then the wParam (hDC) is also 0.
EDIT2: The MS RichTextBox doesn't have a LeftMargin. (only RightMargin) so a negative LineWidth never applies. Can you test if a negative LineWidth works ? E.g. RightMargin set to 0 and LeftMargin set to something menaingful.
Thanks
I'm busy this morning, but give a sample later this day...
My line with createDC() works on my PC with five monitors, but nevertheless yours works too. Depends prob. on the declaration (which I forgot to copy).
Greetings
Here some information:
It's true, the MS control has no left margin; this is one reason why I prefer your control.
A negative LineWidth is same like a LineWidth of 0 which cancels the WYSIWYG and makes the text wrap to the right window border.
So in my opinion leave the handling of the margins as they are. The handling of the LineWidth should be done by the calling app, even more because there is no right and left margin stored in a richtext. It should be up to the app to set and handle them.Code:'Create a new project
'Add a form
'Add the VBCCR17.OCX
'Paste this code to the form
Option Explicit
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Const WM_USER = &H400
Const EM_SETTARGETDEVICE = (WM_USER + 72)
Dim mnRightMargin&
Private Sub Form_Load()
appLeftMargin = 500 'twips
appRightMargin = 5000 'twips
'Paste text from the clipboard to the control to make the margins usefull...
'Resize the form to see the behavior of the control and the margins
End Sub
Private Sub Form_Resize()
If ScaleHeight > 60 And ScaleWidth > 60 Then
rtf.Move 30, 30, ScaleWidth - 60, ScaleHeight - 60
End If
End Sub
Property Let appLeftMargin(ByVal nNewValue As Long)
On Error Resume Next
Dim nHdc&
'anything to do...
If rtf.LeftMargin <> nNewValue Then
'set VBCCR-control new LeftValue
rtf.LeftMargin = nNewValue
'check rightmargin...
If mnRightMargin > nNewValue Then
nHdc = CreateDC("Display", "", 0&, 0&)
'set the linewidth according the margins, make WYSIWYG
SendMessage rtf.hwnd, EM_SETTARGETDEVICE, nHdc, ByVal mnRightMargin - nNewValue
'clean up
DeleteDC nHdc
End If
End If
End Property
Property Let appRightMargin(ByVal nNewValue As Long)
Dim nHdc As Long
Dim nLeftMargin&
'anything to do...
If nNewValue <> mnRightMargin Then
nLeftMargin = rtf.LeftMargin
'illegal RightMargin set to 0
'take the WYSIWYG from Control...
Select Case nNewValue
Case Is <= nLeftMargin
'cache RightMargin
mnRightMargin = 0
'reset the controls rightmargin property ...
rtf.RightMargin = 0
'make the VBCCR-Control wrap to window
SendMessage rtf.hwnd, EM_SETTARGETDEVICE, 0&, 0&
'set RightMargin
Case Else
'cache RightMargin
mnRightMargin = nNewValue
'make control WYSIWYG
nHdc = CreateDC("Display", "", 0&, 0&)
'set the linewidth according the margins, make WYSIWYG
SendMessage rtf.hwnd, EM_SETTARGETDEVICE, nHdc, ByVal mnRightMargin - nLeftMargin
'clean up
DeleteDC nHdc
End Select
End If
End Property
Greetings
Thinking about it, there could be a more elegant solution:
A RightMargin greater than the LeftMargin sets the LineWidth to RightMargin minus LeftMargin.
A RightMargin of zero or negative (or smaller than LeftMargin) sets the RightMargin to that (positive) value and cancels the LineWidth.
This is more or less the essence of my sample above but it also breaks the compatibility of the RightMargin Property, because negative values are legit.
GreetingsCode:LeftMargin=0: RightMargin=-100 'RightMargin=100 twips from the right border of the control
LeftMargin=0: RightMargin=5000 'LineWidth=5000 twips
LefMargin=100: RightMargin=2400 'LineWidth=2300 twips
LeftMargin=500: RightMargin=75 'LineWidth=0, RightMargin=75 twips from right border
I also implemented the event RulerScroll to my code. The Event is used to move a ruler according to the position of the scrollbars of the control. I'm using the "VBAccelerator Subclassing adn Timer Assistent" for subclassing, so the snippets are
and in the queueCode:'start Subclassing
SSubTimer6.AttachMessage Me, rtf.hWndUserControl, WM_COMMAND
The name of the event "RulerScroll" is arbitrary. I use it to scroll a ruler above the text to show the caret's position and for tabs and borders.Code:Dim ScrollPos As POINTAPI
Dim X&, Y&
'Subclassing ...
If iMsg = WM_COMMAND Then
'
Select Case Int(wParam \ &H10000)
Case EN_UPDATE
SendMessage rtf.hwnd, EM_GETSCROLLPOS, 0, ScrollPos
X = (ScrollPos.X * Screen.TwipsPerPixelX)
Y = (ScrollPos.Y * Screen.TwipsPerPixelY)
RaiseEvent RulerScroll(X, Y)
...
Greetings
Hello Krool, I found an issue when an UserControl that is ControlContainer is holding a LabelW inside.
The OleDropMode can't be changed to manual, it raises an error.
Attached is a test project.
That's a VB6 bug. See below workaround I use for FrameW:Quote:
Originally Posted by Eduardo-
Code:Public Property Get OLEDropMode() As OLEDropModeConstants
Attribute OLEDropMode.VB_Description = "Returns/Sets whether this object can act as an OLE drop target."
OLEDropMode = UserControl.OLEDropMode
End Property
Public Property Let OLEDropMode(ByVal Value As OLEDropModeConstants)
' Setting OLEDropMode to OLEDropModeManual will fail when windowless controls are contained in the user control.
Const DRAGDROP_E_ALREADYREGISTERED As Long = &H80040101
Select Case Value
Case OLEDropModeNone, OLEDropModeManual
On Error Resume Next
UserControl.OLEDropMode = Value
If Err.Number = DRAGDROP_E_ALREADYREGISTERED Then
RevokeDragDrop UserControl.hWnd
UserControl.OLEDropMode = Value
End If
On Error GoTo 0
Case Else
Err.Raise 380
End Select
UserControl.PropertyChanged "OLEDropMode"
End Property
Thank you!
Hi Krool,
I noticed an area my having slowed down significantly after implementing the CCR statusbar. I investigated this by simply updating two panels 10.000 times to an empty string.
Using the original statusbar this took 32 milliseconds. Using the CCR statusbar it took 2505 seconds!Code:brStatusBar.Panels(2).Text = ""
brStatusBar.Panels(3).Text = ""
Is this simply the result / consequence of Unicode support, or am I doing something wrong?
Regards,
Erwin
Thanks.Quote:
Originally Posted by Erwin69
2505 seconds or milliseconds ?
Sorry, 2505 milliseconds. Otherwise there would have been another problem... :bigyello:Quote:
Originally Posted by Krool
@Erwin69,
Do you set 10000 times the exact same text ?
Because setting each time a different text the performance of the MS StatusBar is as bad as well. However, if old and new text is equal I can of course make an improvement, if necessary.
Because changing a text the refresh is "immediately". So in below example you can look how it increments. I did the "same" in VBCCR.
Code:Dim T As Single
T = Timer
Dim i As Long
For i = 1 To 10000
StatusBar1.Panels(1).Text = "test" & i
Next i
Debug.Print Timer - T
Hi Krool,
I notice the slowness with different values as well. I was indeed assigning the same value many times.
As background info: in this particular case, I'm updating the statusbar as part of the mouse move, so that the user knows which object the cursor is over. For that the code cycles through several collections, some of which can have over 1000 items, and evaluates the coordinates of the item vs the mouse position. If the item being evaluated is not under the cursor, I set the two panels to "", so assigning the same value many times.
I've now fixed it by first checking the value of one panel, and only updating it when it's not "".
Regards,
Erwin
Erwin69, you should only assign a value when it has changed, meaning when it is different from the value already in the panel.
Greetings
Seniorchef
Well, that's what I described in my previous post as the fix. Point is that with the standard status bar there was no delay when assigning the same value that the panel already had. Maybe MS optimized that by only refreshing the control if the value has changed. I thought it wise to share this info with Krool and the community.Quote:
Originally Posted by Seniorchef
Yes thanks. Noted.Quote:
Originally Posted by Erwin69
I think it's worth to get fixed soon as well.
I fixed the property now in the StatusBar control. (Exit Property if new value equals old value)Quote:
Originally Posted by Erwin69
ProgressBar/StatusBar problems
A MDI form has a StatusBar.
On the first panel it shall show a ProgressBar on demand.
After progress is finished, the ProgressBar shall hide.
a)
ProgressBar.Visible has no effect.
b)
The StatusBar font size can't be changed.
---
Not sure it is a VBCCR problem.
But perhaps in VBCCR there are other means to solve the 2 'problems'?
Code:VERSION 5.00
Object = "{7020C36F-09FC-41FE-B822-CDE6FBB321EB}#1.2#0"; "VBCCR17.OCX"
Begin VB.MDIForm MDIForm1
BackColor = &H8000000C&
Caption = "MDIForm1"
ClientHeight = 3975
ClientLeft = 120
ClientTop = 465
ClientWidth = 7740
LinkTopic = "MDIForm1"
StartUpPosition = 2 'CenterScreen
Begin VBCCR17.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 495
Left = 0
Top = 3480
Width = 7740
_ExtentX = 13653
_ExtentY = 873
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Segoe UI"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
AllowSizeGrip = 0 'False
InitPanels = "MDIForm1.frx":0000
End
Begin VB.PictureBox Picture1
Align = 1 'Align Top
BeginProperty Font
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Left = 0
ScaleHeight = 1035
ScaleWidth = 7680
TabIndex = 0
TabStop = 0 'False
Top = 0
Visible = 0 'False
Width = 7740
Begin VBCCR17.ProgressBar ProgressBar1
Height = 615
Left = 240
Top = 120
Visible = 0 'False
Width = 3780
_ExtentX = 6668
_ExtentY = 1085
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Segoe UI"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Step = 10
End
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1
Left = 840
Top = 1440
End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SetParent _
Lib "user32" (ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Sub MDIForm_Click()
ProgressBar1.Visible = True
Timer1.Enabled = True
With ProgressBar1
Call SetParent(.hWnd, StatusBar1.hWnd)
.Left = 1000 'not working
.Top = 0
.Width = StatusBar1.Width
.Height = StatusBar1.Height / 2
End With
End Sub
Private Sub Timer1_Timer()
With ProgressBar1
.Value = .Value + 1
If .Value >= 100 Then
Timer1.Enabled = False
.Value = 0
.Visible = False 'not working
'workaround
.Width = 0
.Height = 0
End If
End With
End Sub
I can't check now. But the SetParent is wrong, shall be:Quote:
Originally Posted by Karl77
Code:Call SetParent(.hWndUserControl, StatusBar1.hWnd)
Oh well, yes.Quote:
Originally Posted by Krool
Solves a).
Thank you!
Good. But why you can't change the Font of the StatusBar ?Quote:
Originally Posted by Karl77
For me it works..
I can change the font but not the font size.
Try to set Segoe UI / 10.
Reverts to 8.25.
I can't replicate. For me it just reverts to 9.75Quote:
Originally Posted by Karl77
Could this have to do with the various sizes that have been installed for the font on the PC? I remember having had some challenges with font sizes in the past with Windows seemingly arbitrarily switching to another size than the number it was given.Quote:
Originally Posted by Krool
Also, as you’re talking about a UI font, could Windows’ scaling setting play a role, e.g. if it’s not 100%?
Now I have 9.75 as well after several tries.Quote:
I can't replicate. For me it just reverts to 9.75
I had to set a different font before, change the size, and then set the font.
So forget the strange effect.
Not in this case.Quote:
Also, as you’re talking about a UI font, could Windows’ scaling setting play a role, e.g. if it’s not 100%?
I work at 100% always, and alter the setting for tests only.
I never save a project when not at 100%.
Toolbar index problem
I have a toolbar with 3 buttons.
They are added by code, using the string key of the imagelist.
All fine.
Now I have a .DisabledImagelist.
For this test the imagelist holds the same images, but in different order.
While the single image has the same key as in the normal imagelist.
When I now disable a button by key, the wrong image from the DisabledImagelist is applied.
It would be good if the image for the disabled button is fetched by the image key.
Attachment 185607
I understand.. However, the "solution" is not easy.Quote:
Originally Posted by Karl77
First of all, the TBBUTTONINFOW structure has only single iImage member.
So TB_SETIMAGELIST/TB_SETDISABLEDIMAGELIST/TB_SETHOTIMAGELIST do use the same iImage member.
That could be solved applying I_IMAGECALLBACK on iImage member and set the appropriate index at TBN_GETDISPINFO. But, that implies two possible solutions:
1. Fetch the index from the ImageList at every TBN_GETDISPINFO. (performance penalty)
2. Add new DisabledImage/HotImage in the TbrButton class. So that the index can be fetched once and used at TBN_GETDISPINFO. For back-compat reasons DisabledImage/HotImage must return the Image property in case they are not set. (empty) Which would be possible as the properties are Variants.
So I opt for solution 2. In would be possible even to incorporate this into VBCCR17 (only typelib version increments)
But that would require your code to set the possible new DisabledImage property afterwards. (an enhancement in the Buttons.Add signature is not possible as it breaks binary compatibility)
example:
What do you think ?Code:With .Buttons.Add(, "key1", , TbrButtonStyleDefault, "a")
.DisabledImage = "a"
End With
Performance penalty is not my friend.
On the other hand, it depends on how often it happens and how long it takes.
Other idea:
Sorting the .DisabledImageList so that the index matches the .ImageList.
This has to be done 1x only.
(Don't know how to handle it when the DisabledImageList is shorter than .ImageList.)
A change in the source is no problem.
When using such, is the image from the .DisabledImageList?Code:.DisabledImage = "a"
If so, then fine.
Regarding the imagelists:
Up to now I create the disabled images manually.
I don't do it for all normal pictures.
And I don't want do do that at all anymore.
The normal pictures get added to the imagelist by code.
The sources are PNGs with transparency in a ressource file.
Works good, no problem.
The idea is now, to read the pictures in the imagelist, make them brighter and greyscale and copy the result to a .DisabledImagelist.
Would avoid the former issue "Toolbar index problem" completely.
Before I reinvent the wheel:
Are there any functions I could use for the image processing in VBCCR?
Or another idea which is not a large additional library?