PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  

Author Topic: CWindow RC 22  (Read 3270 times)

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
CWindow RC 22
« on: September 29, 2016, 12:02:21 AM »

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:

Code: [Select]
' ########################################################################################
' 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.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #1 on: September 30, 2016, 03:31:21 AM »

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.

Code: [Select]
' ########################################################################################
' 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
' ========================================================================================

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #2 on: September 30, 2016, 03:50:23 AM »

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.

Code: [Select]
' ########################################################################################
' 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
' ========================================================================================
« Last Edit: October 01, 2016, 05:08:51 AM by Jose Roca »
Logged

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #3 on: September 30, 2016, 01:32:39 PM »

After adding the following method to the CWebBrowser class

Code: [Select]
' ========================================================================================
' 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

Code: [Select]
   ' // 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.
« Last Edit: October 01, 2016, 04:29:32 AM by Jose Roca »
Logged

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #4 on: September 30, 2016, 02:09:16 PM »

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.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #5 on: October 01, 2016, 05:40:24 AM »

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.

Code: [Select]
' ########################################################################################
' 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
' ========================================================================================

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #6 on: October 01, 2016, 02:23:23 PM »

To get HTML5 working with an embedded WebBrowser, we need to use a meta tag like this:

Code: [Select]
<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.

Code: [Select]
' ########################################################################################
' 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
' ========================================================================================
« Last Edit: October 01, 2016, 02:26:42 PM by Jose Roca »
Logged

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #7 on: October 01, 2016, 02:31:58 PM »

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.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3171
Re: CWindow RC 22
« Reply #8 on: October 01, 2016, 02:43:10 PM »

This one embeds an HTML5 Audio Player.

Code: [Select]
' ########################################################################################
' 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
' ========================================================================================