CWindow Release Candidate 31

[José Roca]

And we even can have dynamic arrays of CWSTRings in a UDT!

Code Select Expand


'#CONSOLE ON
#define UNICODE
#include once "Afx/CWSTR.inc"
USING Afx

TYPE MyType
   rg(ANY) AS CWSTR
END TYPE

DIM t AS MyType
REDIM t.rg(1 TO 2) AS CWSTR

t.rg(1) = "String 1"
t.rg(2) = "String 2"

print t.rg(1)
print t.rg(2)

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

And also dynamic arrays of CVARs (Variants).

Code Select Expand


'#CONSOLE ON
#define UNICODE
#define _CVAR_DEBUG_ 1
#include once "Afx/CVAR.inc"
USING Afx

TYPE MyType
   rg(ANY) AS CVAR
END TYPE

DIM t AS MyType
REDIM t.rg(1 TO 2) AS CVAR

PRINT LBOUND(t.rg)
PRINT UBOUND(t.rg)

t.rg(1) = "String"
t.rg(2) = CVAR(12345.12)

print t.rg(1)
print t.rg(2)

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

I have added two new overloaded LET operators to allow to assign numeric values without having to use CVAR(value) when the type of the variant isn't important.

Code Select Expand


' ========================================================================================
PRIVATE OPERATOR CVar.Let (BYVAL _value AS LONGINT)
   VariantClear(@vd) : vd.vt = VT_I8   : vd.llVal = CLNGINT(_value)
END OPERATOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR CVar.Let (BYVAL _value AS DOUBLE)
   VariantClear(@vd) : vd.vt = VT_R8   : vd.dblVal = CDBL(_value)
END OPERATOR
' ========================================================================================


Not only we can have dynamic arrays of dynamic unicode strings but also dynamic arrays of variants.

[José Roca]

Updated the download file with changes to the WebBroser class and small changes to CWSTR and CVAR.

@Paul
Next time you will post an update to your editor, don't forget to update the includes, templates and projects.
Latest version always in GitHub: https://github.com/JoseRoca/WinFBX

There have been small but important changes in CWebBrowserEventsImpl.inc that I have discovered trying to modify the HTML5 YouTube player template to add processing of the NewWindow3 event to avoid the creation of a new instance of Internet Explorer if the user clicks a link.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_WB_YouTube_HTML5.fbtpl
' Contents: WebBrowser - YouTube HTML5 Player
' 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
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CVAR.inc"
#INCLUDE ONCE "Afx/CWebBrowser/CWebBrowser.inc"
USING Afx

CONST IDC_WEBBROWSER = 1001

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)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE SUB WebBrowser_NewWindow3Proc (BYVAL hwndContainer AS HWND, BYVAL ppdispVal AS IDispatch PTR PTR, _
   BYVAL pbCancel AS VARIANT_BOOL PTR, BYVAL dwFlags AS ULONG, BYVAL pwszUrlContext AS WSTRING PTR, _
   BYVAL pwszUrl AS WSTRING PTR)

' ========================================================================================
' Build the script
' Notes: For some reason, using 'height=100%' with iframe does not work as expected; the
' height attribute only works with pixel values, not percentage. As a workaround, we style
' the iframe by giving it a relative height value in viewport units (vh) instead of
' absolute pixels (style='height:100vh'). To force YouTube to use the HTML5 player
' instead of the Shockwave-Flash player, we have to add ""?html5=1'".
' ========================================================================================
FUNCTION BuildYouTubeScript (BYVAL strCode AS STRING) AS STRING

   DIM s AS STRING

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "   <title>YouTube video (HTML5 player)</title>"
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=edge' />"
   s += "   <meta http-equiv='MSThemeCompatible' content='Yes'>"
   s += "</head>"
   s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
   s += "<iframe width='100%' style='height:100vh'"
   s += " src='http://www.youtube.com/embed/" & strCode & "?html5=1'>"
   s += "</iframe>"
   s += "</body>"
   s += "</html>"

   FUNCTION = s

END FUNCTION
' ========================================================================================

' ========================================================================================
' 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)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "WebBrowser - YouTube HTML5 Player", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(750, 450)
   ' // Centers the window
   pWindow.Center

   ' // Add a WebBrowser control
   DIM pwb AS CWebBrowser = CWebBrowser(@pWindow, IDC_WEBBROWSER, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   ' // Set the IDocHostUIHandler interface
   pwb.SetUIHandler
   ' // Connect events
   pwb.Advise
   ' // Set event callback procedures
   pwb.SetEventProc("NewWindow3", @WebBrowser_NewWindow3Proc)

   ' // Build the script
   DIM strCode AS STRING = "sJFOhTBelpU"   ' --> Change me: 11 character video code
   DIM s AS STRING = BuildYouTubeScript(strCode)
   ' // Save the script as a temporary file
   DIM wszPath AS WSTRING * MAX_PATH = AfxSaveTempFile(s, "html")
   ' // Navigate to the path
   pwb.Navigate(wszPath)
   ' // Processes pending Windows messages to allow the page to load
   ' // Needed if the message pump isn't running
   AfxPumpMessages
   ' // Kill the temporary file
   KILL wszPath

   ' // Displays the window and dispatches the Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

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_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         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, IDC_WEBBROWSER), _
               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
' ========================================================================================

' ========================================================================================
' If the user clicks a link, prevent the creation of a new instance of Internet Explorer
' and display it in our embedded web browser control.
' ========================================================================================
SUB WebBrowser_NewWindow3Proc (BYVAL hwndContainer AS HWND, BYVAL ppdispVal AS IDispatch PTR PTR, _
   BYVAL pbCancel AS VARIANT_BOOL PTR, BYVAL dwFlags AS ULONG, BYVAL pwszUrlContext AS WSTRING PTR, _
   BYVAL pwszUrl AS WSTRING PTR)

   ' // Get a pointer to the hosted web browser control
   DIM pwb AS Afx_IWebBrowser2 PTR = AfxGetBrowserPtr(hwndContainer, IDC_WEBBROWSER)
   IF pwb = NULL THEN EXIT SUB
   ' // Cancel the new window creation
   *pbCancel = VARIANT_TRUE
   ' // Navigate to the page
'   DIM vUrl AS VARIANT : vUrl.vt = VT_BSTR : vUrl.bstrVal = SysAllocString(pwszUrl)
'   pwb->Navigate2(@vUrl)
'   VariantClear @vurl
   ' // Alternate way
   DIM cvUrl AS CVAR = *pwszUrl
   pwb->Navigate2(cvUrl)

END SUB
' ========================================================================================


[José Roca]

Changed a BOOLEAN to LONG in a couple of secondary functions in AfxStr.inc to make them compatible with both FBC 1.05 and FBC 1.06. I wrote them using 1.06 and 1.05 complains about mixing booleans with other data types.

Two templates have become obsolete:

CW_WB_VirtualEarthMap.fbtpl

Microsoft stopped supporting this API in Nov 2016. Now uses Bing Maps version 8.

CW_WB_YouTube.fbtpl

Google has stopped support for embedding Shockwave-Flash. Now only uses the HTML5 player. Not a loss because Shockwave was very oudated. Use the CW_WB_YouTube_HTML5.fbtpl template.

Also, the Google Maps template sometimes GPFs when the applications ends.

[José Roca]

I wrote the OLE container because I didn't know how to make web pages DPI aware with ATL. Because I had some problems with it recently, I have examined the source code for the ATL container and I have figured how to do it. It is a metter of retrieving the host interface, use it to retrieve the IAxWinAmbientDispatch interface and then call the put_DocHostFlags method.

Code Select Expand


' ========================================================================================
' Obtains a direct interface pointer to the container for a specified window (if any),
' given its handle.
' - hwnd:  A handle to the window that is hosting the control.
' Return value:
'   The IUnknown of the container of the control.
' ========================================================================================
PRIVATE FUNCTION CAtlCon.AtlHost (BYVAL hwnd AS .HWND) AS IUnknown PTR
   DIM pProc AS FUNCTION (BYVAL hwnd AS .HWND, BYREF punk AS IUnknown PTR) AS HRESULT
   pProc = cast(ANY PTR, GetProcAddress(m_hAtlLib, "AtlAxGetHost"))
   IF pProc = NULL THEN RETURN NULL
   DIM punk AS IUnknown PTR
   DIM hr AS HRESULT = pProc(hwnd, punk)
   RETURN punk
END FUNCTION
' ========================================================================================


Code Select Expand


' ========================================================================================
PRIVATE PROPERTY CAtlCon.DocHostFlags (BYVAL hwnd AS .HWND, BYVAL dwDocHostFlags AS DWORD)
   DIM AFX_IID_IAxWinAmbientDispatch_ AS GUID = (&hB6EA2051, &h048A, &h11D1, {&h82, &hB9, &h00, &hC0, &h4F, &hB9, &h94, &h2E})
   DIM pDocHost AS IUnknown PTR = this.AtlHost(hwnd)
   DIM pAmbientDisp AS Afx_IAxWinAmbientDispatch PTR
   IF pDocHost THEN
      pDocHost->lpvtbl->QueryInterface(pDocHost, @AFX_IID_IAxWinAmbientDispatch_, @pAmbientDisp)
      IF pAmbientDisp THEN
         pAmbientDisp->put_DocHostFlags(DOCHOSTUIFLAG_NO3DBORDER OR DOCHOSTUIFLAG_THEME OR DOCHOSTUIFLAG_DPI_AWARE)
         pAmbientDisp->Release
      END IF
   END IF
END PROPERTY
' ========================================================================================


I have needed to look at the source code to figure it because the MSDN documentation is very scarce and short. Just "[AtlAxGetHost] Obtains a direct interface pointer to the container for a specified window (if any), given its handle." Nothing more: no explanation of what you can do with this pointer, no examples.

I have started to write a new class, CAtlCon, that will replace COleCon and CWebBrowser. With just an instance of the class we will be able to work with many ActiveX controls at the same time. The handle of each control will differentiate them. As Atl.dll is a system component, it's use will also reduce the size of the executable.

Usage example:

Code Select Expand


   ' // Create  an instance of the CAtlCon class
   DIM pAtlCon AS CAtlCon
   ' // Add a web browser control
   DIM hWb AS HWND = pAtlCon.AddWebBrowser(@pWindow, IDC_ATLWIN)
   ' // Set the user interface capabilities of the host object
   pAtlCon.DocHostFlags(hWb) = DOCHOSTUIFLAG_NO3DBORDER OR DOCHOSTUIFLAG_THEME OR DOCHOSTUIFLAG_DPI_AWARE
   pAtlCon.WbNavigate(hWb, "https://forum.powerbasic.com/")


[Petrus Vorster]

The stuff you come up with is staggering and mind boggling.
Insanely interesting but way above my best level of understanding.

Great stuff.

[José Roca]

It is going very well. In a day or two it will be finished. Much better that the former COleCon / CWebBrowser classes. Despite the scarce documentation and the lack of examples, I have managed to learn how this ATL container works. I have written an OLE container class, CAtlCon, that wraps the ATL.DLL procedures and the customization COM interface, and a WebBrowser class, CWebCtx, that extends CAtlCon and implements wrappers for all the IWebBrowser2 interface and several of the most useful HTML interfaces. What remains to do is a class for events sink and a couple of additional wrappers for using unregistered and/or licensed ActiveX controls.

I just have finished a function to allow keyboard navigation that works perfectly. I have had problems with that during many years. One could use SendMessage to send an special message to the control in the message pump, but it was impractical if you use several controls. Besides, once the focus was caught by a web page, there was not way to exit from it using the tab key. Now it works seamless and honoring the z order.

Code Select Expand


' ========================================================================================
' Forwards the message to the control. Active in-place objects must always be given the
' first chance at translating accelerator keystrokes.
' Usage example:
'   ' // Dispatch Windows messages
'   DIM uMsg AS MSG
'   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
'      IF AtlForwardMessage(GetFocus, @uMsg) = FALSE THEN
'         IF IsDialogMessageW(hWndMain, @uMsg) = 0 THEN
'            TranslateMessage(@uMsg)
'            DispatchMessageW(@uMsg)
'         END IF
'      END IF
'   WEND
' Note: WM_FORWARDMSG = &H37F ' (895)
' ========================================================================================
PRIVATE FUNCTION AtlForwardMessage (BYVAL hctl AS HWND, BYVAL pMsg AS tagMsg PTR) AS BOOLEAN
   IF (pMsg->message < WM_KEYFIRST OR pMsg->message > WM_KEYLAST) AND _
      (pMsg->message < WM_MOUSEFIRST OR pMsg->message > WM_MOUSELAST) THEN RETURN FALSE
   DIM hwnd AS HWND = hctl
   DIM wszClassName AS WSTRING * 260
   WHILE (GetWindowLongPtrW(hwnd, GWL_STYLE) AND WS_CHILD)
      IF (GetWindowLongPtrW(hwnd, GWL_EXSTYLE) AND WS_EX_MDICHILD) THEN EXIT WHILE
      GetClassNameW hwnd, wszClassName, SIZEOF(wszClassName)
      IF wszClassName = "AtlAxWin" THEN EXIT WHILE
      hwnd = GetParent(hwnd)
   WEND
   IF wszClassName <> "AtlAxWin" THEN RETURN FALSE
   RETURN SendMessageW(hwnd, &H37F, 0, cast(LPARAM, pMsg))
END FUNCTION
' ========================================================================================


I had tried many variations of similar code and never managed to get the perfect combination, but I'm persistent.

[Paul Squires]

...but I'm persistent.

You are the most persistent person I know!

[Petrus Vorster]

I have had problems with that during many years.

It's really hard to believe Josè had a code problem for "many years". 
When all this stuff finally comes together with that designer of Paul, no tears will ever be wept for the loss of Powerbasic.

[Jean-pierre Leroy]

Excellent Petrus 

[Paul Squires]

OMG, Peter that's epic! 

[José Roca]

Love it! Exaggerated but friendly.

[Petrus Vorster]

LOL, man, where would we be without you?
You are way too modest.
If this forum were for martial arts, you would be Bruce Lee.

Thought you guys may find it funny. 

[José Roca]

ATL.DLL is a dead way. Although works fine to host the WebBrowser control, it works very badly with other ActiveX controls.

The good news is that I have made another OLE container, CAxHost, that works very well. When i wrote COleCon, I didn't know how to write a true COM class with FreeBasic. This new container uses reference counted COM classes with automatic creation and self destruction.

Now I will adapt the WebBrowser class to work with the new container and modify the templates and examples.

After this, the only item in my list of unresolved problems is the failure to create a domain with the NET hosting class.