[VB6] Modern Shell Interface Type Library - oleexp.tlb

[The trick]

Unfortunately while I can verify the problem exists I don't know how to resolve this when the IDL source is correct... any ideas?

Maybe a bug in MKTYPLIB? It shows FUNCDESC.oVft = 0. Here is the TLB without this bug in ID2D1Geometry interface but it exists in all the derived interfaces. I've just fixed bytes in a hex editor.

[fafalone]

It must start somewhere in the new ifaces and impact all following.. I had checked some older ones for just this issue but it seemed ok. Will investigate tonight.

[fafalone]

ID2D1RoundedRectangleGeometry::GetRoundedRect voffset=0x0034, inherits from ID2DGeometry... so it counts those methods... but not ID2D1Resource or IUnknown



ID2D1DrawingStateBlock::GetDescription voffset=0x00010, it inherits from ID2D1Resource... so same setup as ID2DGeometry, but correct.

Ok so I don't know why it's happening, but I figured out the solution... placing ID2D1Resource *before* ID2D1Geometry fixes the problem (even though it's forward declared). I'll post an update a little later after I make sure this isn't impacting anything else.

[fafalone]

Project Updated

The version is still 5.3, but if you downloaded oleexp before this post, it's impacted by the bug discussed in the previous few posts. It has now been fixed.

I made sure no interface appears before the one it inherits from, which was the cause of the bug, though it really shouldn't have been, given they were forward declared.

[The trick]

Please fix the IID of ITypeInfo interface it isn't correct.

[fafalone]

Wow, olelib (the project this was forked from) came out like 20 years ago and nobody has noticed this until now lol... i checked my copy of the original and sure enough it was wrong from then.


I'm finishing up adding some extra media foundation interfaces to support DirectComposition, I'll post it along with that tonight.

[The trick]

fafalone, are you interested in a project in which you could mix tlbs? Just i thought about the issues with MKTYPLIB like optional parameters, out/retval attributes. I think i could make a TLB mixer and you could use MIDL to produce modern typelib then mix it with VB6-compatible types.

[fafalone]

Do you mean just using MKTYPLIB for the unavoidable redefinitions then midl for everything else? and then combine them? Yes it's a possibility... but I'm pretty sure twinBASIC will support exporting typelibs very soon now (and not via midl compilation), at which point I can just export it all from my tbShellLib version. At this point I'm probably going to wait for that, because even if I could compile oleexp in midl, it would be a **ton** of work to go back and fix everywhere I didn't preserve the types and just put 'long' instead of the proper type and a typedef. I did that once already, it took weeks.

[fafalone]

Ok that took a lot longer than I thought since mfidl.idl was 15k lines to get through, and I still need to do IID and GUID generation work before a final public release, but here's a test version with the ITypeInfo bug fixed and the new MF interfaces.

[fafalone]

Project Updated - Version 5.4

NOTE: The Beta version posted last night contained bugs in several interfaces and types.

The final release also includes the extensive set of GUIDs for the Media Foundation interfaces (in addition to the regular interface IIDs).

Changelog:
(oleexp 5.4 - Released 09 February 2023)

• Added DXGI and DirectComposition interfaces
  
• Substantially expanded included Media Foundation interfaces. This includes all the related GUIDs defined in mfidl.idl, in DirectX.bas, in addition to the interface IIDs.
  
• (Bug fix) IMFMediaTypes had ByVal UDTs
  
• (Bug fix) IShellWindows had member with VARIANT instead of VARIANT_BOOL.
  
• (Bug fix) ITypeInfo had the wrong GUID, which is incredible as it's been wrong since the original olelib.

[fafalone]

Project Updated - Version 5.5

Since a few people are working on typelib-related stuff right now I wanted to release a fix for a major bug immediately: ICreateTypeLib2 incorrectly inherited from IUnknown instead of ICreateTypeLib (another in the category of 'unnoticed for 20+ years' lol). Also added a few basic COM interfaces from oaidl.idl.

• Added objidl.idl interfaces IAdviseSink2, IClientSecurity, IServerSecurity, IMallocSpy, IClassActivator, IProgressNotify, IStdMarshalInfo, IExternalConnection and IThumbnailExtractor (w/coclass ThumbnailFCNHandler).
• Added undocmented hardware enum interfaces/coclasses.
• Bug fix: ICreateTypeLib2 incorrectly extended IUnknown instead of ICreateTypeLib.

These updates have also been applied to tbShellLib v2.9.85.

[georgekar]

Can You make a IDispatch2
which have this alternative functions:

rgszNames not as string
Function GetIDsOfNames(riid As IID, rgszNames As Long, cNames As Long, lcid As Long, rgDispId As Long) As Long

pVarResult as variant
Function Invoke(dispIdMember As Long, riid As IID, lcid As Long, wFlags As Integer, pDispParams As DISPPARAMS, pVarResult, pExcepInfo As EXCEPINFO, puArgErr As Long) As Long

reason:
1) You can't invoke a method using named arguments, because you can't pass an array of long values (the pointers to BSTR) in GetIDsOfNames to get an array from pointer rgDispId.

2) Invoke may return an UDT and that goes to pVarResult if it is Variant.

I use this and works nice for me:

// Generated .IDL file (by the OLE/COM Object Viewer)
// 
// typelib filename: IDispatch.tlb


[
  uuid(54BC8460-C769-11D2-8350-444553540004),
  version(2.0),
  helpstring("IDispatch Interface - Eduardo Morcillo - changed for M2000 Interperter")
]
library IDispatch
{


    // TLib :     // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
    importlib("stdole2.tlb");


typedef struct {                
long Data1;
                
short Data2;
                
short Data3;
                
unsigned char Data4[8];
    } IID;
    typedef struct {
        [helpstring("Parameters")        
]
        long rgPointerToVariantArray;
        [helpstring("Named parameters")        
]
        long rgPointerToDISPIDNamedArgs;
        [helpstring("Parameter count")        
]
        long cArgs;
        [helpstring("Named parameter count")        
]
        long cNamedArgs;
    } DISPPARAMS;
  
    typedef struct {
        [helpstring("Error number")        
]
        short wCode;
                
short wReserved;
        [helpstring("Source")        
]
        long StrPtrSource;
        [helpstring("Description")        
]
        long StrPtrDescription;
        [helpstring("Help file")        
]
        long StrPtrHelpFile;
        [helpstring("Help context")        
]
        long dwHelpContext;
                
long pvReserved;
        [helpstring("HRESULT (__stdcall *pfnDeferredFillIn)(struct EXCEPINFO *);")        
]
        long pfnDeferredFillIn;
                
long scode;
    } EXCEPINFO;


    typedef [helpstring("InvokeFlags")]
    enum {
        DISPATCH_METHOD = 1,
        DISPATCH_PROPERTYGET = 2,
        DISPATCH_PROPERTYPUT = 4,
        DISPATCH_PROPERTYPUTREF = 8
    } InvokeFlags;


    typedef [helpstring("IDispatch::Invoke HRESULTs")]
    enum {
        DISP_E_UNKNOWNINTERFACE = -2147352575,
        DISP_E_MEMBERNOTFOUND = -2147352573,
        DISP_E_PARAMNOTFOUND = -2147352572,
        DISP_E_TYPEMISMATCH = -2147352571,
        DISP_E_UNKNOWNNAME = -2147352570,
        DISP_E_NONAMEDARGS = -2147352569,
        DISP_E_BADVARTYPE = -2147352568,
        DISP_E_EXCEPTION = -2147352567,
        DISP_E_OVERFLOW = -2147352566,
        DISP_E_BADINDEX = -2147352565,
        DISP_E_UNKNOWNLCID = -2147352564,
        DISP_E_ARRAYISLOCKED = -2147352563,
        DISP_E_BADPARAMCOUNT = -2147352562,
        DISP_E_PARAMNOTOPTIONAL = -2147352561,
        DISP_E_BADCALLEE = -2147352560,
        DISP_E_NOTACOLLECTION = -2147352559,
        DISP_E_DIVBYZERO = -2147352558
    } InvokeResults;


    typedef [helpstring("Standard DISPIDs")]
    enum {
        DISPID_AUTOSIZE = -500,
        DISPID_BACKCOLOR = -501,
        DISPID_BACKSTYLE = -502,
        DISPID_BORDERCOLOR = -503,
        DISPID_BORDERSTYLE = -504,
        DISPID_BORDERWIDTH = -505,
        DISPID_DRAWMODE = -507,
        DISPID_DRAWSTYLE = -508,
        DISPID_DRAWWIDTH = -509,
        DISPID_FILLCOLOR = -510,
        DISPID_FILLSTYLE = -511,
        DISPID_FONT = -512,
        DISPID_FORECOLOR = -513,
        DISPID_ENABLED = -514,
        DISPID_HWND = -515,
        DISPID_TABSTOP = -516,
        DISPID_TEXT = -517,
        DISPID_CAPTION = -518,
        DISPID_BORDERVISIBLE = -519,
        DISPID_APPEARANCE = -520,
        DISPID_MOUSEPOINTER = -521,
        DISPID_MOUSEICON = -522,
        DISPID_PICTURE = -523,
        DISPID_VALID = -524,
        DISPID_READYSTATE = -525,
        DISPID_LISTINDEX = -526,
        DISPID_SELECTED = -527,
        DISPID_LIST = -528,
        DISPID_COLUMN = -529,
        DISPID_LISTCOUNT = -531,
        DISPID_MULTISELECT = -532,
        DISPID_MAXLENGTH = -533,
        DISPID_PASSWORDCHAR = -534,
        DISPID_SCROLLBARS = -535,
        DISPID_WORDWRAP = -536,
        DISPID_MULTILINE = -537,
        DISPID_NUMBEROFROWS = -538,
        DISPID_NUMBEROFCOLUMNS = -539,
        DISPID_DISPLAYSTYLE = -540,
        DISPID_GROUPNAME = -541,
        DISPID_IMEMODE = -542,
        DISPID_ACCELERATOR = -543,
        DISPID_ENTERKEYBEHAVIOR = -544,
        DISPID_TABKEYBEHAVIOR = -545,
        DISPID_SELTEXT = -546,
        DISPID_SELSTART = -547,
        DISPID_SELLENGTH = -548,
        DISPID_REFRESH = -550,
        DISPID_DOCLICK = -551,
        DISPID_ABOUTBOX = -552,
        DISPID_ADDITEM = -553,
        DISPID_CLEAR = -554,
        DISPID_REMOVEITEM = -555,
        DISPID_CLICK = -600,
        DISPID_DBLCLICK = -601,
        DISPID_KEYDOWN = -602,
        DISPID_KEYPRESS = -603,
        DISPID_KEYUP = -604,
        DISPID_MOUSEDOWN = -605,
        DISPID_MOUSEMOVE = -606,
        DISPID_MOUSEUP = -607,
        DISPID_ERROREVENT = -608,
        DISPID_READYSTATECHANGE = -609,
        DISPID_CLICK_VALUE = -610,
        DISPID_RIGHTTOLEFT = -611,
        DISPID_TOPTOBOTTOM = -612,
        DISPID_NAME = -800,
        DISPID_DELETE = -801,
        DISPID_OBJECT = -802,
        DISPID_PARENT = -803
    } STANDARD_DISPIDS;


    typedef enum {
        DISPID_AMBIENT_BACKCOLOR = -701,
        DISPID_AMBIENT_DISPLAYNAME = -702,
        DISPID_AMBIENT_FONT = -703,
        DISPID_AMBIENT_FORECOLOR = -704,
        DISPID_AMBIENT_LOCALEID = -705,
        DISPID_AMBIENT_MESSAGEREFLECT = -706,
        DISPID_AMBIENT_SCALEUNITS = -707,
        DISPID_AMBIENT_TEXTALIGN = -708,
        DISPID_AMBIENT_USERMODE = -709,
        DISPID_AMBIENT_UIDEAD = -710,
        DISPID_AMBIENT_SHOWGRABHANDLES = -711,
        DISPID_AMBIENT_SHOWHATCHING = -712,
        DISPID_AMBIENT_DISPLAYASDEFAULT = -713,
        DISPID_AMBIENT_SUPPORTSMNEMONICS = -714,
        DISPID_AMBIENT_AUTOCLIP = -715,
        DISPID_AMBIENT_APPEARANCE = -716,
        DISPID_AMBIENT_PALETTE = -726,
        DISPID_AMBIENT_TRANSFERPRIORITY = -728,
        DISPID_AMBIENT_RIGHTTOLEFT = -732,
        DISPID_AMBIENT_TOPTOBOTTOM = -733
    } AMBIENT_DISPIDS;


    typedef enum {
        DISPID_FONT_NAME = 0,
        DISPID_FONT_SIZE = 2,
        DISPID_FONT_BOLD = 3,
        DISPID_FONT_ITALIC = 4,
        DISPID_FONT_UNDER = 5,
        DISPID_FONT_STRIKE = 6,
        DISPID_FONT_WEIGHT = 7,
        DISPID_FONT_CHARSET = 8,
        DISPID_PICT_HANDLE = 0,
        DISPID_PICT_HPAL = 2,
        DISPID_PICT_TYPE = 3,
        DISPID_PICT_WIDTH = 4,
        DISPID_PICT_HEIGHT = 5,
        DISPID_PICT_RENDER = 6
    } OLEOBJECTS_DISPIDS;


    interface IDispatchM2000;
    [
      odl,
      uuid(00020400-0000-0000-C000-000000000046),
      helpstring("IDispatch Interface")
    ]
    interface IDispatchM2000: IUnknown {
        long _stdcall GetTypeInfoCount([out] long* pctinfo);
        long _stdcall GetTypeInfo(
                        [in] long iTInfo, 
                        [in] long lcid, 
                        [out] long* ppTInfo);
        long _stdcall GetIDsOfNames(
                        [in] IID* riid, 
                        [in] long *rgszNames, 
                        [in] long cNames,
                        [in] long lcid, 
                        [in, out] long *rgDispId);
        long _stdcall Invoke(
                        [in] long dispIdMember, 
                        [in] IID* riid, 
                        [in] long lcid, 
                        [in] short wFlags, 
                        [in, out] DISPPARAMS* pDispParams, 
                        [out] VARIANT* pVarResult, 
                        [out] EXCEPINFO* pExcepInfo, 
                        [out] long* puArgErr);
    };
};

[fafalone]

Why wouldn't you be able to pass the named arguments as strings?

It should accept arrays... since the number of elements is specified by cNames and "as string" is just passing a pointer to a string anyway, you should be able to pass stringarray(0) and it will get all of them... at least, this is how it works for interfaces, longs/integers/bytes, and UDTs, though I haven't specifically tried that setup with strings.

With Invoke, you'd pass VarPtr(variant), which is equivalent to passing ByRef variant. But yes that doesn't match the official definition so should have been different.

But sure I can put your alternate version into the next release... I'll mark it hidden so as not to confuse but IDispatchM2000 will be there (all this does is prevent it from showing up in the object browser, you can use it as normal, it's the 'restricted' attribute that interferes with normal use).

[georgekar]

Thanks

[fafalone]

So there's a bunch of incorrectly formatted GUIDs and PROPERTYKEYs in mDirectX.bas... I'm in the middle of finishing D2D now so am going to post a corrected version of just that module and wait to update the main release...


Edit: Attachment removed; new public release has fixes applied.

---

@georgekar, IDispatchM2000 will have to go in oleexpimp.tlb because MKTYPLIB doesn't allow two interfaces with the same GUID.

[georgekar]

Why wouldn't you be able to pass the named arguments as strings?

This is a part of code before the invoke (at iDispatch). I have to pass the names of the named arguments in reverse order, but at 0 has to be the name of the function. So I pass the myptr(0) (by reference) so I pass the pointer of the first element of the array. But I am thinking that I didn't use Varptr(pargs2(0)), on OLEEXP, so maybe you are right. Anyway I have to pass the names in reverse order, so a long array is more preferable, because only the strptr need to copy there in the right order.

            ReDim myptr(0 To fixnamearg)
            myptr(0) = StrPtr(pstrProcName)
            For lngLoop = fixnamearg To 1 Step -1
            myptr(fixnamearg - lngLoop + 1) = StrPtr(pargs2(lngLoop))
            Next lngLoop
                ReDim varDISPID(0 To fixnamearg)
            lngRet = IDsp.GetIDsOfNames(riid, myptr(0), fixnamearg + 1, Clid, varDISPID(0))
            dispid = varDISPID(0)

[fafalone]

Project Updated - Version 5.6

This version adds all missing Direct2D interfaces/types/enums/GUIDs, adds all Direct3D 11 and 12 interfaces/types/enums/GUIDs, and corrects the bugs in mDirectX.bas.

PLEASE NOTE: ADDON MODULES NOW DISTRIBUTED SEPARATELY.
Download oleexp-modules.zip for mIID.bas, mPKEY.bas, mCoreAudio.bas, mWIC.bas, mDirectShow.bas, mPortableDevices.bas, and mDirectX.bas.
This is due to the attachment size limit now being exceeded if they're all in the same zip with oleexp.tlb.

By request of georgekar, an alternative version of IDispatch, IDispatchM2000, is available in oleexpimp.tlb (it's not Implements-compatible but MKTYPLIB doesn't let you put two interfaces with the same GUID in one TLB).

These changes have also been applied to tbShellLib v3.0.10.

[mozaiktm]

Hi, fafalone.

Thanks for sharing this great type libray.

Currently, I'm trying to convert a source code for AeroWizards from C++ to VB6, but I'm facing some issues here. Some members of PROPSHEETPAGE, like hblWatermark, pszHeaderTitle, pszHeaderSubTitle, are missing from your type library. Some Type also seems to be missing, like PROPSHEETHEADER.

I don't know if it would cause error if I keep going without these stuff, so I'm putting a hold on it. Could you add them in the future update? I'll gladly help you if you need it.

Have a great day. Thank you.

[fafalone]

With a UDT, you don't strictly have to use the TLB version, you can declare alternates locally because vb6 support declaring UDTs (and api calls).

But the situation here is the PROPSHEETPAGE in oleexp dates from the Win2k/XP-era original olelib this project was forked from, and the members you mentioned were only added in Windows Vista. I actually added the more recent versions to tbShellLib, but it looks like I didn't also add them to oleexp. I'll put them in the next version, along with the header.

In the mean time you can add them to your project in VB6:

Public Type PROPSHEETPAGE_V2
	dwSize As Long
    dwFlags As PSP_FLAGS
    hInstance As LongPtr
    pResource As LongPtr
    hIcon As LongPtr
    pszTitle As LongPtr
    pfnDlgProc As LongPtr
    lParam As LongPtr
    pfnCallback As LongPtr
    pcRefParent As LongPtr
    pszHeaderTitle As LongPtr
    pszHeaderSubTitle As LongPtr
End Type
Public Type PROPSHEETPAGE_V3
	dwSize As Long
    dwFlags As PSP_FLAGS
    hInstance As LongPtr
    pResource As LongPtr
    hIcon As LongPtr
    pszTitle As LongPtr
    pfnDlgProc As LongPtr
    lParam As LongPtr
    pfnCallback As LongPtr
    pcRefParent As LongPtr
    pszHeaderTitle As LongPtr
    pszHeaderSubTitle As LongPtr
    hActCtx As LongPtr
End Type
Public Type PROPSHEETPAGE_V4
	dwSize As Long
    dwFlags As PSP_FLAGS
    hInstance As LongPtr
    pResource As LongPtr
    hIcon As LongPtr
    pszTitle As LongPtr
    pfnDlgProc As LongPtr
    lParam As LongPtr
    pfnCallback As LongPtr
    pcRefParent As LongPtr
    pszHeaderTitle As LongPtr
    pszHeaderSubTitle As LongPtr
    hActCtx As LongPtr
    bmHeader As LongPtr
End Type


Public Type PROPSHEETHEADER
    dwSize As Long
    dwFlags as PropSheetHeaderFlags
    hwndParent as LongPtr
    hInstance as LongPtr
    hIcon as LongPtr
    pszCaption as LongPtr
    nPages as Long
    nStartPage as LongPtr
    ppsp as LongPtr
End Type
public Type PROPSHEETHEADER_V2
    dwSize as Long
    dwFlags as PropSheetHeaderFlags
    hwndParent as LongPtr
    hInstance as LongPtr
    hIcon as LongPtr
    pszCaption as LongPtr
    nPages as Long
    nStartPage as LongPtr
    ppsp as LongPtr
    hbmWatermark as LongPtr
    hplWatermark as LongPtr
    hbmHeader as LongPtr
End Type
Public Enum PropSheetHeaderFlags
	PSH_DEFAULT = &H00000000
	PSH_PROPTITLE = &H00000001
	PSH_USEHICON = &H00000002
	PSH_USEICONID = &H00000004
	PSH_PROPSHEETPAGE = &H00000008
	PSH_WIZARDHASFINISH = &H00000010
	PSH_WIZARD = &H00000020
	PSH_USEPSTARTPAGE = &H00000040
	PSH_NOAPPLYNOW = &H00000080
	PSH_USECALLBACK = &H00000100
	PSH_HASHELP = &H00000200
	PSH_MODELESS = &H00000400
	PSH_RTLREADING = &H00000800
	PSH_WIZARDCONTEXTHELP = &H00001000
' ----- New flags for wizard97 -----------
	PSH_WIZARD97 = &H01000000
	PSH_WATERMARK = &H00008000&
	PSH_USEHBMWATERMARK = &H00010000  ' user pass in a hbmWatermark instead of pszbmWatermark
	PSH_USEHPLWATERMARK = &H00020000  '
	PSH_STRETCHWATERMARK = &H00040000  ' stretchwatermark also applies for the header
	PSH_HEADER = &H00080000&
	PSH_USEHBMHEADER = &H00100000
	PSH_USEPAGELANG = &H00200000  ' use frame dialog template matched to page
	PSH_WIZARD_LITE = &H00400000
	PSH_NOCONTEXTHELP = &H02000000
	PSH_AEROWIZARD = &H00004000
	PSH_RESIZABLE = &H04000000
	PSH_HEADERBITMAP = &H08000000
	PSH_NOMARGIN = &H10000000
End Enum

Then use them with these local APIs instead of the TLB-defined APIs (which are currently hard-coded for the original):

Public Declare Function CreatePropertySheetPage Lib "comctl32" Alias "CreatePropertySheetPageA" (psp As Any) As Long
Public Declare Function CreatePropertySheetPageW Lib "comctl32" (psp As Any) As Long
Public Declare Function DestroyPropertySheetPage Lib "comctl32" (ByVal hPage As Long) As Long
Public Declare Function PropertySheet Lib "comctl32" Alias "PropertySheetA" (psh As Any) As Long
Public Declare Function PropertySheetW Lib "comctl32" (psh As Any) As Long

PS- There's an error I just found with PSN_QUERYINITIALFOCUS and PSN_TRANSLATEACCELERATOR; the correct values are:

	PSN_TRANSLATEACCELERATOR = (-212)
	PSN_QUERYINITIALFOCUS = (-213)

[Elroy]

FYI, I couldn't get oleexp.StringFromGUID2 going. I just called StringFromGUID2 directly to get it going. Here's the code I couldn't make work:

Private Function GetStringGuid() As String
    Dim uGuid As oleexp.UUID
    oleexp.CoCreateGuid uGuid
    GetStringGuid = Space$(38&)
    Call oleexp.StringFromGUID2(uGuid, ByVal StrPtr(GetStringGuid), 39&)
    GetStringGuid = Mid$(GetStringGuid, 2&, 36&)
End Function

Further FYI, it does return 39 (number of characters it "thinks" it returned, including null terminator) but it just returns spaces.

If I declare the following ...

Private Declare Function StringFromGUID2 Lib "ole32" (g As Any, ByVal lpsz As Long, ByVal cchMax As Long) As Long

... and then remove the "oleexp." from the call, all works fine.

[fafalone]

Yeah I've had trouble with that too...

    [entry("StringFromGUID2")]
    LONG StringFromGUID2(
        [in] UUID *UUID,
        [in, out] LPWSTR lplpsz,
        [in] LONG cbMax);

I'll just change it to Long for the next release, since VB obviously has some issue with the LPWSTR argument (even though it's used elsewhere and works).

I actually had trouble with the VB6 declares too, and wound up writing my own routine for it:

    Private Function GUIDToString(tg As UUID, Optional bBrack As Boolean = True) As String
    'StringFromGUID2 never works, even "working" code from vbaccelerator AND MSDN
    GUIDToString = Right$("00000000" & Hex$(tg.Data1), 8) & "-" & Right$("0000" & Hex$(tg.Data2), 4) & "-" & Right$("0000" & Hex$(tg.Data3), 4) & _
    "-" & Right$("00" & Hex$(CLng(tg.Data4(0))), 2) & Right$("00" & Hex$(CLng(tg.Data4(1))), 2) & "-" & Right$("00" & Hex$(CLng(tg.Data4(2))), 2) & _
    Right$("00" & Hex$(CLng(tg.Data4(3))), 2) & Right$("00" & Hex$(CLng(tg.Data4(4))), 2) & Right$("00" & Hex$(CLng(tg.Data4(5))), 2) & _
    Right$("00" & Hex$(CLng(tg.Data4(6))), 2) & Right$("00" & Hex$(CLng(tg.Data4(7))), 2)
    If bBrack Then GUIDToString = "{" & GUIDToString & "}"
    End Function

[mozaiktm]

Thanks for the help.

There's still some things missing, but I want to focus on converting the thing I'm working on. And, oh, I'm looking forward to the next update.

Have a great day. Thank you.

To be honest, I feet like I should say more, but I don't know what to say... Sorry.

[fafalone]

What's missing? I went through the SDK headers for the propsheet stuff, I think I got it all. Or do you mean other things? If it's interfaces needed I definitely want to know; but it's not meant to be a comprehensive api set; the apis are only for things directly related to the interfaces since they can be declared in VB (and interfaces can't).

[fafalone]

Major Update - oleexp Version 6.0

This version of oleexp adds the full set of Microsoft Speech APIs v5.4 (both automation and standard interface sets), and the full set of WebView2 interfaces, for those who'd like to pursue their own wrappers. Also included fixes for the issues mentioned above with missing PROPSHEET UDTs and StringFromGUID2 not working, and some miscellaneous interfaces.

These features have also been added to tbShellLib for twinBASIC.

Full changelog:

(oleexp 6.0 - Released 26 February 2023)

• Added WebView2 interfaces/types/enums.
• Added Microsoft Speech APIs Version 5.4
• Added IHttpNegotiate3, IObjectProvider, IEnumObjects, and IIOCancelInformation interfaces.
• Added Vista+ PROPSHEETPAGE and PROPSHEETHEADER versions of these structs (use PROPSHEETPAGE_V4 and PROPSHEETHEADER_V2 on Vista+) and PropSheet/PropSheetW APIs. Also corrected wrong values for PSN_TRANSLATEACCELERATOR/PSN_QUERYINITIALFOCUS.
• (Bug fix) StringFromGUID2 now uses a Long instead of LPWSTR since the latter was not working.

Also please take note of the different file structure of the zips-- I had to rearrange things because of the attachment size limit again. oleexp60.zip contains only oleexp.tlb; oleexpimp.tlb and history.txt are now in oleexp60-2.zip along with all the addon modules (including a new mSpeech.bas for the Speech APIs).

Edit: Forgot to add, there's a few WebView2 interfaces with members documented as Property Get/Let that have been changed to regular functions and renamed. This is because the Get returns a UDT ByRef, but the Let expects it ByVal, which VB6 doesn't support, so it had to be rewritten to pass the members individually, and MKTYPLIB doesn't support having different arguments for same-named Get/Let combos.

These are:

ICoreWebView2Controller::Bounds->get_Bounds() As RECT, put_Bounds(left, top, right, bottom)

ICoreWebView2PointerInfo::PointerDeviceRect->get_PointerDeviceRect() As RECT, put_PointerDeviceRect(left, top, right, bottom)
ICoreWebView2PointerInfo::DisplayRect->get_DisplayRect() As RECT, put_DisplayRect(left, top, right, bottom)
ICoreWebView2PointerInfo::PixelLocation->get_PixelLocation() As POINT, put_PixelLocation(x, y)
ICoreWebView2PointerInfo::HimetricLocation->get_HimetricLocation() As POINT, put_HimetricLocation(x, y)
ICoreWebView2PointerInfo::PixelLocationRaw->get_PixelLocationRaw() As POINT, put_PixelLocationRaw(x, y)
ICoreWebView2PointerInfo::HimetricLocationRaw->get_HimetricLocationRaw() As POINT, put_HimetricLocationRaw(x, y)
ICoreWebView2PointerInfo::TouchContact->get_TouchContact() As RECT, put_TouchContact(left, top, right, bottom)
ICoreWebView2PointerInfo::TouchContactRaw->get_TouchContactRaw() As RECT, put_TouchContactRaw(left, top, right, bottom)

[LeandroA]

Hi Fafalone, I am looking at the possibility of moving from d2dvb.tlb to oleexp.tlb, D2DVB is excellent and very comfortable, but I am not sure if TheTrick will continue to update it, I do not know if you have thought at some point to implement the d2D1EFFECTS , try through My part of TLB but all my attempts were in vain (**** Midl **** Mktyplib). Frank Schüler gave me an excellent example of D2D1Effects no TLB, but I couldn't agree with d2DVB.TLB

Well my first question because I am mistake 13 in this

'Oleexp v5.6

Option Explicit
Private Declare Function GetMem8 Lib "msvbvm60" (ByRef pSrc As Any, ByRef pDst As Any) As Long
           
Dim cFactory As ID2D1Factory
                         
Private Sub Form_Load()
   
  Set cFactory = DWriteCreateFactory(DWRITE_FACTORY_TYPE_SHARED, IID_IDWriteFactory)
End Sub

Private Function IID_IDWriteFactory() As UUID
    GetMem8 543017151384793.4554@, IID_IDWriteFactory
    GetMem8 524995195940339.1138@, ByVal VarPtr(IID_IDWriteFactory) + 8
End Function

[fafalone]

ID2D1Effect is present... I believe I got all of the Direct2D interfaces, if one is missing let me know. I started by merging The trick's tlb, so for what was in that the syntax should be identical except I had to remove optional attribs since mktyplib doesn't allow them.

[LeandroA]

oh perfect I had not seen it!
I have a question, I'm having problems in this line, vb6 crash
Set cMemTarget = cFactory.CreateWicBitmapRenderTarget(cWICBitmap, tRTP)

looking and comparing both tlb there is an extra * in the first parameter (target).

D2DVB.tlb
    HRESULT _stdcall CreateWicBitmapRenderTarget(
                        [in] void target, 
                        [in] D2D1_RENDER_TARGET_PROPERTIES* renderTargetProperties, 
                        [out, retval] ID2D1RenderTarget** renderTarget);

oleexp.tlb
    HRESULT _stdcall CreateWicBitmapRenderTarget(
        [in] void* target,
        [in] D2D1_RENDER_TARGET_PROPERTIES* renderTargetProperties,
        [out, retval] ID2D1RenderTarget** renderTarget);

I tried passing it varptr(cWICBitmap) or byval varptr(cWICBitmap) , but no result

[fafalone]

I believe since it's an object you should jut pass cWICBitmap or ByVal ObjPtr(cWICBitmap).

Does this line work with the other TLB?

[LeandroA]

uff if you are right, I had tried with objptr but surely I missed the byval.

I've finished exporting all the functions and everything is working ok, now I'm going to play with the effects. Thank you!!

[LeandroA]

Sorry for the twists and turns, I just realized that the font is not taking me (CreateTextFormat), I have already tried different ways but I do not have the correct result, the FontFamillyName parameter is vbLong, so I am passing strptr(sName) , one way to check it is with GetFontFamilyNameLength which if I pass as Font "Arial" should return 5 but any font that I pass always returns 2 (or 4 in case I am passing a pointer stored in a long variable)

Option Explicit
Private Declare Function GetMem8 Lib "msvbvm60" (ByRef pSrc As Any, ByRef pDst As Any) As Long
                         
Dim cDWFactory              As IDWriteFactory
Dim cTextFormat             As IDWriteTextFormat


Private Sub Form_Load()
    Set cDWFactory = DWriteCreateFactory(DWRITE_FACTORY_TYPE_SHARED, IID_IDWriteFactory)

    Dim sFontName As String '* 32
    Dim ptr As Long
    
    sFontName = "Arial"
    'ptr = StrPtr(sFontName)

    Set cTextFormat = cDWFactory.CreateTextFormat(StrPtr(sFontName), Nothing, _
                DWRITE_FONT_WEIGHT_NORMAL, _
                DWRITE_FONT_STYLE_NORMAL, _
                DWRITE_FONT_STRETCH_NORMAL, _
                Me.FontSize * 96# / 72#, 0&)
                                        
    MsgBox cTextFormat.GetFontFamilyNameLength  '& vbCrLf & Len(sFontName)
    

End Sub

Public Function IID_IDWriteFactory() As UUID
    GetMem8 543017151384793.4554@, IID_IDWriteFactory
    GetMem8 524995195940339.1138@, ByVal VarPtr(IID_IDWriteFactory) + 8
End Function

The last parameter LocaleName also has an error if I pass any value, but well, this doesn't seem to be necessary to call it.

[VanGoghGaming]

sFontName should not be a string but an array of integers (0 to 31). Then you would use "lstrcpy" to write the Font Name:

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal pszDst As Long, ByVal pszSrc As String) As Long
Dim sFontName(0 to 31) as Integer
lstrcpy VarPtr(sFaceName(0)), "Arial"

Then try passing VarPtr(sFaceName(0)) to cDWFactory.CreateTextFormat and see how it goes.

[LeandroA]

sFontName should not be a string but an array of integers (0 to 31). Then you would use "lstrcpy" to write the Font Name:

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal pszDst As Long, ByVal pszSrc As String) As Long
Dim sFontName(0 to 31) as Integer
lstrcpy VarPtr(sFaceName(0)), "Arial"

Then try passing VarPtr(sFaceName(0)) to cDWFactory.CreateTextFormat and see how it goes.

No, it does not work. :/

    Dim sFaceName(0 To 31) As Byte
    lstrcpy VarPtr(sFaceName(0)), "Arial"

    Set cTextFormat = cDWFactory.CreateTextFormat(VarPtr(sFaceName(0)), Nothing, _
                DWRITE_FONT_WEIGHT_NORMAL, _
                DWRITE_FONT_STYLE_NORMAL, _
                DWRITE_FONT_STRETCH_NORMAL, _
                Me.FontSize * 96# / 72#, 0&)
                                        
    MsgBox cTextFormat.GetFontFamilyNameLength

[The trick]

LeandroA, do my examples work?

' // DirectWrite basic drawing example

Option Explicit

Dim cD2dFactory As ID2D1Factory
Dim cDWFactory  As IDWriteFactory
Dim cTarget     As ID2D1HwndRenderTarget
Dim cTextFormat As IDWriteTextFormat
Dim cBrush      As ID2D1Brush

Private Sub Form_Load()
    
    Set cD2dFactory = D2D1.CreateFactory
    
    Set cTarget = cD2dFactory.CreateHwndRenderTarget(D2D1.RenderTargetProperties( _
                                    D2D1.PixelFormat(DXGI_FORMAT_B8G8R8A8_UNORM)), _
                                    D2D1.HwndRenderTargetProperties(Me.hWnd, D2D1.SizeU))
    
    Set cDWFactory = DW.CreateFactory(DWRITE_FACTORY_TYPE_SHARED)
    
    ' // Create text format
    Set cTextFormat = cDWFactory.CreateTextFormat("Arial", Nothing, DWRITE_FONT_WEIGHT_NORMAL, _
                                    DWRITE_FONT_STYLE_NORMAL, DWRITE_FONT_STRETCH_NORMAL, _
                                    19# * 96# / 72#, "en-US")
                                    
    ' // Color brush
    Set cBrush = cTarget.CreateSolidColorBrush(D2D1.ColorF(Red), ByVal 0&)
                                    
End Sub

Private Sub Form_Paint()
    Dim sText   As String
    
    sText = "Hello World!"
    
    cTarget.BeginDraw
    
    cTarget.Clear D2D1.ColorF(Ivory)
    
    cTarget.DrawText sText, Len(sText), ByVal cTextFormat, D2D1.RectF(20, 20, 220, 120), cBrush

    cTarget.EndDraw ByVal 0&, ByVal 0&
    
End Sub

Private Sub Form_Resize()
    cTarget.Resize D2D1.SizeU(Me.ScaleWidth, Me.ScaleHeight)
End Sub

    ' // Create WIC bitmap that is saved to file
    Set cBitmap = cWicFactory.CreateBitmap(Me.ScaleWidth, Me.ScaleHeight, _
                                           WIC.GUID_WICPixelFormat32bppPBGRA, WICBitmapCacheOnLoad)

    ' // Create render target based on that image
    Set cBitmapSurf = cFactory.CreateWicBitmapRenderTarget(cBitmap, D2D1.RenderTargetProperties( _
                        D2D1.PixelFormat(DXGI_FORMAT_B8G8R8A8_UNORM, D2D1_ALPHA_MODE_PREMULTIPLIED), _
                        D2D1_RENDER_TARGET_TYPE_SOFTWARE, 96, 96, D2D1_RENDER_TARGET_USAGE_GDI_COMPATIBLE))
    
    DrawButtons cBitmapSurf

If you need something about d2dvb.tlb or dwvb.tlb you can write to the related thread.

[LeandroA]

LeandroA, do my examples work?

Hi TheTrick, d2dvb.tlb and dwvb.tlb works correctly, but as I mentioned above I'm migrating to oleexp.tlb, because I want to use ID2D1Effect , the problem I'm in now is the CreateTextFormat function (Oleexp), its parameters are not vbstrings but vblong and not I manage to make it work

[fafalone]

Hmm looks like I might have the declare incorrect. If VB lets you, ByVal StrPtr for now, I'll fix in next version.

Original is

_In_z_ WCHAR const* fontFamilyName,

so should be [in] long instead of [in, out] long*

It was a massive project so I used some automated code formatting, must have missed that in manual review.

Edit: Attached is a test version where that (and all other DWrite instances of [in, out] long* where it's _In_z_ WCHAR const*) is now [in] long (ByVal Long) which should work with just StrPtr.

[LeandroA]

Edit: Attached is a test version where that (and all other DWrite instances of [in, out] long* where it's _In_z_ WCHAR const*) is now [in] long (ByVal Long) which should work with just StrPtr.

Error 5

    Set cTextFormat = cDWFactory.CreateTextFormat(StrPtr("Arial"), Nothing, _
                DWRITE_FONT_WEIGHT_NORMAL, _
                DWRITE_FONT_STYLE_NORMAL, _
                DWRITE_FONT_STRETCH_NORMAL, _
                Me.FontSize * 96# / 72#, 0&)

thank you for your good predisposition

[VanGoghGaming]

Have you declared "lstrcpy" with Alias "lstrcpyW"? The declaration already present in "oleexp" is the ANSI version "lstrcpyA" which is no good... I was hoping it would be the same as the ".szFaceName" member of the "CHARFORMAT2" type which is an array of integers and I got it working correctly with "lstrcpy".

[fafalone]

Sorry about that, looks like one of the saves didn't take and the * was still there when I reloaded it. It's definitely gone from this one, double checked in oleview.

[LeandroA]

Sorry about that, looks like one of the saves didn't take and the * was still there when I reloaded it. It's definitely gone from this one, double checked in oleview.

thank you very much Fafalone, now it works fine. One more request, I'm not in a hurry but when I release another update I could implement QueryInterface to ID2D1RenderTarget

thank!

[fafalone]

Normally you don't need QI directly; the VB Set statement is a wrapper for it, so

Dim rt As ID2D1RenderTarget
Dim de As ID2D1Effect

Set rt = de

is the same as calling de.QueryInterface(IID_ID2D1RenderTarget, rt)

That said, if you still want to, the way to do it is first cast to the unrestricted IUnknown in oleexp:

Dim pUnk As oleexp.IUnknown
Dim hr As Long

Set pUnk = de

hr = pUnk.QueryInterface(...)