CWindow Release Candidate 22
Besides some minor corrections and typos, the main novelty are the ADO classes (in the CADODB folder).
I have done my best to make them as easy to use as possible, but database applications need heavy error checking (mostly omited in the examples for brevity and clarity), which can be fastidious. Structured exception handling is a must for them. This is one of the features that I wish to see implemented in the compiler.
An small example:
' ########################################################################################
' Microsoft Windows
' Contents: ADO - Open recordset example
' Compiler: FreeBasic 32 & 64 bit
' Demonstrates how to open a recordset using a connection object and a source string.
' Note: Error checking ommited for brevity.
' 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 "Afx/CADODB/CADODB.inc"
using Afx
' // Open the connection
DIM pConnection AS CAdoConnection
pConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb"
' // Open the recordset
DIM pRecordset AS CAdoRecordset
DIM cbsSource AS CBSTR = "SELECT * FROM Authors"
DIM hr AS HRESULT = pRecordset.Open(cbsSource, pConnection, adOpenKeyset, adLockOptimistic, adCmdText)
' // Parse the recordset
DO
' // While not at the end of the recordset...
IF pRecordset.EOF THEN EXIT DO
' // Get the content of the "Author" column
DIM cvRes AS CVARIANT = pRecordset.Collect("Author")
PRINT cvRes
' // Fetch the next row
IF pRecordset.MoveNext <> S_OK THEN EXIT DO
LOOP
PRINT
PRINT "Press any key..."
SLEEP
The biblio.mdb database included in the examples is 32-bit, so don't compile the examples that use it with the 64-bit compiler.
The ADO classes are documented in the new help file.
Now that the CWebBrowser class allows to connect with the events fired by the WebBrowser control and allows customization with the IDocHostUIHandler2 interface to render the html pages at High DPI settings, I'm going to add more methods and write examples. After all, I wrote the OLE Container mainly to host this control. The only problem is that the embedded control works in compatibility mode (IE 7) by design.
The goal is to make the class as powerful and easy to use as possible. Embedding this control in our applications allows to display pictures, videos, maps, play music, and all that a web browser can do, that is almost limitless, although many things require jscript and I still don't know much about this language.
This is an adaptation of a Microsoft example, FishIETank.
' ########################################################################################
' Microsoft Windows
' Contents: Fish tank
' Compiler: FreeBasic 32 & 64 bit
' Adaptation of FishIEThank. Copyright © Microsoft Corporation.
' 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/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)
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
AfxSetProcessDPIAware
' // Creates the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "Fish Tank", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(800, 480)
' // 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
' // Navigate to the html page
pwb.Navigate(ExePath & "\FishIETank.htm")
' // 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 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
IF wParam <> SIZE_MINIMIZED THEN
' // Retrieve a pointer to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
' // Move the position of the control
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
' ========================================================================================
This one embeds a YouTube video. I want to write a method to write the html script directly instead of saving it to a temporary file and navigate to it.
' ########################################################################################
' Microsoft Windows
' Contents: WebBrowser with an embedded YouTube video
' 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/AfxCtl.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)
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
' Build the YouTube script
' ========================================================================================
FUNCTION BuildYouTubeScript (BYVAL strCode AS STRING, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG) AS STRING
' // Build the URL
DIM strURL AS STRING = "http://www.youtube.com/v/" & strCode
' // Build the web page
DIM s AS STRING
s = "<!DOCTYPE html>" & CHR(13, 10)
s += "<html>" & CHR(13, 10)
s += "<head>" & CHR(13, 10)
s += "<meta http-equiv='MSThemeCompatible' content='Yes'>" & CHR(13, 10)
s += "<title>YouTube video</title>" & CHR(13, 10)
s += "" & CHR(13, 10)
s += "</head>" & CHR(13, 10)
s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
s += "<object width=" & STR(nWidth) & " height=" & STR(nHeight) & ">" & _
"<param name='movie' value=" & strURL & "</param>" & _
"<embed src=" & strURL & _
" type='application/x-shockwave-flash' width='100%' height='100%'>" & _
"</embed></object>"
s += "" & CHR(13, 10)
s += "</body>" & CHR(13, 10)
s += "" & CHR(13, 10)
s += "</html>" & CHR(13, 10)
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, "Embedded WebBrowser control with a YouTube video", @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
' // Build the html script
' DIM strCode AS STRING = "_oAgkTwFRuM" ' --> Change me: 11 character video code
DIM strCode AS STRING = "IUGfC7GYi18" ' --> Change me: 11 character video code
DIM s AS STRING = BuildYouTubeScript(strCode, pWindow.ClientWidth, pWindow.ClientHeight)
' // Save the script to a temporary file
DIM wszPath AS WSTRING * MAX_PATH = AfxSaveTempFile(s, "html")
' // Navigate to the path
pwb.Navigate(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 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 control
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
' ========================================================================================
After adding the following method to the CWebBrowser class
' ========================================================================================
' Writes one or more HTML expressions to a document.
' Parameters
' - cbsHtml: Text and HTML tags to write.
' - cr: Write the HTML text followed by a carriage return.
' Remarks
' In HTML, the carriage return is ignored unless it occurs in preformatted text.
' Note When document.IHTMLDocument2::write or document.IHTMLDocument2::writeln is used
' in an event handler, you must also use document.IHTMLDocument2::close.
' Return value:
' - S_OK if successful, or an error value otherwise.
' ========================================================================================
PRIVATE FUNCTION CWebBrowser.WriteHtml (BYREF cbsHtml AS CBSTR, BYVAL cr AS BOOLEAN = FALSE) AS HRESULT
IF m_pWebBrowser = NULL OR cbsHtml.m_bstr = NULL THEN RETURN E_POINTER
DIM pIHTMLDocument2 AS IHTMLDocument2 PTR
DIM hr AS HRESULT = m_pWebBrowser->get_Document(@cast(IDispatch PTR, pIHTMLDocument2))
IF hr <> S_OK THEN RETURN hr
' // Create a safearray of variants of one element
DIM psarray AS SafeArray PTR
DIM rgsabounds(0) AS SAFEARRAYBOUND = {(1, 0)}
psarray = SafeArrayCreate(VT_VARIANT, 1, @rgsabounds(0))
IF psarray = NULL THEN RETURN E_FAIL
' // Fill the safearray with the script
DIM ix AS LONG = 0
DIM vHtml AS VARIANT
vHtml.vt = VT_BSTR
vHtml.bstrVal = cbsHtml.m_bstr
SafeArrayPutElement(psarray, @ix, @vHtml)
' // Write the string
IF cr THEN
hr = pIHTMLDocument2->lpvtbl->writeln(pIHTMLDocument2, psarray)
ELSE
hr = pIHTMLDocument2->lpvtbl->write(pIHTMLDocument2, psarray)
END IF
' // Destroy the safearray
SafeArrayDestroy psarray
' // Free the pIHTMLDocument2 interface
pIHTMLDocument2->lpvtbl->Release(pIHTMLDocument2)
' / Don't free vHtml because it does not own the BSTR
' // Return the result code
RETURN hr
END FUNCTION
' ========================================================================================
we can use
' // Build the html script
DIM strCode AS STRING = "IUGfC7GYi18" ' --> Change me: 11 character video code
DIM cbsScript AS CBSTR = BuildYouTubeScript(strCode, pWindow.ClientWidth, pWindow.ClientHeight)
' // Write the script to the web page
pwb.WriteHtml(cbsScript)
to write html directly to the web page.
I have found code to call a java script in the web page from our code...
JavaScript call from C++
http://www.codeproject.com/Articles/2352/JavaScript-call-from-C
Each time that I search for something in the web, I find new possibilities. This is going to be a great experience... I feel happy.
I have added methods for all the relevant IWebBrowser2 interface, some useful methods that use the IHtmlDocument interfaces and a method to embed the YouTube video that allows to embed the video just passing the code.
' ########################################################################################
' Microsoft Windows
' Contents: WebBrowser with an embedded YouTube video
' 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/AfxCtl.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)
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)
DIM hwndMain AS HWND = pWindow.Create(NULL, "Embedded WebBrowser control with a YouTube video", @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
' // Embed a YouTube video
pwb.EmbedYouTubeVideo("IUGfC7GYi18")
' // 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 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 control
' 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
' ========================================================================================
To get HTML5 working with an embedded WebBrowser, we need to use a meta tag like this:
<meta http-equiv=""X-UA-Compatible"" content=""IE=edge"" >"
We also need to save the page to a file and load it with the Navigate method.
' ########################################################################################
' Microsoft Windows
' Contents: WebBrowser HTML5 canvas test
' 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 _CWB_DEBUG_ 1
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.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)
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)
DIM hwndMain AS HWND = pWindow.Create(NULL, "Embedded WebBrowser control with audio player", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(400, 250)
' // 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
' // Build the html page
DIM s AS STRING
s = "<!DOCTYPE HTML>" & CHR(13, 10)
s += "<html>" & CHR(13, 10)
s += " <head>" & CHR(13, 10)
s += " <meta http-equiv=""X-UA-Compatible"" content=""IE=edge"" >" & CHR(13, 10)
s += " <meta http-equiv='MSThemeCompatible' content='Yes'>" & CHR(13, 10)
s += " <style>" & CHR(13, 10)
s += " body {" & CHR(13, 10)
s += " margin: 0px;" & CHR(13, 10)
s += " padding: 0px;" & CHR(13, 10)
s += " }" & CHR(13, 10)
s += " </style>" & CHR(13, 10)
s += " </head>" & CHR(13, 10)
s += " <body>" & CHR(13, 10)
s += " <canvas id=""myCanvas"" width=""400"" height=""245""></canvas>" & CHR(13, 10)
s += " <script>" & CHR(13, 10)
s += " var canvas = document.getElementById('myCanvas');" & CHR(13, 10)
s += " var context = canvas.getContext('2d');" & CHR(13, 10)
s += " var rectWidth = 200;" & CHR(13, 10)
s += " var rectHeight = 100;" & CHR(13, 10)
s += " var rectX = 50;" & CHR(13, 10)
s += " var rectY = 50;" & CHR(13, 10)
s += " var cornerRadius = 50;" & CHR(13, 10)
s += "" & CHR(13, 10)
s += " context.beginPath();" & CHR(13, 10)
s += " context.moveTo(rectX, rectY);" & CHR(13, 10)
s += " context.lineTo(rectX + rectWidth - cornerRadius, rectY);" & CHR(13, 10)
s += " context.arcTo(rectX + rectWidth, rectY, rectX + rectWidth, rectY + cornerRadius, cornerRadius);" & CHR(13, 10)
s += " context.lineTo(rectX + rectWidth, rectY + rectHeight);" & CHR(13, 10)
s += " context.lineWidth = 5;" & CHR(13, 10)
s += " context.stroke();" & CHR(13, 10)
s += " </script>" & CHR(13, 10)
s += " </body>" & CHR(13, 10)
s += "</html>" & CHR(13, 10)
' // 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
' // Delete 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 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 control
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
' ========================================================================================
To demonstrate the importance of calling the SetUIHandler method to make the WebBrowser High DPI aware, see the attached capture, un which I simply have removed pwb.SetUIHandler, and compare it with the capture posted above.
Of course, if you're working at 96 DPI you won't notice the difference when running the program.
Sorry for the wrong caption. I have forgot to change it.
This one embeds an HTML5 Audio Player.
' ########################################################################################
' Microsoft Windows
' Contents: WebBrowser with embedded audio 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
#define _CWB_DEBUG_ 1
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.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)
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)
DIM hwndMain AS HWND = pWindow.Create(NULL, "Embedded WebBrowser control with audio player", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(515, 150)
' // 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
' // Build the html page
DIM s AS STRING
s = "<!doctype html>" & CHR(13, 10)
s += "<head>" & CHR(13, 10)
s += " <title>Audio Element Sample</title>" & CHR(13, 10)
s += " <meta http-equiv='X-UA-Compatible' content='IE=edge' />" & CHR(13, 10)
s += " <meta http-equiv='MSThemeCompatible' content='Yes'>" & CHR(13, 10)
s += "</head>" & CHR(13, 10)
s += "<body>" & CHR(13, 10)
s += " <h2>Audio Element Sample</h2>" & CHR(13, 10)
s += " <!-- Display the audio player with control buttons. -->" & CHR(13, 10)
s += " <!-- Remember to change the path of the url of the audio file. -->" & CHR(13, 10)
s += " <audio style='width:500px;height:50px' src='" & ExePath & "\Kalimba.mp3' controls autoplay loop>" & CHR(13, 10)
s += " HTML5 audio not supported" & CHR(13, 10)
s += " </audio>" & CHR(13, 10)
s += "</body>" & CHR(13, 10)
s += "</html>" & CHR(13, 10)
' // 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
' // Delete 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 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 control
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
' ========================================================================================