CWindow Release Candidate 17
Incorporates the new GDI+ and ODBC classes.
The help file documents these classes and provides code snippets for most GDI+ methods.
In CWindow, add the following lines
' // Don't allow negative values for the styles
IF dwStyle = -1 THEN dwStyle = 0
IF dwExStyle = -1 THEN dwExStyle = 0
before
' // Make sure that the control has the WS_CHILD style
dwStyle = dwStyle OR WS_CHILD
' // Create the control
hCtl = .CreateWindowExW(dwExStyle, wsClassName, wszTitle, dwStyle, x * m_rx, y * m_ry, nWidth * m_rx, nHeight * m_ry, _
hParent, CAST(HMENU, CAST(LONG_PTR, cID)), m_hInstance, CAST(LPVOID, lpParam))
IF hCtl = NULL THEN EXIT FUNCTION
I changed the default value from 0 to -1 because Paul needed to pass 0 for a ownerdraw control and this causes CreatWindowExW to fail if these values remain as -1, for example when trying to create an instance of an user control.
I have no idea, but looks useless. How is going another language to create instances of the classes and call its methods? This is not a binary standard like COM, but a proprietary system.
I have implemented an OLE Container using classes and virtual methods. I have got it working, at least with the WebBrowser control, that is the one for which I have more interest. I will add some bells ans whistles, like support for licensed controls and register free activation of ActiveX controls.
I plan to write a WebBrowser wrapper class to take full advantage of this powerful control, that can be used for html, images, graphics, videos, and a lot of things more.
I also have plans for other classes such ADO and WinHTTP. We already have a powerful framework. When Paul will finish his editor, we can launch the first official version.
Wow, that's impressive! I didn't realize that you were going to work on the OLE container. Awesome.
I have 16 issues left to resolve before I upload the new editor source code. :)
Got it!
For the WebBrowser control, we need to do:
DIM pOleCon AS COleCon PTR = NEW COleCon(@pWindow, 1001, "Shell.Explorer", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight - 20)
DIM pWb AS IWebBrowser2 PTR = cast(IWebBrowser2 PTR, pOleCon->OcxDispPtr)
DIM vUrl AS VARIANT
vUrl.vt = VT_BSTR
vUrl.bstrVal = SysAllocString("http://www.planetsquires.com/protect/forum/index.php")
DIM hr AS HRESULT = pWb->lpvtbl->Navigate2(pWb, @vUrl, NULL, NULL, NULL, NULL)
VariantClear @vurl
But I want to write a WebBrowser class to avoid the use of variants and, above all, to implement the IDocHostUIHandler interface, that allows to set a flag to make it DPI aware. Prevously, I used an optical zoom, that is deprecated.
Before James ask why I haven't declared the methods of the interfaces as private to avoid bloat, it is not possible because the functions aren't called by the FB code, but by the hosted ActiveX control, and FB has no way to know which ones will be called. If some are removed and the OCX calls them, it will crash.
I also have achieved to embed an old VB6 control, the MonthView Calendar, implemented in the licensed ActiveX MSCOMCT2.OCX, using a registration free technique that, unlike the one posted by a FB user, does not require the use of a manifest.
' ########################################################################################
' Microsoft Windows
' Contents: Embedded MonthView Calendar OCX
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define UNICODE
'#define _OC_DEBUG_ 1
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/COleCon/COleCon.inc"
USING Afx
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
CoInitialize NULL
' // Set process DPI aware
' // The recommended way is to use a manifest file
AfxSetProcessDPIAware
' // Creates the main window
DIM pWindow AS CWindow
' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
pWindow.Create(NULL, "COleCon - Embedded MonthView Calendar OCX", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(580, 360)
' // Centers the window
pWindow.Center
DIM wszLibName AS WSTRING * 260 = ExePath & "\MSCOMCT2.OCX"
DIM CLSID_MSComCtl2_MonthView AS CLSID = (&h232E456A, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
DIM IID_MSComCtl2_MonthView AS CLSID = (&h232E4565, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
DIM RTLKEY_MSCOMCT2 AS WSTRING * 260 = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
DIM pOleCon AS COleCon PTR = NEW COleCon(@pWindow, 1001, wszLibName, CLSID_MSComCtl2_MonthView, _
IID_MSComCtl2_MonthView, RTLKEY_MSCOMCT2, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
IF pOleCon THEN Delete pOleCon
CoUnInitialize
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_CREATE
' // If you want to create controls in WM_CREATE instead of in WinMain, you can
' // retrieve a pointer of the class with AfxCWindowPtr(lParam). Use hwnd as the
' // handle of the window instead of pWindow->hWindow or omitting this parameter
' // because CWindow doesn't know the value of this handle until the WM_CREATE
' // message has been processed.
' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close", 350, 250, 75, 23)
' // An alternative is no pass the value of the main window handle to CWindow with
' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' pWindow->hWindow = hwnd
' IF pWindow THEN pWindow->AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Optional resizing code
IF wParam <> SIZE_MINIMIZED THEN
' // Retrieve a pointer to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
' // Move the position of the button
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, 1001), _
0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
END IF
CASE WM_DESTROY
' // Ends the application by sending a WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Funny that they have localized the names of the months, but not "Today".
Quote from: John Spikowski on August 19, 2016, 02:59:28 AM
QuoteWhen Paul will finish his editor, we can launch the first official version.
Will this be a fork of the original FreeBASIC project?
It is in addition to the current WinFBE that already exists in GitHub. That version has a classic kind of editor interface whereas the one I am working on now uses a more modern and clean interface. Both do the same thing: edit and compile code.
Quote
Will FireFly ever be made open source?
No, I already answered this exact same question for you. http://www.planetsquires.com/protect/forum/index.php?topic=3496.msg29128#msg29128
Once the editor project is completed, I would like to get back at the grid control project. That is a key control that a lot of projects need. In combination with Jose's classes, the FB tool chain will be quite strong at that point.
This is a personal project in which nobody else is collaborating. I always use "Freeware" in all the code that I publish, and never "Open Source".
"Freeware is proprietary software that is available for use at no monetary cost. In other words, freeware may be used without payment but may usually not be modified, re-distributed or reverse-engineered without the author's permission."
Just because the source code is avilable doesn't mean that the followers of the Open Source movement can seize it.
Jose,
How about COM a demo we can try?
Maybe Fred's Grid control?
James
Jose,
Even though I don't do 32bit any more, I found the 32bit ocx and it worked fine with Fb32.
James
It would require to prepare headers first and all that.
BTW to make it easier to use I have added the following changes:
Initialize the COM library when the constructors are called.
' // Initialize the COM library
DIM hr AS HRESULT = OleInitialize(NULL)
IF hr = S_OK OR hr = S_FALSE THEN m_bUninitOLE = TRUE
Uninitialize it when the class is destroyed.
IF m_bUninitOLE THEN OleUninitialize
Multiple calls to CoInitialize or OleInitialize are allowed as long as each call to the initialize function is paired with a call to the uninitialize function.
I'm using OleInitialize instead of CoInitialize because OleInitialize adds the following functionality:
- Clipboard
- Drag and Drop
- Object linking and embedding (OLE)
- In-place activation
OleInitialize specifies the concurrency model as single-thread apartment (STA).
Quote from: James Fuller on August 19, 2016, 02:37:51 PM
Jose,
Even though I don't do 32bit any more, I found the 32bit ocx and it worked fine with Fb32.
James
I have chosen it because it could try it without having to prepare headers first. I don't want to try the other VB6 controls because they're 32-bit only and it is too much work to prepare the headers.
With the changes, instead of
DIM wszLibName AS WSTRING * 260 = ExePath & "\MSCOMCT2.OCX"
DIM CLSID_MSComCtl2_MonthView AS CLSID = (&h232E456A, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
DIM IID_MSComCtl2_MonthView AS CLSID = (&h232E4565, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
DIM RTLKEY_MSCOMCT2 AS WSTRING * 260 = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
DIM pOleCon AS COleCon PTR = NEW COleCon(@pWindow, 1001, wszLibName, CLSID_MSComCtl2_MonthView, _
IID_MSComCtl2_MonthView, RTLKEY_MSCOMCT2)
DIM pOleCon2 AS COleCon PTR = NEW COleCon(@pWindow, 1002, wszLibName, CLSID_MSComCtl2_MonthView, _
IID_MSComCtl2_MonthView, RTLKEY_MSCOMCT2)
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
IF pOleCon THEN Delete pOleCon
IF pOleCon2 THEN Delete pOleCon2
CoUnInitialize
we can use
DIM wszLibName AS WSTRING * 260 = ExePath & "\MSCOMCT2.OCX"
DIM CLSID_MSComCtl2_MonthView AS CLSID = (&h232E456A, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
DIM IID_MSComCtl2_MonthView AS CLSID = (&h232E4565, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
DIM RTLKEY_MSCOMCT2 AS WSTRING * 260 = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
DIM pOleCon AS COleCon = COleCon(@pWindow, 1001, wszLibName, CLSID_MSComCtl2_MonthView, _
IID_MSComCtl2_MonthView, RTLKEY_MSCOMCT2)
DIM pOleCon2 AS COleCon = COleCon(@pWindow, 1002, wszLibName, CLSID_MSComCtl2_MonthView, _
IID_MSComCtl2_MonthView, RTLKEY_MSCOMCT2)
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
> I tried the embedded calendar control example and all I get is the base window with the title and the client area blank. I didn't get any errors with the compile. The MSCOMCT2.OCX is resident on my Windows 7 32 bit OS.
If the OCX is registered, you only need to pass the ProgID. The example that I have posted is for embedding unregistered OCXs.
> Does this mean we are not permitted to fix bugs or enhance the libraries?
If you make changes, keep them private. If you still don't know what Freeware means, please do a Google search. It is almost the opposite to Open Source.
> Here is a C# .NET date picker compiled as a COM control
Mine is embedded in the application and yours not. The purpose of an OLE Container is to embed the control, not to launch another application that hosts it.
A new class. CFileSys.inc. Provides many useful methods to work with files and folders.
DECLARE FUNCTION DriveLetters () AS CBSTR
DECLARE FUNCTION DriveExists (BYREF cbsDrive AS CBSTR) AS BOOLEAN
DECLARE FUNCTION FileExists (BYREF cbsFileSpec AS CBSTR) AS BOOLEAN
DECLARE FUNCTION FolderExists (BYREF cbsFileSpec AS CBSTR) AS BOOLEAN
DECLARE FUNCTION IsDriveReady (BYREF cbsDrive AS CBSTR) AS BOOLEAN
DECLARE FUNCTION GetDriveName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFolderName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFileName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
DECLARE FUNCTION GetExtensionName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
DECLARE FUNCTION GetBaseName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
DECLARE FUNCTION GetAbsolutePathName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
DECLARE FUNCTION GetTempName () AS CBSTR
DECLARE FUNCTION GetDriveShareName (BYREF cbsDrive AS CBSTR) AS CBSTR
DECLARE FUNCTION GetDriveFileSystem (BYREF cbsDrive AS CBSTR) AS CBSTR
DECLARE FUNCTION GetDriveType (BYREF cbsDrive AS CBSTR) AS DRIVETYPECONST
DECLARE FUNCTION GetFolderType (BYREF cbsFolder AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFileType (BYREF cbsFile AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFileVersion (BYREF cbsFileName AS CBSTR) AS CBSTR
DECLARE FUNCTION GetParentFolderName (BYREF cbsFolder AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFolderShortPath (BYREF cbsFolder AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFolderShortName (BYREF cbsFolder AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFolderDriveLetter (BYREF cbsFolder AS CBSTR) AS CBSTR
DECLARE FUNCTION SetFolderName (BYREF cbsFolder AS CBSTR, BYREF cbsName AS CBSTR) AS HRESULT
DECLARE FUNCTION BuildPath (BYREF cbsPath AS CBSTR, BYREF cbsName AS CBSTR) AS CBSTR
DECLARE FUNCTION GetSerialNumber (BYREF cbsDrive AS CBSTR) AS LONG
DECLARE FUNCTION GetVolumeName (BYREF cbsDrive AS CBSTR) AS CBSTR
DECLARE FUNCTION SetVolumeName (BYREF cbsDrive AS CBSTR, BYREF cbsName AS CBSTR) AS HRESULT
DECLARE FUNCTION GetNumDrives () AS LONG
DECLARE FUNCTION GetNumSubFolders (BYREF cbsFolder AS CBSTR) AS LONG
DECLARE FUNCTION GetNumFiles (BYREF cbsFolder AS CBSTR) AS LONG
DECLARE FUNCTION IsRootFolder (BYREF cbsFolder AS CBSTR) AS BOOLEAN
DECLARE FUNCTION GetStandardStream (BYVAL StandardStreamType AS STANDARDSTREAMTYPES, BYVAL bUnicode AS VARIANT_BOOL = FALSE) AS Afx_ITextStream PTR
DECLARE FUNCTION GetFileSize (BYREF cbsFile AS CBSTR) AS LONG
DECLARE FUNCTION SetFileName (BYREF cbsFile AS CBSTR, BYREF cbsName AS CBSTR) AS HRESULT
DECLARE FUNCTION GetFileShortPath (BYREF cbsFile AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFileShortName (BYREF cbsFile AS CBSTR) AS CBSTR
DECLARE FUNCTION GetFileAttributes (BYREF cbsFile AS CBSTR) AS FILEATTRIBUTE
DECLARE FUNCTION SetFileAttributes (BYREF cbsFile AS CBSTR, BYVAL lAttr AS FILEATTRIBUTE) AS HRESULT
DECLARE FUNCTION GetFileDateCreated (BYREF cbsFile AS CBSTR) AS DATE_
DECLARE FUNCTION GetFileDateLastModified (BYREF cbsFile AS CBSTR) AS DATE_
DECLARE FUNCTION GetFileDateLastAccessed (BYREF cbsFile AS CBSTR) AS DATE_
DECLARE FUNCTION GetFolderSize (BYREF cbsFolder AS CBSTR) AS LONG
DECLARE FUNCTION GetFolderAttributes (BYREF cbsFolder AS CBSTR) AS FILEATTRIBUTE
DECLARE FUNCTION SetFolderAttributes (BYREF cbsFolder AS CBSTR, BYVAL lAttr AS FILEATTRIBUTE) AS HRESULT
DECLARE FUNCTION GetFolderDateCreated (BYREF cbsFolder AS CBSTR) AS DATE_
DECLARE FUNCTION GetFolderDateLastModified (BYREF cbsFolder AS CBSTR) AS DATE_
DECLARE FUNCTION GetFolderDateLastAccessed (BYREF cbsFolder AS CBSTR) AS DATE_
DECLARE FUNCTION GetDriveAvailableSpace (BYREF cbsDrive AS CBSTR) AS DOUBLE
DECLARE FUNCTION GetDriveFreeSpace (BYREF cbsDrive AS CBSTR) AS DOUBLE
DECLARE FUNCTION GetDriveTotalSize (BYREF cbsDrive AS CBSTR) AS DOUBLE
DECLARE FUNCTION CreateFolder (BYREF cbsFolder AS CBSTR) AS Afx_IFolder PTR
DECLARE FUNCTION DeleteFolder (BYREF cbsFolder AS CBSTR, BYVAL bForce AS VARIANT_BOOL = FALSE) AS HRESULT
DECLARE FUNCTION MoveFolder (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR) AS HRESULT
DECLARE FUNCTION CopyFolder (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR, BYVAL OverWriteFiles AS VARIANT_BOOL = -1) AS HRESULT
DECLARE FUNCTION CopyFile (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR, BYVAL OverWriteFiles AS VARIANT_BOOL = -1) AS HRESULT
DECLARE FUNCTION DeleteFile (BYREF cbsFileSpec AS CBSTR, BYVAL bForce AS VARIANT_BOOL = FALSE) AS HRESULT
DECLARE FUNCTION MoveFile (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR) AS HRESULT
Jose
Thanks again for sharing your code, its always very efficient and professionnal.
I've noticed something missing: in the help file you are showing COM procedures ( under AfxCOM.inc )
i wanted to use the following one
FUNCTION AfxGuid (BYVAL pwszGuidText AS WSTRING PTR = NULL) AS GUID
but did not find that .inc file , probably you prepared the help file for future adding .
I've done some modifications on your code
' ########################################################################################
' Microsoft Windows
' Contents: Embedded MonthView Calendar OCX
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define UNICODE
'#define _OC_DEBUG_ 1
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/COleCon/COleCon.inc"
USING Afx
DECLARE FUNCTION WinMain(BYVAL hInstance AS HINSTANCE , _
BYVAL hPrevInstance AS HINSTANCE , _
BYVAL szCmdLine AS ZSTRING PTR , _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL) , NULL , COMMAND() , SW_NORMAL)
DECLARE FUNCTION WndProc(BYVAL hwnd AS HWND , BYVAL uMsg AS UINT , BYVAL wParam AS WPARAM , BYVAL lParam AS LPARAM) AS LRESULT
private function GUID_From_Str(BYREF lpsz AS CWSTR) as GUID
dim temp as GUID = (0 , 0 , 0 ,{0 , 0 , 0 , 0 , 0 , 0 , 0 , 0})
if len(lpsz) <> 38 then return(temp)
CLSIDFromString(lpsz , @temp)
return(temp)
end function
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain(BYVAL hInstance AS HINSTANCE , _
BYVAL hPrevInstance AS HINSTANCE , _
BYVAL szCmdLine AS ZSTRING PTR , _
BYVAL nCmdShow AS LONG) AS LONG
'CoInitialize NULL
' // Set process DPI aware
' // The recommended way is to use a manifest file
AfxSetProcessDPIAware
' // Creates the main window
DIM pWindow AS CWindow
' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
pWindow.Create(NULL , "COleCon - Embedded regfree MonthView Calendar OCX" , @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(1124 , 360)
' // Centers the window
'DIM wszLibName AS WSTRING * 260 = ExePath & "\MSCOMCT2.OCX"
DIM wszLibName AS cwstr = ExePath & "\MSCOMCT2.OCX"
'DIM CLSID_MSComCtl2_MonthView AS CLSID = (&h232E456A , &h87C3 , &h11D1 ,{&h8B , &hE3 , &h00 , &h00 , &hF8 , &h75 , &h4D , &hA1})
DIM CLSID_MSComCtl2_MonthView AS CLSID = GUID_from_str ( "{232E456A-87C3-11D1-8BE3-0000F8754DA1}")
'DIM IID_MSComCtl2_MonthView AS CLSID = (&h232E4565 , &h87C3 , &h11D1 ,{&h8B , &hE3 , &h00 , &h00 , &hF8 , &h75 , &h4D , &hA1})
DIM IID_MSComCtl2_MonthView AS IID = GUID_from_str( "{232E4565-87C3-11D1-8BE3-0000F8754DA1}")
'DIM RTLKEY_MSCOMCT2 AS WSTRING * 260 = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
'DIM RTLKEY_MSCOMCT2 AS CWSTR = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
'DIM RTLKEY_MSCOMCT2 AS CWSTR = ""
DIM pOleCon AS COleCon = COleCon(@pWindow , 1001 , wszLibName , CLSID_MSComCtl2_MonthView , _
IID_MSComCtl2_MonthView , RTLKEY_MSCOMCT2 )
FUNCTION = pWindow.DoEvents(nCmdShow)
'IF pOleCon THEN Delete pOleCon
'CoUnInitialize
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc(BYVAL hwnd AS HWND , BYVAL uMsg AS UINT , BYVAL wParam AS WPARAM , BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_CREATE
' // If you want to create controls in WM_CREATE instead of in WinMain, you can
' // retrieve a pointer of the class with AfxCWindowPtr(lParam). Use hwnd as the
' // handle of the window instead of pWindow->hWindow or omitting this parameter
' // because CWindow doesn't know the value of this handle until the WM_CREATE
' // message has been processed.
' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close", 350, 250, 75, 23)
' // An alternative is no pass the value of the main window handle to CWindow with
' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' pWindow->hWindow = hwnd
' IF pWindow THEN pWindow->AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd , WM_CLOSE , 0 , 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Optional resizing code
IF wParam <> SIZE_MINIMIZED THEN
' // Retrieve a pointer to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
' // Move the position of the button
IF pWindow THEN pWindow -> MoveWindow GetDlgItem(hwnd , 1001) , _
0 , 0 , pWindow -> ClientWidth , pWindow -> ClientHeight , CTRUE
END IF
CASE WM_DESTROY
' // Ends the application by sending a WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd , uMsg , wParam , lParam)
END FUNCTION
' ========================================================================================
I do not like to use the Guid members directly, i think it is easier to use via strings (not evident to remember the type structure)
that is why i wanted to use AfxGuid function , so i've done an equivalent one
GUID_From_Str(BYREF lpsz AS CWSTR) as GUID
and i've also generalized the use of dynamic unicode string too.
Last point, i've noticed your code works even whith RTLKEY_MSCOMCT2 ="", even if MSCOMCT2.OCX is not registered
Marc
I have not included AfxCom.inc because it just contais a few functions. I still don't know what I will do with the variants and propvariants. There is an essential library, propvarutil, that is missing in the FB headers.
> Last point, i've noticed your code works even whith RTLKEY_MSCOMCT2 ="", even if MSCOMCT2.OCX is not registered
Maybe this control doesn't care about it. I think that what the VB6 ide used was a design-time license key, but I never have used VB6, so I don't know all the details. Essentially, without that design-time license key the OCX will run when the application created an instance of it in a non-licensed computer, but you could not create an instance of it in the VB ide. There were third-party OCXs that required the use of a license key at runtime, besides having a design-time license key to work with the VB6 ide.
In fact, I'm not interested in OCXs, except the WebBrowser control. I even thought to make a lightweight container tailored for it, which requires the implementation of only a few interfaces and adds less bloat. Maybe I will make some code conditional if an use web browser define is used.
> and i've also generalized the use of dynamic unicode string too.
In a function like that, it doesn't matter, but avoid to use CWSTR or WSTRING with COM methods that expect a BSTR. Use CBSTR instead.
A good thing of my framework is that it is written in pure FB code, without resorting to C++ or third party libraries. This provides good learning stuff and demonstrates that FB is a capable compiler.
I have added Advise and Unadvise methods to the OLE Container to connect events.
thank's for the AfxCOM.inc
Quoteavoid to use CWSTR or WSTRING with COM methods that expect a BSTR. Use CBSTR instead.
yes, understood , my only concern is avoiding as much as possible the use of Wstring *, to cwstr as general unicode string
QuoteI have added Advise and Unadvise methods to the OLE Container to connect events.
nice ! :) could you post your code , i will test it immediatly.
one question, what's the advantage/difference of using your ole container compared with atl container ?
I understand it is not necessary to have atl.dll but that dll (or other version) is always part of windows system.
Jose
" I have added Advise and Unadvise methods to the OLE Container to connect events."
i wanted to say: could you post a sample usage of that methods
Quote
one question, what's the advantage/difference of using your ole container compared with atl container ?
I understand it is not necessary to have atl.dll but that dll (or other version) is always part of windows system.
The one that comes pre-installed is very old and does not work very well. Version 80 works better (probably other versions too, but this is the one that I have tested), but you have to make sure that the user has the version that you're using installed.
There is also the question of being able to do it using FB alone without the usual workaround of using another language or a third party control. After all, I'm doing it to see what I can do with this compiler.
This is a preliminary test to connect to the events fired by the WebBrowser control. Next I want to implement the IDocHostUIHandler interface to make the embedded browser DPI aware by returning the DOCHOSTUIFLAG_DPI_AWARE flag in the GetHostInfo method.
' ########################################################################################
' Microsoft Windows
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define UNICODE
#define _OC_DEBUG_ 1
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "win/exdisp.bi"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "Afx/AfxCom.inc"
#INCLUDE ONCE "Afx/COleCon/COleCon.inc"
USING Afx
' TODO: A class template, CWebBrowser, that will create the OLE Container with an
' embedded browser and connect events.
' If is DPI aware and the caller doesn't tell that he is going to implement a custom
' IDocHostUIHandler interface, create an instance of our own.
' Address to pass the Invoke messages
'extern DIID_DWebBrowserEvents2 as const IID
TYPE CWebBrowserEventsImpl EXTENDS Afx_IDispatch
DECLARE VIRTUAL FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION AddRef () AS ULONG
DECLARE VIRTUAL FUNCTION Release () AS ULONG
DECLARE VIRTUAL FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
DECLARE CONSTRUCTOR
DECLARE DESTRUCTOR
m_pIDocHostUIHandler AS ANY PTR
END TYPE
' ========================================================================================
CONSTRUCTOR CWebBrowserEventsImpl
' Create an instance of the IDocHostUIHandler class
' m_pIDocHostUIHandler = NEW CIDocHostUIHandler
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
DESTRUCTOR CWebBrowserEventsImpl
' Delete the IDocHostUIHandler class
' IF m_pIDocHostUIHandler THEN Delete m_pIDocHostUIHandler
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObj AS LPVOID PTR) AS HRESULT
OC_DP("CWebBrowserEventsImpl QueryInterface")
IF ppvObj = NULL THEN RETURN E_INVALIDARG
IF IsEqualIID(riid, @DIID_DWebBrowserEvents2) THEN
*ppvObj = @this
' // Not really needed, since this is not a COM object
cast(Afx_IUnknown PTR, *ppvObj)->AddRef
END IF
RETURN S_OK
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.AddRef () AS ULONG
OC_DP("CWebBrowserEventsImpl AddRef")
RETURN 1
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.Release () AS DWORD
OC_DP("CWebBrowserEventsImpl Release")
RETURN 1
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.GetTypeInfoCount (BYVAL pctInfo AS UINT PTR) AS HRESULT
OC_DP("CWebBrowserEventsImpl GetTypeInfoCount")
*pctInfo = 0
RETURN E_NOTIMPL
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
OC_DP("CWebBrowserEventsImpl GetTypeInfo")
RETURN E_NOTIMPL
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
OC_DP("CWebBrowserEventsImpl GetIDsOfNames")
RETURN E_NOTIMPL
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION CWebBrowserEventsImpl.Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
OC_DP("CWebBrowserEventsImpl Invoke dispid = " & WSTR(dispIdMember))
' DISPID 102 - StatusTextChange
' DISPID 104 - DownloadComplete
' DISPID 105 - CommandStateChange
' DISPID 106 - DownloadBegin
' DISPID 108 - ProgressChange
' DISPID 112 - PropertyChange
' DISPID 113 - TitleChange
' DISPID 225 - PrintTemplateInstantiation
' DISPID 226 - PrintTemplateTeardown
' DISPID 227 - UpdatePageStatus (not implemented)
' DISPID 250 - BeforeNavigate2
' DISPID 251 - NewWindow2
' DISPID 252 - NavigateComplete2
' DISPID 253 - OnQuit
' DISPID 254 - OnVisible
' DISPID 255 - OnToolBar
' DISPID 256 - OnMenuBar
' DISPID 257 - OnStatusBar
' DISPID 258 - OnFullScreen
' DISPID 260 - OnTheaterMode
' DISPID 262 - WindowSetResizable
' DISPID 264 - WindowSetLeft
' DISPID 265 - WindowSetTop
' DISPID 266 - WindowSetWidth
' DISPID 267 - WindowSetHeight
' DISPID 263 - WindowClosing
' DISPID 268 - ClientToHostWindow
' DISPID 269 - SetSecureLockIcon
' DISPID 270 - FileDownload
' DISPID 271 - NavigateError
' DISPID 272 - PrivacyImpactedStateChange
' DISPID 273 - NewWindow3
' DISPID 282 - SetPhishingFilterStatus
' DISPID 283 - WindowStateChanged
' =====================================================================================
' DISPID 259 - DocumentComplete
' Fires when a document is completely loaded and initialized.
' =====================================================================================
' METHOD DocumentComplete <259> (BYVAL pDisp AS IDispatch, BYREF vURL AS VARIANT)
SELECT CASE dispIdMember
CASE 259 ' // DocumentComplete
' // After the MSHTML document has been loaded we retrieve a reference to its
' // ICustomDoc interface and give him a pointer to our IDocHostUIHandler interface
' // to allow for customization.
'DIM pIWebBrowser2 AS IWebBrowser2 PTR = cast(IWebBrowser2 PTR, pDisp)
' // Get a reference to the active document
'DIM pIHTMLDocument2 AS IHTMLDocument2 PTR
'pIWebBrowser2->get_Document(@pIHTMLDocument2)
' // Get a reference to the CustomDoc interface
' pICustomDoc = pIHTMLDocument2
' IF ISNOTHING(pICustomDoc) THEN EXIT METHOD
'DIM pICustomDoc AS ICustomDoc PTR
'pIHTMLDocument2->QueryInterface(@IID_ICustomDoc, @pICustomDoc)
''pIHTMLDocument2->QueryInterface(cast(IID PTR, @IID_ICustomDoc), @pICustomDoc)
' // Set our IDocHostUIHandler interface for MSHTML
' // MSHTML will release its previous IDocHostUIHandler interface
' // (if one is present) and call pDocHostUIHandler's AddRef method.
' Create an instance of the Afx_IDocHostUIHandler class in the constructor method
' of the WebBrowser events class and destroy it in the destructor method.
'IF pIDocHostUIHandler THEN pICustomDoc->SetUIHandler(pIDocHostUIHandler)
END SELECT
RETURN S_OK
END FUNCTION
' ========================================================================================
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
' // The recommended way is to use a manifest file
AfxSetProcessDPIAware
' // Creates the main window
DIM pWindow AS CWindow
' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
pWindow.Create(NULL, "COleCon - Embedded WebBrowser control", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(700, 450)
' // Centers the window
pWindow.Center
' // Add a status bar
DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", , 1002)
' // Set the parts
DIM rgParts(1 TO 2) AS LONG = {pWindow.ScaleX(160), -1}
IF StatusBar_SetParts(hStatusBar, 2, @rgParts(1)) THEN
StatusBar_Simple(hStatusBar, FALSE)
END IF
DIM pOleCon AS COleCon PTR = NEW COleCon(@pWindow, 1001, "Shell.Explorer", _
0, 0, pWindow.ClientWidth, pWindow.ClientHeight - 20)
DIM pEvtObj AS CWebBrowserEventsImpl PTR = NEW CWebBrowserEventsImpl
pOleCon->Advise(pEvtObj, DIID_DWebBrowserEvents2)
DIM pWb AS IWebBrowser2 PTR = cast(IWebBrowser2 PTR, pOleCon->OcxDispPtr)
IF pWb THEN
DIM vUrl AS VARIANT
vUrl.vt = VT_BSTR
' vUrl.bstrVal = SysAllocString("https://forum.powerbasic.com/")
' vUrl.bstrVal = SysAllocString("http://www.freebasic.net/forum/")
vUrl.bstrVal = SysAllocString("http://www.planetsquires.com/protect/forum/index.php")
DIM hr AS HRESULT = pWb->lpvtbl->Navigate2(pWb, @vUrl, NULL, NULL, NULL, NULL)
VariantClear @vurl
END IF
SetFocus GetDlgItem(pWindow.hWindow, 1001)
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
pOleCon->Unadvise ' // Call it before deleting the events class
IF pEvtObj THEN Delete pEvtObj
IF pOleCon THEN Delete pOleCon
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_CREATE
' // If you want to create controls in WM_CREATE instead of in WinMain, you can
' // retrieve a pointer of the class with AfxCWindowPtr(lParam). Use hwnd as the
' // handle of the window instead of pWindow->hWindow or omitting this parameter
' // because CWindow doesn't know the value of this handle until the WM_CREATE
' // message has been processed.
' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close", 350, 250, 75, 23)
' // An alternative is no pass the value of the main window handle to CWindow with
' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
' pWindow->hWindow = hwnd
' IF pWindow THEN pWindow->AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Optional resizing code
IF wParam <> SIZE_MINIMIZED THEN
' // Retrieve a pointer to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
' // Move the position of the button
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, 1001), _
0, 0, pWindow->ClientWidth, pWindow->ClientHeight - 20, CTRUE
END IF
CASE WM_DESTROY
' // Ends the application by sending a WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Quote
GUID_From_Str(BYREF lpsz AS CWSTR) as GUID
and i've also generalized the use of dynamic unicode string too.
I prefer to no force anybody to use my code exclusively unless needed.
IF you change you function to
GUID_From_Str(BYREF lpsz AS WSTRING) as GUID
it will work both with WSTRINGs and CWSTRs.
DIM cws AS CWSTR = "{232E456A-87C3-11D1-8BE3-0000F8754DA1}"
DIM g AS GUID = GUID_From_Str(cws)
DIM wsz AS WSTRING * 40 = "{232E456A-87C3-11D1-8BE3-0000F8754DA1}"
DIM g AS GUID = GUID_From_Str(wsz)
and also with CBSTR
DIM cws AS CWSTR = "{232E456A-87C3-11D1-8BE3-0000F8754DA1}"
DIM g AS GUID = GUID_From_Str(cws)
It will also work as you have declared it, but doing so you're forcing the inclusion of the CWSTR class.
I finally have managed to tame the beast: WebBrowser events and implementation of the IDocHostUIHandler interface. Another bug in the FB libraries has driven me crazy. The linker failed and you don't have the means of knowing why. It happens that extern IID_ICustomDoc is broken.
I have modified the COleCon.Forward message. Now we can navigate through the elements of a web page using the TAB key.
The linker fails when compiling it with the 64-bit compiler. Probably yet another bug in the FB Windows libraries.
Can't find were the problem is. Does anybody know if there are problems with virtual functions in 64-bit?
Another problem with the WebBrowser conttrol is that Microsoft, in its infinite wisdom, makes IE 7 the default-rendering mode for all applications that use the WB control. And to change this behavior, you have to add the application name to the registry key HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION.
The OLE Container works with the 64-bit compiler. What I'm having problems are with the events.
Got it! I just needed to change EXTENDS Afx_IDocHostUIHandler2 to EXTENDS Afx_IUnknown.
Because it worked with 32 bit, it made me thing, wrongly, that the problem was elsewhere, and I only have tried this after discarding anything else. Such is life!
Regarding the problem of compatibility, for the examples that I will do, using my own html code, I will use a meta tag:
<meta http-equiv=â€X-UA-Compatible†content=â€IE=edgeâ€>.
If somebody wants to do a browser, be aware of the compatibility problem and don't blame me if some web pages aren't rendered correctly.
The following article discusses the question:
Controlling WebBrowser Control Compatibility
https://blogs.msdn.microsoft.com/patricka/2015/01/12/controlling-webbrowser-control-compatibility/
Jose
here my evolution of your olecon.inc
I wanted to be able to know wich cId is making the event ( interresting when using more than 1 component ...)
so i put a dummy class type to be generic to be able to transmit the value of the cID when advise is done
'dummy event type to mimic the event Afx_IDispatch to put the cID in event class
TYPE Dummy_Events
dummy as integer
m_cID as integer = -1
END TYPE
I've checked the m_cID is 4 bytes (in 32bits) after the adress of the class ( if i put it like that)
that's why dummy as integer exists in dummy_events (hope it also works in 64bits)
TYPE CWebBrowserEventsImpl EXTENDS Afx_IDispatch
DECLARE VIRTUAL FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION AddRef () AS ULONG
DECLARE VIRTUAL FUNCTION Release () AS ULONG
DECLARE VIRTUAL FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
DECLARE CONSTRUCTOR
DECLARE DESTRUCTOR
m_cID as integer = -1 '// cID of the component first position of vars
m_pIDocHostUIHandler AS ANY PTR
END TYPE
the new class TYPE COleCon
Public:
m_pData AS Afx_OleConDispatch PTR
m_bUninitOLE AS BOOLEAN
m_dwCookie AS DWORD ' // Cookie for Unadvise
m_riidEvt AS IID PTR ' // IID of the events interface
m_pEvt as Dummy_Events PTR '// dummy event to mimic the event Afx_IDispatch to put the cID in event class
cID as INTEGER = -1 '// the control ID
Ev_cID as INTEGER = -1 '// the control ID fired event ( changed by advise/unadvise)
Private:
DECLARE SUB CreateContainer (BYVAL pWindow AS CWindow PTR, BYVAL cID AS INTEGER, BYREF wszProgID AS WSTRING, _
BYREF wszLibName AS WSTRING, BYREF rclsid AS const CLSID, BYREF riid AS const IID, BYREF wszLicKey AS WSTRING, _
BYVAL x AS LONG = 0, BYVAL y AS LONG = 0, BYVAL nWidth AS LONG = 0, BYVAL nHeight AS LONG = 0, _
BYVAL dwStyle AS DWORD = 0, BYVAL dwExStyle AS DWORD = 0, BYVAL ambientFlags AS DWORD = 0)
...
the new advise function
PRIVATE FUNCTION COleCon.Advise (BYVAL pEvtObj AS IDispatch PTR, BYVAL riid AS IID PTR) AS HRESULT
OC_DP("BEGIN COlecon.Advise")
IF pEvtObj = NULL THEN RETURN E_POINTER
m_pEvt = cast(any ptr ,pEvtObj)
m_riidEvt = riid
' // Query for the IConnectionPointContainer interface
DIM pCPC AS IConnectionPointContainer PTR
DIM hr AS HRESULT = IUnknown_QueryInterface(m_pData->m_pOcx, @IID_IConnectionPointContainer, @pCPC)
IF hr <> S_OK OR pCPC = NULL THEN RETURN hr
' // Query for the IConnectionPoint interface
DIM pCP AS IConnectionPoint PTR
hr = pCPC->lpvtbl->FindConnectionPoint(pCPC, riid, @pCP)
IF hr <> S_OK OR pCP = NULL THEN
IUnknown_Release(pCPC)
RETURN hr
END IF
' // Terminates the advisory connection previously established between a connection point object and a client's sink.
IF m_dwCookie THEN hr = pCP->lpvtbl->Unadvise(pCP, m_dwCookie)
m_dwCookie = 0
' // Establishes a connection between a connection point object and the client's sink.
hr = pCP->lpvtbl->Advise(pCP, cast(IUnknown PTR, pEvtObj), @m_dwCookie)
IF pCPC THEN IUnknown_Release(pCPC)
IF pCP THEN
this.Ev_cID = this.cID
m_pEvt->m_cID = this.cID
print "Advise event : " & m_pEvt-> m_cID
IUnknown_Release(pCP)
END IF
OC_DP("END COlecon.Advise")
RETURN hr
END FUNCTION
the evolution of unadvise function
IF pCP THEN
IUnknown_Release(pCP)
this.Ev_cID = -1
END IF
a simple test is also included, must be compiled with -s console parameter ( because sleep)
I already had changed the example before going to sleep. Will add more changes if needed.
There is no need to change the Advise/Unadvise functions. Just add a new constructor to the events class:
' ########################################################################################
' CWebBrowserEventsImpl class
' Implementation of the WebBrowser events sink class
' ########################################################################################
TYPE CWebBrowserEventsImpl EXTENDS Afx_IDispatch
DECLARE VIRTUAL FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION AddRef () AS ULONG
DECLARE VIRTUAL FUNCTION Release () AS ULONG
DECLARE VIRTUAL FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
DECLARE VIRTUAL FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
DECLARE CONSTRUCTOR
DECLARE CONSTRUCTOR (BYVAL hwnd AS HWND)
DECLARE DESTRUCTOR
m_hwnd AS HWND ' // Handle of the container's window
m_pIDocHostUIHandler AS CDocHostUIHandler2Impl PTR
END TYPE
' ########################################################################################
' ========================================================================================
' Constructors
' ========================================================================================
CONSTRUCTOR CWebBrowserEventsImpl
' // Create an instance of the IDocHostUIHandler class
m_pIDocHostUIHandler = NEW CDocHostUIHandler2Impl
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CWebBrowserEventsImpl (BYVAL hwnd AS HWND)
m_hwnd = hwnd
' // Create an instance of the IDocHostUIHandler class
m_pIDocHostUIHandler = NEW CDocHostUIHandler2Impl
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' Destructor
' ========================================================================================
DESTRUCTOR CWebBrowserEventsImpl
' // Delete the IDocHostUIHandler class
IF m_pIDocHostUIHandler THEN Delete m_pIDocHostUIHandler
END DESTRUCTOR
' ========================================================================================
' // Create an instance of our CWebBrowserEventsImpl class and connect the WebBrowser events
DIM pEvtObj AS CWebBrowserEventsImpl PTR = NEW CWebBrowserEventsImpl(pOlecon->hWindow)
dim hr as hresult = pOleCon->Advise(pEvtObj, DIID_DWebBrowserEvents2)
Doing it in the events class, that you have to implement anyway, you can add as much info as you want/need and not being limited to what Advise supports.
I also have modified the ForwardMessage function:
' ========================================================================================
' Forwards the message to the control. Active in-place objects must always be given the
' first chance at translating accelerator keystrokes. You can provide this opportunity by
' calling IOleInPlaceActiveObject.TranslateAccelerator from your container's message loop
' before doing any other translation. You should apply your own translation only when this
' method returns FALSE.
' Remarks: If the control is the WebBrowser control, TranslateAccelerator calls the namesake
' method of the IDocHostUIHandler interface.
' ========================================================================================
PRIVATE FUNCTION COleCon.ForwardMessage (BYVAL pMsg AS tagMsg PTR) AS BOOLEAN
IF m_pData->m_pOcx = NULL THEN RETURN FALSE
' // See if the window with focus is the WebBrowser control
IF m_pData->m_wszProgID = "Shell.Explorer" OR m_pData->GuidText(@m_pData->m_rclsid) = "8856F961-340A-11D0-A96B-00C04FD705A2" THEN
DIM hwndFocus AS HWND = GetFocus
DIM hWin AS HWND = FindWindowEx(m_pData->m_hwnd, NULL, "Shell Embedding", "")
IF hWin THEN hWin = FindWindowEx(hWin, NULL, "Shell DocObject View", "")
IF hWin THEN hWin = FindWindowEx(hWin, NULL, "Internet Explorer_Server", "")
IF hWin <> hwndFocus THEN RETURN FALSE
ELSE
' // See if the window that has the focus is a child of our container window
DIM hWndParent AS HWND, hWndTmp AS HWND
hWndParent = GetFocus()
DO
hWndTmp = GetParent(hWndParent)
IF hWndTmp = NULL THEN EXIT DO
hWndParent = hWndTmp
IF hWndParent = m_pData->m_hwnd THEN EXIT DO
LOOP
IF hWndParent <> m_pData->m_hwnd THEN RETURN FALSE
END IF
' // Translate the message
DIM hr AS HRESULT, pActiveObject AS IOleInPlaceActiveObject PTR
hr = IUnknown_QueryInterface(m_pData->m_pOcx, @IID_IOleInPlaceActiveObject, @pActiveObject)
IF pActiveObject = NULL THEN RETURN FALSE
hr = pActiveObject->lpvtbl->TranslateAccelerator(pActiveObject, pMsg)
IUnknown_Release(pActiveObject)
IF hr = S_OK THEN RETURN TRUE
END FUNCTION
' ========================================================================================
Jose,
I've also tried with constructor (var something),it was my first idea,
but i wanted to be more automatic and why impose to define something when it can be automatized ?
My dummy type proposition can do that easily ( or other solution to write to mem var)
And as the event class is only connected after advise is done we don't care before.
in my opinion using advise/unadvise to enable/disable events is a good solution,
testing the cid var of that event class (or whatever var : hwnd if prefered) could be interresting.
advise to set the var value , unadvise to reset the var value.
a detail point in your proposal
DIM pEvtObj AS CWebBrowserEventsImpl PTR = NEW CWebBrowserEventsImpl(pOlecon->hWindow)
you probably want to do : pOlecon->m_pData->m_hwnd
and using your word " Doing it in the events class, that you have to implement anyway, you can add as much info as you want/need "
transfering m_pData is even better, to not be limited
what do you think?
Jose
My target idea is to have a generic tool as your TypeLib Browser adapted to freebasic using your Cwindow framework
to ease the job of non-expert COM as I am when needing to use activeX/OCX component.
am i dreaming ?
Today, i use the AxSuite3, my adaptation of the AxSuite2 done by Loe ( using lot of your original code ),
not perfect but quite usable.
Quote
you probably want to do : pOlecon->m_pData->m_hwnd
and using your word " Doing it in the events class, that you have to implement anyway, you can add as much info as you want/need "
transfering m_pData is even better, to not be limited
what do you think?
It was only an example. You can store whatever you wish / need.
Besides, you don't even need to add new constructors. You can access the data directly, e.g.
Instead of
DIM pEvtObj AS CWebBrowserEventsImpl PTR = NEW CWebBrowserEventsImpl(pOlecon->hWindow)
you can do
DIM pEvtObj AS CWebBrowserEventsImpl PTR = NEW CWebBrowserEventsImpl
pEvtObj->m_hwnd = pOlecon->hWindow
I also want to make the Advise and Unadvise methods standalone functions, for use with non visual OCXs.
Quote from: Marc Pons on August 26, 2016, 07:30:00 AM
Jose
My target idea is to have a generic tool as your TypeLib Browser adapted to freebasic using your Cwindow framework
to ease the job of non-expert COM as I am when needing to use activeX/OCX component.
am i dreaming ?
Today, i use the AxSuite3, my adaptation of the AxSuite2 done by Loe ( using lot of your original code ),
not perfect but quite usable.
It is a lot of work and has low priority to me, since I don't use OCXs. First I have to do other things.