CommonControls (Replacement of the MS common controls)

[imotion]

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?

[clintc]

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!

[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

[Krool]

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.

[Chris_G33]

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:

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:

hCursorHand = LoadCursor(0, CLng(IDC_HAND))

In UserControl_MouseMove:

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

With this the hand cursor is shown fine.

[Krool]

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.

[sagit62]

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

[Krool]

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..

[sagit62]

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)

[Krool]

Thank for your reply.

I have now added this code in LabelW.ctl:

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:

hCursorHand = LoadCursor(0, CLng(IDC_HAND))

In UserControl_MouseMove:

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.

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 ?

[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

[Krool]

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.

[sagit62]

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

Here the project for est the exotic behavior ...
TestFrameW.zip

[Krool]

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

Here the project for est the exotic behavior ...
TestFrameW.zip

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:


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.

[imotion]

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

[sagit62]

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:


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

[imotion]

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

[Mith]

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

[imotion]

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

[Krool]

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.

[Mith]

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?

[fafalone]

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.

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)

[imotion]

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

[imotion]

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?

[Mith]

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

[imotion]

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

[Arnoutdv]

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

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

[Kevin2]

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!!!

[xiaoyao]

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

[xiaoyao]

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)

[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.

[xiaoyao]

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++

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;

[Arnoutdv]

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

[xiaoyao]

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

[Arnoutdv]

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.

[xiaoyao]

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

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

[fafalone]

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.

                    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.

[xiaoyao]

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.

[fafalone]

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...

                        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;

    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.

[xiaoyao]

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