CommonControls (Replacement of the MS common controls)

I have a problem with ListView and ImageList, Im stuck, I tried the most simple, I use a ImageList with just 1 image, then I remove the image and add another, it is always 1 index, I update the image so I can put diferent icon for diferent file in ListView

example:
Set LVitem= ListView1.ListItems.Add(, , "item1", , 1)
LVitem.SubItems(1) = "SubItem1"

ImageList1.ListImages.Remove (1)
Call ImageList1.ListImages.Add(1, , Form1.Picture1(1).Image)

Set LVitem= ListView1.ListItems.Add(, , "item2", , 1)
LVitem.SubItems(1) = "SubItem2"

ImageList1.ListImages.Remove (1)
Call ImageList1.ListImages.Add(1, , Form1.Picture1(2).Image)

Icons in listview will be all the same, they will be Form1.Picture1(2).Image, the last image updated in ListView, even if the image is replaced after creation of the Item
so the only way to have diferent icons for diferent items in ListView is to assing diferent index, and grow the ImageList, but this is not the proper way for an explorer with files
or maybe is just that I dont know how to do it or Im missing anything, anu idea please?

Quote:

---

Originally Posted by Krool

The issue with the black line appears to be the DrawThemeParentBackground and the WM_PRINTCLIENT handler.
So, either I remove the WM_PRINTCLIENT handler or remove the DrawThemeParentBackground.

Since it makes maybe sense for "transparent" BP_GROUPBOX style windows to use DrawThemeParentBackground it makes definitely no sense for the FrameW control which is isolated in a UserControl with a fixed BackColor.
The "Transparent" property of the FrameW can be used to draw a fake replica of the parent background already. So there is no need here for DrawThemeParentBackground.

Update released. Fixed. Thanks for reporting !

---

Thank You Krool!

You're the best!

Problem with mouse pointer hand with labelw:

When the user has increased the cursor size in the windows settings e.g. set to 3, and I set the mouse pointer for a labelw to 4 - Hand, then the mouse pointer is pixeld:
Attachment 194463
(Irfan View could not capture the correct cursor (arrows instead), so I took a picture)

With other controls the hand is shown correcty.

What's the problem here? how can I fix that?

Thank you

Quote:

---

Originally Posted by Chris_G33

Problem with mouse pointer hand with labelw:

When the user has increased the cursor size in the windows settings e.g. set to 3, and I set the mouse pointer for a labelw to 4 - Hand, then the mouse pointer is pixeld:
Attachment 194463
(Irfan View could not capture the correct cursor (arrows instead), so I took a picture)

With other controls the hand is shown correcty.

What's the problem here? how can I fix that?

Thank you

---

The LabelW is a windowless control and is dependent on the MousePointer VB6 basis. There is no hand cursor, that's why it uses LoadCursor and MouseIcon when set to 4 - Hand.
Unfortunately this get's scaled blurry. I don't know how to fix. Probably overkill solution would be to intercept WM_SETCURSOR on IOleInPlaceObjectWindowless::OnWindowMessage.

As a workaround you could use the WindowedLabel control where WM_SETCURSOR is handled properly and 4 - Hand will show as expected.

Quote:

---

Originally Posted by Krool

The LabelW is a windowless control and is dependent on the MousePointer VB6 basis. There is no hand cursor, that's why it uses LoadCursor and MouseIcon when set to 4 - Hand.
Unfortunately this get's scaled blurry. I don't know how to fix. Probably overkill solution would be to intercept WM_SETCURSOR on IOleInPlaceObjectWindowless::OnWindowMessage.

As a workaround you could use the WindowedLabel control where WM_SETCURSOR is handled properly and 4 - Hand will show as expected.

---

Thank for your reply.

I have now added this code in LabelW.ctl:

Code:

---

Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Const IDC_HAND As Long = 32649
Private hCursorHand As Long

---

in UserControl_Initialize:

Code:

---

hCursorHand = LoadCursor(0, CLng(IDC_HAND))

---

In UserControl_MouseMove:

Code:

---

If PropMousePointer = vbIconPointer Then
    If GetCursor <> hCursorHand Then SetCursor hCursorHand
End If

---

With this the hand cursor is shown fine.

I just did a quick and dirty test with IOleInPlaceObjectWindowless and handling OnWindowMessage WM_SETCURSOR and do SetCursor and it works.

The question is now should I update really OLEGuids and VTableHandle for that issue ? Again, UserControl_MouseMove might work but is not the proper way to do it. I would replace this said LabelW with a WindowedLabel control.

Quote:

---

Originally Posted by Krool

The issue with the black line appears to be the DrawThemeParentBackground and the WM_PRINTCLIENT handler.
So, either I remove the WM_PRINTCLIENT handler or remove the DrawThemeParentBackground.

Since it makes maybe sense for "transparent" BP_GROUPBOX style windows to use DrawThemeParentBackground it makes definitely no sense for the FrameW control which is isolated in a UserControl with a fixed BackColor.
The "Transparent" property of the FrameW can be used to draw a fake replica of the parent background already. So there is no need here for DrawThemeParentBackground.

Update released. Fixed. Thanks for reporting !

---

Really great!
Thank you so much

I updated the OLEGuids.tlb to include IOleInPlaceObjectWindowless and IOleInPlaceObjectWindowlessVB interfaces in preparation of an eventually upcoming proper handling of WM_SETCURSOR for windowless controls. (e.g. Hand cursor with more than 1x scale on the ease of access settings)
VTableHandle.bas and LabelW not yet modified..

Quote:

---

Originally Posted by Krool

The issue with the black line appears to be the DrawThemeParentBackground and the WM_PRINTCLIENT handler.
So, either I remove the WM_PRINTCLIENT handler or remove the DrawThemeParentBackground.

Since it makes maybe sense for "transparent" BP_GROUPBOX style windows to use DrawThemeParentBackground it makes definitely no sense for the FrameW control which is isolated in a UserControl with a fixed BackColor.
The "Transparent" property of the FrameW can be used to draw a fake replica of the parent background already. So there is no need here for DrawThemeParentBackground.

Update released. Fixed. Thanks for reporting !

---

New information about the appearance of the black line in a FrameW under certain conditions.
I was able to do various tests after the release of the 1.8.60 upgrade.
I was able to verify that the black line continues to appear when these three conditions occur together:
1. A FrameW (SubFrameW) inside another FrameW (MainFrameW)
2. In the SubFrameW these controls are present at the same time: at least one original VB6 ComboBox - at least one LabelW from the CCR set.
3. At runtime, the MainFrameW is first hidden (Me.MainFrameW.Visible = False) and then made visible again (Me.MainFrameW.Visible = True).

If in the SubFrameW there are only VB6 ComboBox and VB6 Label, the black line does not appear.
The same if there is only either a VB6 ComboBox or a VB6 Label or a CCR LabelW. Even if there are both Label VB6 and LabelW CCR and other CCR controls the black line does not appear.
The double procedure of point 3 is necessary to generate the black line event. The black line does not appear in IDE or runtime if the FrameW is not first hidden and then made visible again.

I tried to delete the VB6 ComboBoxes and recompile the project with the CCR version 1.8.58 and the behavior is the same. Making me think that the problem is not the one identified and fixed, but has to do with an incompatibility between the VB6 ComboBox and the CCR set.
I have not verified if the problem concerns only the VB6 ComboBox control or also other VB6 controls that are not the basic ones such as the Label.

I hope I have been sufficiently clear and perhaps also useful for the development of the CCR project that I find truly great and useful.
Thanks for your attention.

(Google translation from Italian)

Quote:

---

Originally Posted by Chris_G33

Thank for your reply.

I have now added this code in LabelW.ctl:

Code:

---

Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Const IDC_HAND As Long = 32649
Private hCursorHand As Long

---

in UserControl_Initialize:

Code:

---

hCursorHand = LoadCursor(0, CLng(IDC_HAND))

---

In UserControl_MouseMove:

Code:

---

If PropMousePointer = vbIconPointer Then
    If GetCursor <> hCursorHand Then SetCursor hCursorHand
End If

---

With this the hand cursor is shown fine.

---

Should I add the fix into the LabelW directly ? (by handling WM_SETCURSOR on IOleInPlaceObjectWindowless::OnWindowMessage)

But this adds a little bit of overhead to a lightweight control,
thus I think it should be explicitly enabled via a conditional compilation constant (e.g. #Const ImplementSetCursor defaulting to False to avoid extra overhead)

So for your use-case you could then just change #Const ImplementSetCursor into True and it would work out of the box.

EDIT: Or no compilation const and add / remove the overhead when the mousepointer is on 4 - Hand. I think that would be OK.

Quote:

---

Originally Posted by sagit62

New information about the appearance of the black line in a FrameW under certain conditions.
I was able to do various tests after the release of the 1.8.60 upgrade.
I was able to verify that the black line continues to appear when these three conditions occur together:
1. A FrameW (SubFrameW) inside another FrameW (MainFrameW)
2. In the SubFrameW these controls are present at the same time: at least one original VB6 ComboBox - at least one LabelW from the CCR set.
3. At runtime, the MainFrameW is first hidden (Me.MainFrameW.Visible = False) and then made visible again (Me.MainFrameW.Visible = True).

If in the SubFrameW there are only VB6 ComboBox and VB6 Label, the black line does not appear.
The same if there is only either a VB6 ComboBox or a VB6 Label or a CCR LabelW. Even if there are both Label VB6 and LabelW CCR and other CCR controls the black line does not appear.
The double procedure of point 3 is necessary to generate the black line event. The black line does not appear in IDE or runtime if the FrameW is not first hidden and then made visible again.

I tried to delete the VB6 ComboBoxes and recompile the project with the CCR version 1.8.58 and the behavior is the same. Making me think that the problem is not the one identified and fixed, but has to do with an incompatibility between the VB6 ComboBox and the CCR set.
I have not verified if the problem concerns only the VB6 ComboBox control or also other VB6 controls that are not the basic ones such as the Label.

---

That sounds exotic. Can you provide a small demo project replicating exactly this issue ?

anyone knows how it would be a custon sort in Listview? is possible?
I want to try to sort folders and files separately, like the windows explorer, also I want to do another kind of sorts

Quote:

---

Originally Posted by imotion

anyone knows how it would be a custon sort in Listview? is possible?
I want to try to sort folders and files separately, like the windows explorer, also I want to do another kind of sorts

---

Unfortunately there is no custom sort type and event.
Eventually it will be included some day, noted.

I recommend you to go the "virtual mode" route right from start. It has a lot of performance benefits (unload etc.) and you can sort your cache data how you want.

EDIT: Or you send LVM_SORTITEMSEX manually to the listview.

That sounds exotic. Can you provide a small demo project replicating exactly this issue ?

Here the project for est the exotic behavior ...
Attachment 194488

Quote:

---

Originally Posted by sagit62

That sounds exotic. Can you provide a small demo project replicating exactly this issue ?

Here the project for est the exotic behavior ...
Attachment 194488

---

Thanks.
Ok, well it can be fixed (workaround) when you call .Refresh on the frame that has a black line.

And when I remove the WM_PRINTCLIENT handler it will not have this black line to start with..
And it is the VB6 ComboBox which is sending it. Probably again this DrawThemeParentBackground from the themed combo box.

An UserControl.Cls after the WM_PRINTCLIENT handler will fix the black line. Think will gonna do that as bugfix.

Because removing the WM_PRINTCLIENT handler on the FrameW results in edges not properly drawn on the combobox, as you can see here:
Attachment 194490

EDIT: Update released. Fixed.

EDIT2: Second fix. The UserControl.Cls at WM_PRINTCLIENT becomes unnecessary when I set the .AutoRedraw = True / False in the DrawFrame routine instead of always True at design time. That is cleaner.

Quote:

---

Originally Posted by Krool

Unfortunately there is no custom sort type and event.
Eventually it will be included some day, noted.

I recommend you to go the "virtual mode" route right from start. It has a lot of performance benefits (unload etc.) and you can sort your cache data how you want.

EDIT: Or you send LVM_SORTITEMSEX manually to the listview.

---

Thank you very much Krool, I decided to give a try to virtual, but seems complicated if there isnt an example, the first I found is that I cant add items, I investigated a bit and seems in virtual it doesnt handle data, it only displays in Listview what you want it to display or something like that i think, but Im new with it and I dont know how to pass the data to show in the Listview or how to work with it, so I think i give up in the try, could be much complicated and more without example
but in fact it seems completely flexible for sorting as you give it the list that you want to be displayed, you can cook it before I think

Quote:

---

Originally Posted by Krool

Thanks.
Ok, well it can be fixed (workaround) when you call .Refresh on the frame that has a black line.

And when I remove the WM_PRINTCLIENT handler it will not have this black line to start with..
And it is the VB6 ComboBox which is sending it. Probably again this DrawThemeParentBackground from the themed combo box.

An UserControl.Cls after the WM_PRINTCLIENT handler will fix the black line. Think will gonna do that as bugfix.

Because removing the WM_PRINTCLIENT handler on the FrameW results in edges not properly drawn on the combobox, as you can see here:
Attachment 194490

EDIT: Update released. Fixed.

EDIT2: Second fix. The UserControl.Cls at WM_PRINTCLIENT becomes unnecessary when I set the .AutoRedraw = True / False in the DrawFrame routine instead of always True at design time. That is cleaner.

---

All ok!
I renew my thanks

well I wont use virtual mode this time, normal mode is more slow I guess, the file explorer that Im making is slow for large folders like system32 for example, but for want I need is ok and I could sort files folders as i wanted, only in date columns they arent sort separately like windows explorer

I have a question
I tested a file named with another language, different characters, is it suposed to show it correctly in the treeview and listview, or Im missing anything, or it isnt that kind of unicode support

Quote:

---

Originally Posted by imotion

I tested a file named with another language, different characters, is it suposed to show it correctly in the treeview and listview, or Im missing anything, or it isnt that kind of unicode support

---

You have to use the WIDE version of all your APIs that ends with an "A" to get UNICODE file names: "FindFirstFileA", "FindNextFileA", etc

Quote:

---

Originally Posted by Mith

You have to use the WIDE version of all your APIs that ends with an "A" to get UNICODE file names: "FindFirstFileA", "FindNextFileA", etc

---

I think its not that in this case, but thanks

Quote:

---

Originally Posted by Chris_G33

Problem with mouse pointer hand with labelw:

When the user has increased the cursor size in the windows settings e.g. set to 3, and I set the mouse pointer for a labelw to 4 - Hand, then the mouse pointer is pixeld:
Attachment 194463
(Irfan View could not capture the correct cursor (arrows instead), so I took a picture)

With other controls the hand is shown correcty.

What's the problem here? how can I fix that?

Thank you

---

Update released.

The LabelW can now show a proper Hand cursor by handling WM_SETCURSOR on IOleInPlaceObjectWindowless::OnWindowMessage.
This little overhead is only in use for the Hand cursor, which is quite a common cursor, thus important.

Quote:

---

Originally Posted by imotion

I think its not that in this case, but thanks

---

How can you display the UNICODE file names in the controls if your read only the ANSI names of the files with your sample project?

Quote:

---

Originally Posted by imotion

anyone knows how it would be a custon sort in Listview? is possible?
I want to try to sort folders and files separately, like the windows explorer, also I want to do another kind of sorts

---

Quote:

---

Originally Posted by Krool

Unfortunately there is no custom sort type and event.
Eventually it will be included some day, noted.

I recommend you to go the "virtual mode" route right from start. It has a lot of performance benefits (unload etc.) and you can sort your cache data how you want.

EDIT: Or you send LVM_SORTITEMSEX manually to the listview.

---

FYI if you want to get the exact sort order of Explorer, compare strings with StrCmpLogicalW, which is what Explorer itself uses. You still have to handle folder vs nonfolder manually. Or use IShellFolder.CompareIDs and it will handle folders automatically .

Maybe use .Tag to store if it's a folder then modify ListItemSortingFunctionLogical.

(PS- As the others told you, yes it is indeed the case Find*FileA returns ANSI names in its WIN32_FIND_DATAA type. You need Find..W and WIN32_FIND_DATAW)

Quote:

---

Originally Posted by fafalone

FYI if you want to get the exact sort order of Explorer, compare strings with StrCmpLogicalW, which is what Explorer itself uses. You still have to handle folder vs nonfolder manually. Or use IShellFolder.CompareIDs and it will handle folders automatically .

Maybe use .Tag to store if it's a folder then modify ListItemSortingFunctionLogical.

(PS- As the others told you, yes it is indeed the case Find*FileA returns ANSI names in its WIN32_FIND_DATAA type. You need Find..W and WIN32_FIND_DATAW)

---

thank you, Im not with that now and I already saw a lot of complicated examples of sorting lol, I could do it in the easy way, only that folders arent sorted separate in date columns, but is ok for me
what I would like to know is that if is it possible to show another languages filenames characters in the right way in treeview and listview

Quote:

---

Originally Posted by Mith

How can you display the UNICODE file names in the controls if your read only the ANSI names of the files with your sample project?

---

I know not much about this so not sure what you mean Mith, do you mean I have to use a OS with language in chinesse for example to see chinesse characters in listview filenames?

Quote:

---

Originally Posted by imotion

I know not much about this so not sure what you mean Mith, do you mean I have to use a OS with language in chinesse for example to see chinesse characters in listview filenames?

---

As i suggested before: you have to replace all APIs in your project that ends with an "A" (ANSI) to "W" (UNICODE). API ANSI vs. WIDE

Quote:

---

Originally Posted by Mith

As i suggested before: you have to replace all APIs in your project that ends with an "A" (ANSI) to "W" (UNICODE). API ANSI vs. WIDE

---

for FindFirstFile and FindNextFile that I use to fill the listview with filenames, there isnt an Api version with A and another without A

there is only this one, and always declared like this, Alias "FindFirstFileA", but is not working for foreign characters
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"


there are more FindFirstFile, but are diferent api calls
FindFirstFile
FindFirstFileEx
FindFirstFileNameW

FindNextFile
FindNextFileNameW

ah I just saw your link what it says, well i will make tests with this apis in some days, Im busy with other life things, thanks a lot :wave:

You should really start a new thread for your question, because it has nothing to do anymore with Controls provided by Krool

Code:

---

Public Enum FINDEX_INFO_LEVELS
  FindExInfoStandard
  FindExInfoBasic
  FindExInfoMaxInfoLevel
End Enum

Public Enum FINDEX_SEARCH_OPS
  FindExSearchNameMatch
  FindExSearchLimitToDirectories
  FindExSearchLimitToDevices
  FindExSearchMaxSearchOp
End Enum

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Declare Function FindFirstFileExW Lib "kernel32" (ByVal lpFileName As Long, ByVal fInfoLevelId As FINDEX_INFO_LEVELS, ByVal lpFindFileData As Long, Optional ByVal fSearchOp As FINDEX_SEARCH_OPS, Optional ByVal lpSearchFilter As Long, Optional ByVal dwAdditionalFlags As FINDEX_FLAGS) As Long
Declare Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal lpFindFileData As Long) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

---

First Krool - thank you so much for this control!

I'm in the process of upgrading a program I wrote from version 1.7 to version 1.8.

All of the controls are working correctly with the exception of the MonthView control. It uses VisualStyles (and the property is set to use VisualStyles) in the IDE however when complied it reverts back to not using VisualStyles. I've removed the MonthView from the form, put it back, compiled a bunch of times and just cannot seem to get it to use the VisualStyles. All of the other controls are displaying correctly. I even created a new project and tested with the same results. This control displayed correctly with Version 1.7.


Any Suggestions?

Attachment 194533

Attachment 194534

UPDATE: Actually it's all of the controls do not show using the VisualStyles when compiled. I also just installed the program (updated to the 1.8) onto a test machine and it too does not show using the visual styles.

SECOND UPDATE: I got it taken care of. Have no idea why but after I unregistered and then registered I would test - didn't fix it. I rebooted and tested still wasn't working. Unregistered and then registered the OCX again and now it's working. Thanks again for a great control!!!

RichTextBox,MAYbe can add new method:move to line 2?
move to line 2,and at chr 5
rtf txt:
=======
aaaa
12345(move mouse to here)678

richtextbox converts the current line to a number if it is numbered automatically. Otherwise, text cannot be added at the beginning of the line. New character

how to copy line to RICHEDIT2 HWND ?

Need help with Richtext (again)-VBForums
https://www.vbforums.com/showthread....t=EM_STREAMOUT

OR COPY RTF DATA WITHOUT clipboard?
copy richtextbo1 line 4 to richtextbox2

i need copy and save all lines to more files or input to string array() for every line rtf data(with font color/images)

Update released.

Modified OLEGuids.tlb again as following: (compiled with same uuid)

Renamed IDispatch to IDispatchUnrestricted. (used in VTableHandle.bas only which needs to be replaced too)
This allows all the *VB interfaces to use stdole.IDispatch. (better intellisense and just the correct way to do it)
MKTYPLIB expects 'IDispatch' and does not allow to use 'stdole.IDispatch' for OLEAutomation interfaces.

Unregister to old OLEGuids.tlb is not necessary, just overwrite the file.

Quote:

---

Originally Posted by Krool

Update released.

Modified OLEGuids.tlb again as following: (compiled with same uuid)

Renamed IDispatch to IDispatchUnrestricted. (used in VTableHandle.bas only which needs to be replaced too)
This allows all the *VB interfaces to use stdole.IDispatch. (better intellisense and just the correct way to do it)
MKTYPLIB expects 'IDispatch' and does not allow to use 'stdole.IDispatch' for OLEAutomation interfaces.

Unregister to old OLEGuids.tlb is not necessary, just overwrite the file.

---

Case EN_LINK
Dim NMENL As NMENLINK
CopyMemory NMENL, ByVal lParam, LenB(NMENL)
With NMENL
RaiseEvent LinkEvent(.wMsg, .wParam, .lParam, .CHARRANGE.Min, .CHARRANGE.Max)
End With

RTF CONTROL,HOW TO GET link text and how to change?
event:link click
sub ocx_LinkEvent(byref linktxt,byurl linkurl)
linktxt=**
linkurl=**

how to change linktxt?
end sub
questtion2:
how to select a word from now positon?
aaadf abcd123 ddddd

like i put mouse on(d and 1) d>mouse>1,how to get abcd123

it's ai by vc++

Code:

---

if (nStart == nEnd) {
    // ???????
    long wordStart = (long)SendMessage(m_hWndRichEdit, EM_FINDWORDBREAK, WB_LEFTBREAK, nStart);
    // ???????
    long wordEnd = (long)SendMessage(m_hWndRichEdit, EM_FINDWORDBREAK, WB_RIGHTBREAK, nStart);
    nStart = wordStart;
    nEnd = wordEnd;

---

@xiaoyao: By now you should know that you should create your own threads for asking questions

your code for get link url is error,fafalong ,he's method it's ok by api

how to use richtextbox-PrintDoc? print to pdf file

Are you reporting a bug to Krool?
It's very hard to get what you are saying, doing or meaning.
Also printing to PDF is not part of this control set.

it's can add pictures by ole type,but i don't khnow how to save ole Piture
when i click picture1 by ole method insert,how to get this picture REAL SIZE(IN RTF IS 300*500),REAL IS 600*1000

Code:

---

Public Function OLEObjectsByIndex(ByVal IndexObj As Long, Optional ByVal CharPos As Long) As OLEGuids.IOleObject 'addby xiaoyao

If RichTextBoxHandle <> NULL_PTR Then
    Dim OLEInstance As OLEGuids.IRichEditOle
    Set OLEInstance = Me.GetOLEInterface
    If Not OLEInstance Is Nothing Then
        Dim REOBJ As REOBJECT
        REOBJ.cbStruct = LenB(REOBJ)
        If IndexObj = REO_IOB_USE_CP Then REOBJ.CharPos = CharPos
        OLEInstance.GetObject IndexObj, REOBJ, REO_GETOBJ_POLEOBJ
        Set OLEObjectsByIndex = REOBJ.pOleObject '"objptr(??)
    End If
End If
End Function

---

Once you have the IOleObject cast it to either IPicture, or if that fails, to IViewObject2. Then the original size is either IPicture.Width/Height or IViewObject2.GetExtent.

Note it's given in HiMetric and there seems to be application-independent scaling applied; i.e. even if your app is marked DPI-unaware, and even if you use GetDC(hwnd) instead of GetDC(0), the original dimensions returned are scaled according to the Windows system wide scale factor. If you're at 150% multiply by 1.5, for example. At least with IViewObject2, which is the one that worked for my test png.

Code:

---

                    Dim pPic As IPicture
                    Dim szOrig As SIZE
                    Dim szOrigHM As SIZE
                    Set pPic = tObj.poleobj
                    If pPic IsNot Nothing Then
                        szOrigHM.cx = pPic.Width
                        szOrigHM.cy = pPic.Height
                        HiMetricToPixel(szOrigHM, szOrig, hRE)
                        Debug.Print "origdim->IPicture cx=" & szOrig.cx & ",cy=" & szOrig.cy
                        Set pPic = Nothing
                    Else
                        Dim pVO As IViewObject2
                        Set pVO = tObj.poleobj
                        If pVO IsNot Nothing Then
                            pVO.GetExtent(DVASPECT_CONTENT, -1&, vbNullPtr, szOrigHM)
                            HiMetricToPixel(szOrigHM, szOrig, hRE)
                            Debug.Print "origdim->IViewObject2 cx=" & szOrig.cx & ",cy=" & szOrig.cy
                            Set pVO = Nothing
                        Else
                            Debug.Print "origdim->Neither IPicture nor IViewObject2 available."
                        End If
                    End If

---

Where tObj is the REOBJECT after you've successfully called.GetObject.

Yes, sometimes I feel very strange, too. I'm going to add a normal image and I'm going to put it in the same size, but it's going to be smaller, and I'm gonna multiply it by 15 and then multiply it by the dpi multiple.

Probably the easiest way to convert it to an image in VB6.Other programming languages deal with ole objects more complicatedly.

It would be more convenient if some functions needed by the toolbar were made into a control or a property page separately.

For example, if you select an image, you can get the byte array of the image directly, or double-click it to enlarge it.Click on the hyperlink to get the link, and you can also modify the text corresponding to the link.This is a very old technology. Windows WordPad also has very few features.

To get the image to save... if you get an IPicture handle you can use the standard VB6 picture saving.

If you're getting IViewObject2, you can probably get IDataObject...

Code:

---

                        Dim pdo As IDataObject
                        Set pdo = tObj.poleobj
                        If pdo IsNot Nothing Then
                            Debug.Print "Got IDO"
                            Dim fmt As FORMATETC
                            Dim stg As STGMEDIUM
                            fmt.cfFormat = CF_BITMAP
                            fmt.dwAspect = DVASPECT_CONTENT
                            fmt.lIndex = -1
                            fmt.tymed = TYMED_GDI
                            If SUCCEEDED(pdo.GetData(fmt, stg)) Then
                                Debug.Print "Got BMP IDO"
                                Dim gimg As LongPtr
                                GdipCreateBitmapFromHBITMAP(stg.data, 0, gimg)
                                GdipSaveImageToFile(gimg, StrPtr("C:\file\to\save\to.png"), ImageCodecPng, ByVal 0)
                                GdipDisposeImage(gimg)
                            End If

---

(assumes you've already called GdiplusStartup and obtained the CLSID for the codec... I just used a hard coded value to test;

Code:

---

    Public Function ImageCodecPng() As UUID
    '{557CF406-1A04-11D3-9A73-0000F81EF32E}
    Static iid As UUID
    If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H557CF406, CInt(&H1A04), CInt(&H11D3), &H9A, &H73, &H00, &H00, &HF8, &H1E, &HF3, &H2E)
    ImageCodecPng = iid
    End Function

---

PS- You should use REO_GETOBJ_ALL_INTERFACES or resizing may fail.

Dim Pic As StdPicture
Set Pic = LoadPictureEx(App.Path & "\test2.png")
RichTextBox1.OLEObjectsAddFromPicture Pic

Dim Pic As StdPicture
Set Pic = LoadPictureEx(App.Path & "\test1.png")
RichTextBox1.OLEObjectsAddFromPicture Pic

'get all olepic objptr?
Dim c As Long, i As Long
c = RichTextBox1.OLEObjectsCount
For i = 0 To c - 1
Dim obj As OLEGuids.IOleObject
Debug.Print "ole(" & i + 1 & ") objptr=" & RichTextBox1.OLEObjectsGet(i + 1)
Next

while can't get all ole objptr? some times it' 0,some times ,can't get picture2 OBJPTR

@Krool ,how to add this code to your project?

insert link url or edit hyper link:

Code:

---

Const sFriendlyURL As String = "{\rtf1{\field{\*\fldinst{HYPERLINK ""URL""}}{\fldrslt{NAME}}}}" 'by fafalone
Function GetRtfCode(Optional ByVal FromSelectArea As Boolean) As String
    'add Function By XiaoYao
    Dim Buffer As String
    Buffer = vbNullString
    StreamStringOut Buffer, SF_RTF Or IIf(FromSelectArea, SFF_SELECTION, 0)
    GetRtfCode = StrToVar(Buffer) 'TextRTF
End Function

---

Private Sub RichTextBox1_LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long _
, ByVal LinkStart As Long, ByVal LinkEnd As Long)
args from:LinkStart ,LinkEnd

Code:

---

Public Sub SetRange(ByVal SStart As Long, ByVal SLen As Long)
 '??????????????
 Dim CR As CHARRANGE
 CR.cpMin = SStart
 CR.cpMax = SStart + SLen
 SendMessage RichTextBoxHandle, EM_EXSETSEL, 0&, CR
End Sub
Sub EditLinkObj(ByVal txt As String, ByVal LinkUrl As String, ByVal LinkStartA As Long, ByVal LinkEndA As Long, Optional ByVal AddSTR As String = "  ")
'add Function By XiaoYao
        SetRange LinkStartA, LinkEndA - LinkStartA
        If AddSTR <> "" Then txt = AddSTR & txt & AddSTR
        AddLink txt, LinkUrl
    End If
End Sub
Sub AddLink(txt As String, Url As String)
'add Function By XiaoYao
    SelText = GetlinkRTF(txt, Url)
End Sub
Function GetlinkRTF(txt As String, sUrl As String) As String
    If Len(sUrl) Then
        GetlinkRTF = Replace(Replace(sFriendlyURL, "URL", sUrl), "NAME", txt) ' Create a hyperlink for the current selection using RTF syntax
    End If
End Function

---

You can get the link url as following:

Code:

---

Private Sub RichTextBox1_LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal LinkStart As Long, ByVal LinkEnd As Long)
Const WM_LBUTTONDOWN As Long = &H201
If wMsg = WM_LBUTTONDOWN Then
    Debug.Print RichTextBox1.GetTextRange(LinkStart, LinkEnd)
End If
End Sub

---

Quote:

---

Originally Posted by Krool

You can get the link url as following:

Code:

---

Private Sub RichTextBox1_LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal LinkStart As Long, ByVal LinkEnd As Long)
Const WM_LBUTTONDOWN As Long = &H201
If wMsg = WM_LBUTTONDOWN Then
    Debug.Print RichTextBox1.GetTextRange(LinkStart, LinkEnd)
End If
End Sub

---

---

WHY GetTextRange IS GET URL?
a=RichTextBox1.seltext it's for get text
a=RichTextBox1.GetTextRange(LinkStart, LinkEnd)
it's for get url

Hi Krool, thanks again for these controls. I want to replace my old button control with yours, but I'm running into a few issues. Please see attached image.

Attachment 194671

In the top example, the VBCCR18 button control does ok, but I much prefer the positioning of the icon and caption on the old control (i.e. less padding to the left of the icon, and padding between the icon and caption).
The middle example has WordWrap = True, with no icon. Again, ok, but a bit more padding left/right would make it wrap better.
The bottom example has both WordWrap = True and an icon. Here, the wordwrap doesn't account for the picture, and ends up pushing the icon off on the left and overflowing the caption on the right.

Please let me know if you believe this (at least the bottom example) is a bug and can be fixed. Thanks! -Dan

Your project is so huge, how do you manage tens of thousands of lines of code?

This requires a very strong logical thinking, when I found a module if there are thousands of lines of code, I have been crazy.

Quote:

---

Originally Posted by hausman

Hi Krool, thanks again for these controls. I want to replace my old button control with yours, but I'm running into a few issues. Please see attached image.

Attachment 194671

In the top example, the VBCCR18 button control does ok, but I much prefer the positioning of the icon and caption on the old control (i.e. less padding to the left of the icon, and padding between the icon and caption).
The middle example has WordWrap = True, with no icon. Again, ok, but a bit more padding left/right would make it wrap better.
The bottom example has both WordWrap = True and an icon. Here, the wordwrap doesn't account for the picture, and ends up pushing the icon off on the left and overflowing the caption on the right.

Please let me know if you believe this (at least the bottom example) is a bug and can be fixed. Thanks! -Dan

---

the VBCCR button has several "modes". one is the graphical style button which replicates the VB6 native style button. (Style property = Graphical)

Alternativaly, use Style = Normal and set the "PictureAndCaption" property to True. This will be displayed then in a different way.

Third way is to use an ImageList. Then you can refine the location with the ImageListAlignment and ImageListMargin property.

Hello Krool!
The control property of "TextBoxW" is set to "AllowOnlyNumbers=True", and only integers can be entered.
You cannot enter decimals, or negative numbers.

Can the control property of "TextBoxW" be set to "AllowOnlyNumbers=True" to allow the entry of decimal or negative numbers, such as: "0.015" or "-100"

Thank you very much!

Quote:

---

Originally Posted by smileyoufu

Hello Krool!
The control property of "TextBoxW" is set to "AllowOnlyNumbers=True", and only integers can be entered.
You cannot enter decimals, or negative numbers.

Can the control property of "TextBoxW" be set to "AllowOnlyNumbers=True" to allow the entry of decimal or negative numbers, such as: "0.015" or "-100"

Thank you very much!

---

In case this is not possible, there is an easy way to deal with this. Create a function that filters out all non-allowed keystrokes:

Code:

---

Function LimitTextInputToNumeric(KeyCode) As Interger
    Const Numbers$ = "0123456789.,-"
    'backspace = 8
    If KeyCode<> 8 Then
        If InStr(Numbers, Chr(KeyCode)) = 0 Then
            LimitTextInputToNumeric = 0
            Exit Function
        End If
    End If
    LimitTextInputToNumeric = KeyCode
End Function

---

Then from the KeyPress event call the function with the key code:

Code:

---

Private Sub txtMyTextBox_KeyPress(KeyAscii As Integer)
    KeyAscii = LimitTextInputToNumeric(KeyAscii)
End Sub

---

I als use functions for LimitToNumericNoNegative, LimitTextInputToZeroToNine, LimitTextInputToNumericNoDecimals so that I can fully control the input of each textbox where needed.

Update released.

Regression in the WM_PRINTCLIENT handler on the FrameW control due to changes done on 30-Mar-2025.

Now themed only native Command/Option/CheckBox are automatically "transparent" again on a FrameW control.

Hello Erwin69!
Thank you so much for your kind help.
The code you provided basically solved my problem.
However, if the user enters the wrong number (such as "0.0-5" or "0.05-"), it will still not be filtered.

On top of the code you provided, I've added a post-input, post-input digital compliance check verification. Solved this issue for me now.
Maybe you'll have a better approach and idea.
Thank you very much!

Code:

---

Private Sub txtMyTextBox_LostFocus()
    If VBA.IsNumeric(Me.txtMyTextBox.Text) = False Then
        Me.txtMyTextBox.SetFocus
        MsgBox "Only numbers are allowed"
    End If
End Sub

---

Quote:

---

Originally Posted by smileyoufu

However, if the user enters the wrong number (such as "0.0-5" or "0.05-"), it will still not be filtered.

---

Code:

---

Private Sub txtMyTextBox_LostFocus()
  if instr(1,Me.txtMyTextBox.Text,"-") > 1 then
      MsgBox "wrong number"
    end if
End Sub

---

Quote:

---

Originally Posted by smileyoufu

Hello Erwin69!
Thank you so much for your kind help.
The code you provided basically solved my problem.
However, if the user enters the wrong number (such as "0.0-5" or "0.05-"), it will still not be filtered.

On top of the code you provided, I've added a post-input, post-input digital compliance check verification. Solved this issue for me now.
Maybe you'll have a better approach and idea.
Thank you very much!

Code:

---

Private Sub txtMyTextBox_LostFocus()
    If VBA.IsNumeric(Me.txtMyTextBox.Text) = False Then
        Me.txtMyTextBox.SetFocus
        MsgBox "Only numbers are allowed"
    End If
End Sub

---

---

Well, I read the question as how to limit the input to 0-9 and other characters that can be used in doubles, like dot, comma and minus sign, not as making sure the user inputs a valid value. However, validating if the resulting input is a valid number can indeed be done in the LostFocus event.

While you could do it Mith suggested, I'd use a generic "IsNumeric" function like you did. That way your validation is handled in a way that all sorts of situations are covered, plus it takes into consideration Windows regional settings.

A self written function for the validation should also include if multiple decimal separators are being used. (E.g 78..6 or 1.2.3) Plus if your app is used in international environments you'd have to deal with all sorts of formatting that may be valid in one environment but not in the other. E.g. in most if not all countries in Europe the comma is used as a decimal separator, and the dot for digit groeping, so a number like 12.456,78 would be perfectly valid. Also in a negative number is displayed directly with a minus sign in front of the numbers, in front but separated by a space, directly at the end or at the end separated by a space. Have a look at the Windows regional setting for formatting numbers to get a feel for all variations.

Quote:

---

Originally Posted by Krool

the VBCCR button has several "modes". one is the graphical style button which replicates the VB6 native style button. (Style property = Graphical)

Alternativaly, use Style = Normal and set the "PictureAndCaption" property to True. This will be displayed then in a different way.

Third way is to use an ImageList. Then you can refine the location with the ImageListAlignment and ImageListMargin property.

---

FYI, my original button is a different 3rd party button. I want to search / replace it with yours, but I can't without some tweaks.

Style Graphical vs Normal appears to just set the orientation of the picture to the caption, either horizontal or vertical. The bottom example is already Style = Normal (horizontal, as intended). It just doesn't calculate the positioning correctly and pushes the pic off to the left in this case. (If I stretch the button out, it starts to appear).

Finally, ImageList does lay out the pic & caption better, but precludes me from being able to search / replace the existing controls.

Hi,
Today I came across this

Code:

---

    ListView1.View = LvwViewReport
   
    ListView1.ColumnHeaders.Add
    ListView1.ColumnHeaders(1).Text = "Column 1"
   
    ListView1.ColumnHeaders.Add , , "Column 2"

---

Only Column 2 shows, column 1 stays blank. Is it a bug or is it known as normal?

Quote:

---

Originally Posted by Crapahute

Hi,
Today I came across this

Code:

---

    ListView1.View = LvwViewReport
   
    ListView1.ColumnHeaders.Add
    ListView1.ColumnHeaders(1).Text = "Column 1"
   
    ListView1.ColumnHeaders.Add , , "Column 2"

---

Only Column 2 shows, column 1 stays blank. Is it a bug or is it known as normal?

---

Thanks. That's again a strange one.
When inserting a column with a NULL pointer the column is screwed in some way.
The text in the next line is successfully stored but not displayed.
The fix would be to check if the StrPtr = 0 and then replace with a blank "". That way the column is not screwed and you later on can set to empty or a new text.

Fix will follow soon.

EDIT: Update released. Thanks again

Quote:

---

Originally Posted by Erwin69

Well, I read the question as how to limit the input to 0-9 and other characters that can be used in doubles, like dot, comma and minus sign, not as making sure the user inputs a valid value. However, validating if the resulting input is a valid number can indeed be done in the LostFocus event.

While you could do it Mith suggested, I'd use a generic "IsNumeric" function like you did. That way your validation is handled in a way that all sorts of situations are covered, plus it takes into consideration Windows regional settings.

A self written function for the validation should also include if multiple decimal separators are being used. (E.g 78..6 or 1.2.3) Plus if your app is used in international environments you'd have to deal with all sorts of formatting that may be valid in one environment but not in the other. E.g. in most if not all countries in Europe the comma is used as a decimal separator, and the dot for digit groeping, so a number like 12.456,78 would be perfectly valid. Also in a negative number is displayed directly with a minus sign in front of the numbers, in front but separated by a space, directly at the end or at the end separated by a space. Have a look at the Windows regional setting for formatting numbers to get a feel for all variations.

---

Hello Erwin69!
Thank you so much for helping me. Your guidance is very useful, and I will choose the right one reasonably.
Thanks again!

Hello.
For my MIDI audio device control project, I made a couple of small changes to the Slider control.
1. I added the new "ThumbSize" property to be able to resize the default Thumb so that it can be used more easily with the touch screen.
2. Using the existing "Reversed" property, I implemented the ability to reverse the direction of the slider value (both vertically and horizontally).
I marked my changes with the comment: 'VariazioneBG ====.
I hope I haven't made any serious mistakes. In my project it works perfectly.
I thought that perhaps these changes could be of interest to others as well.

Secondly, I ask if it wasn't possible and useful to add a property to the slider (e.g. TumbPicture) to be able to choose your own image to use instead of the default Thumb. I know that it is possible through the DrawMode property. But I'm not expert enough to do it myself.
In my opinion, it is a good addition that can enrich the value of the Slider control.
Thank you for your attention and valuable work.

Update released.

DroppedDown property improved in the CommandButtonW control to raise the DropDown event when set to True.

Basically prior to this update the DroppedDown property was kind of useless because it just used BCM_SETDROPDOWNSTATE which does not raise BCN_DROPDOWN.

Now it raises the event properly and ensure the button is redrawn before and after the event. Also it checks for BST_DROPDOWNPUSHED to not allow recursive entry.
The property makes nothing when BS_SPLITBUTTON is not defined.

Quote:

---

Originally Posted by Krool

Update released.

DroppedDown property improved in the CommandButtonW control to raise the DropDown event when set to True.

Basically prior to this update the DroppedDown property was kind of useless because it just used BCM_SETDROPDOWNSTATE which does not raise BCN_DROPDOWN.

Now it raises the event properly and ensure the button is redrawn before and after the event. Also it checks for BST_DROPDOWNPUSHED to not allow recursive entry.
The property makes nothing when BS_SPLITBUTTON is not defined.

---

There is still a bug when using the DropDown property:

Clicking fast on the DropDown arrow triggers the DropDown event AND the Click Event. A click with "normal speed" triggers only the DropDown event.
That is really annyoing if for example the Click Event opens a message box and the user only clicks on the DropDown arrow...

Can this be fixed? for example: IF DropDown arrow click THEN dont raise the Click Event :)

Update released.

Removed BS_NOTIFY on CommandButtonW/OptionButtonW/CheckBoxW/CommandLink. (like native VB controls)
BN_DOUBLECLICKED therefore is not generated anymore, except for BS_RADIOBUTTON (OptionButtonW) even though BS_NOTIFY is not set.
But OptionButtonW has a DblClick event and therefore is wanted. (like native OptionButton)
A double click will then raise a Click event upon mouse up instead of immediately. (like native VB controls)
This resolves also a side-effect bug in the CommandButtonW control which raised a Click event when doing a double click on the split button part. (BN_DOUBLECLICKED)

Quote:

---

Originally Posted by Mith

There is still a bug when using the DropDown property:

Clicking fast on the DropDown arrow triggers the DropDown event AND the Click Event. A click with "normal speed" triggers only the DropDown event.
That is really annyoing if for example the Click Event opens a message box and the user only clicks on the DropDown arrow...

Can this be fixed? for example: IF DropDown arrow click THEN dont raise the Click Event :)

---

It's a bug in the button control that a WM_LBUTTONDBLCLK on the split button part translates to a BN_DOUBLECLICKED notification.
As described above I didn't try to workaround this bug but rather circumvent it, by removing BS_NOTIFY which is also the correct way to do to match native VB controls.
I think it was kind of a relict from the early stages where I thought "can't harm to have more notifications" but did not grasp the side-effects.

Thanks for pointing this out to eliminate a deep bug!