• Welcome to PlanetSquires Forums.
 

CWindow Release Candidate 30

Started by José Roca, July 20, 2017, 12:17:28 AM

Previous topic - Next topic

José Roca

Code reuploaded. Modified the GDI+ classes to do automatic initialization and shutdown, and added new methods to CVAR.

José Roca

#16
CWSTR class:

Added the GrowSize property, to set the grown size to any value instead of the default of 260 characters. If you pass -1, the grow size will be the same that the length of the current buffer (uses more memory, but it makes a big difference in speed when appending multiple strings).

José Roca

File reuploaded. Added support for SAPI.


' ########################################################################################
' Microsoft Windows
' Contents: SAPI example
' Creates an instance of the ISpVoice interface, sets the the object of interest to word
' boundaries and sets the handle of the window that will receive the user-defined
' MSG_SAPI_EVENT message. When processing the MSG_SAPI_EVENT message, it calls the
' GetEvents method of the ISpVoice interface to retrieve the word boundaries and highlights
' the word in the edit control.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/AfxSapi.bi"
USING Afx

CONST IDC_START = 1001
CONST IDC_STOP = 1002
CONST IDC_TEXTBOX = 1003
CONST MSG_SAPI_EVENT = WM_USER + 1   ' --> change me

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 declaration
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

   ' // Initialize the COM library
   CoInitialize NULL

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   pWindow.Create(NULL, "SAPI example", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(340, 200)
   ' // Centers the window
   pWindow.Center

   ' // Adds a button
   pWindow.AddControl("Button", , IDC_START, "Start", 130, 160, 75, 23)
   pWindow.AddControl("Button", , IDC_STOP, "Stop", 230, 160, 75, 23)

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

   ' // Uninitialize the COM library
   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

   STATIC pSpVoice AS Afx_ISpVoice PTR, cwsText AS CWSTR

   SELECT CASE uMsg

      CASE WM_CREATE
         ' // Create an instance of the SpVoice object
         pSpVoice = AfxNewCom("SAPI.SpVoice")
         IF pSpVoice THEN
            ' // Set the object of interest to word boundaries
            pSpVoice->SetInterest(SPFEI(SPEI_WORD_BOUNDARY), SPFEI(SPEI_WORD_BOUNDARY))
            ' // Set the handle of the window that will receive the MSG_SAPI_EVENT message
            pSpVoice->SetNotifyWindowMessage(hwnd, MSG_SAPI_EVENT, 0, 0)
         END IF
         cwsText = "Now is the time for all good men to read" & _
            " this sentence and head to the enlistment" & _
            " center to help their country fight for justice!"
         DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         IF pWindow THEN
            pWindow->AddControl("EditMultiline", hwnd, IDC_TEXTBOX, cwsText, 20, 20, 300, 120, _
               WS_VISIBLE OR WS_TABSTOP OR WS_VSCROLL OR ES_LEFT OR ES_MULTILINE OR ES_NOHIDESEL OR ES_WANTRETURN)
         END IF
         EXIT FUNCTION

      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
            CASE IDC_START
               ' // Start speaking
               IF pSpVoice THEN pSpVoice->Speak(cwsText, SPF_ASYNC, NULL)
               EXIT FUNCTION
            CASE IDC_STOP
               ' // Stop speaking
               DIM cws AS CWSTR = ""
               IF pSpVoice THEN pSpVoice->Speak(cws, SVSFPurgeBeforeSpeak, NULL)
               EXIT FUNCTION
         END SELECT

      CASE MSG_SAPI_EVENT
         DIM eventItem AS SPEVENT, eventStatus AS SPVOICESTATUS
         DO
            IF pSpVoice->GetEvents(1, @eventItem, NULL) <> S_OK THEN EXIT DO
            IF eventItem.eEventId = SPEI_WORD_BOUNDARY THEN
               pSpVoice->GetStatus(@eventStatus, NULL)
               DIM nStart AS LONG = eventStatus.ulInputWordPos
               DIM nLen AS LONG = eventStatus.ulInputWordLen
               Edit_SetSel(GetDlgItem(hwnd, IDC_TEXTBOX), nStart, nStart + nLen)
            END IF
         LOOP
    CASE WM_DESTROY
          ' // Release the ISpVoice interface
         AfxSafeRelease(pSpVoice)
         ' // 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

#18
Code reuploaded.

Modified the LET operators of the CDispInvoke class to allow to set a NULL Dispatch pointer.

This allows to reuse the class when enumerating WMI objects with a semi-synchronously, forward ony enumerator.


#include "windows.bi"
#include "Afx/CWmiDisp.inc"
using Afx

' // Connect to WMI using a moniker
' // Note: $ is used to avoid the pedantic warning of the compiler about escape characters
DIM pServices AS CWmiServices = $"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"
IF pServices.ServicesPtr = NULL THEN END

' // Execute a query
DIM hr AS HRESULT = pServices.ExecQuery("SELECT * FROM Win32_Printer", 48)
IF hr <> S_OK THEN PRINT AfxWmiGetErrorCodeText(hr) : SLEEP : END

' // Enumerate the objects using the standard IEnumVARIANT enumerator (NextObject method)
' // and retrieve the properties using the CDispInvoke class.
DIM pDispServ AS CDispInvoke
DO
   pDispServ = pServices.NextObject
   IF pDispServ.DispPtr = NULL THEN EXIT DO
   PRINT "Caption: "; pDispServ.Get("Caption").ToStr
   PRINT "Capabilities "; pDispServ.Get("Capabilities").ToStr
LOOP

PRINT
PRINT "Press any key..."
SLEEP


As I said before, testing and experimenting allows to improve the classes.

Note: The number 48 used in pServices.ExecQuery("SELECT * FROM Win32_Printer", 48) is equivalent to use the wbemFlagReturnImmediately (it has a value of 16) and wbemFlagForwardOnly (it has a value of 32) combined. This improves speed when working with large collections and uses less memory, but you can't determine the number of objects in the collection and get the values using named properties. It is the option most often used with VB and VB Script because these languages have the convenience of a built-in For Each enumerator and, although the loop that I have used is not much harder to use than For Each, I'm quite sure that the ex-VB'ers will complain.



José Roca

#19
Added the bstr and cbstr methods to the CWSTR class.

the bstr method may be useful when writing a DLL to be used with another language that does not understand FreeBasic strings but understands COM BSTRings.

Internally, we can use CWSTR and return a BSTR as the result of the function with RETURN cws.bstr.

We can also use CBSTR and return a BSTR as the result of the function either by making a copy using SysAllocString or detaching the BSTR from the CBSTR class with RETURN cbs.Detach, whih is faster because it transfers ownership of the BSTR instead of making a copy. As you can see, I use the technique of attaching and detaching pointers very often, because it is the fatest way. It requires a bit more knowledge from the part of the programmer, but it is worth the effort.

Therefore, if we write and export a function in FreeBasic that returns a BSTR, e.g.

FUNCTION Foo () AS BSTR

in PowerBASIC we can use it writing a declare like DECLARE FUNCTION Foo <etc> () AS WSTRING, and call it as DIM ws AS WSTRING: ws = Foo (). PowerBASIC will attach the returned handle to ws and free it when ws is freed. WSTRING is the name that uses PowerBASIC for BSTR.

The cbstr method is useful to pass a CWSTR to a function or a COM method that expects a BSTR passed by value. If we use cws.bstr, it will correctly pass a BSTR, but we will have a memory leak, since nobody is going to free this BSTR. If we use cws.cbstr, a temporary CBSTR will be created, the BSTR will be passed to the function, and the BSTR will be freed when the temporary CBSTR is destroyed when it goes our of scope (inmediately after calling the procedure).

José Roca

#20
New templates for the WinFBE editor, using the CWebBrowser class and the Google Charts API to build Pie charts. Contrarily to other Web Browser classes available, mine is DPI aware.

There are many kind of charts. See: https://developers.google.com/chart/interactive/docs/examples


2
FBGUI
.bas
CWindow: WebBrowser: Google Pie Chart
' ########################################################################################
' Microsoft Windows
' File: CW_WB_GooglePieChart.fbtpl
' Contents: WebBrowser - Google pie chart
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/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 declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' HTML script to build a Google pie chart
' ========================================================================================
PRIVATE FUNCTION BuildPieChart () AS STRING

   DIM s AS STRING

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=edge' />"
   s += "   <meta http-equiv='MSThemeCompatible' content='Yes'>"
   s += "    <script type='text/javascript' src='https://www.gstatic.com/charts/loader.js'></script>"
   s += "    <script type='text/javascript'>"
   s += "      google.charts.load('current', {'packages':['corechart']});"
   s += "      google.charts.setOnLoadCallback(drawChart);"
   s += "      function drawChart() {"
   s += "        var data = google.visualization.arrayToDataTable(["
   s += "          ['Task', 'Hours per Day'],"
   s += "          ['Work',     11],"
   s += "          ['Eat',      2],"
   s += "          ['Commute',  2],"
   s += "          ['Watch TV', 2],"
   s += "          ['Sleep',    7]"
   s += "        ]);"
   s += "        var options = {"
   s += "          title: 'My Daily Activities'"
   s += "        };"
   s += "        var chart = new google.visualization.PieChart(document.getElementById('piechart'));"
   s += "        chart.draw(data, options);"
   s += "      }"
   s += "    </script>"
   s += "  </head>"
   s += "  <body>"
   s += "    <div id='piechart' style='width: 600px; height: 400px;'></div>"
   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 - Google Pie Chart", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(600, 400)
   ' // 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 script
   DIM s AS STRING = BuildPieChart
   ' // 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
         ' // 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

This one build a 3D pie chart.


2
FBGUI
.bas
CWindow: WebBrowser: Google Pie Chart 3D
' ########################################################################################
' Microsoft Windows
' File: CW_WB_GooglePieChart3D.fbtpl
' Contents: WebBrowser - Google pie chart 3D
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/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 declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' HTML script to build a Google pie chart
' ========================================================================================
PRIVATE FUNCTION BuildPieChart3D () AS STRING

   DIM s AS STRING

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=edge' />"
   s += "   <meta http-equiv='MSThemeCompatible' content='Yes'>"
   s += "    <script type='text/javascript' src='https://www.gstatic.com/charts/loader.js'></script>"
   s += "    <script type='text/javascript'>"
   s += "      google.charts.load('current', {packages:['corechart']});"
   s += "      google.charts.setOnLoadCallback(drawChart);"
   s += "      function drawChart() {"
   s += "        var data = google.visualization.arrayToDataTable(["
   s += "          ['Task', 'Hours per Day'],"
   s += "          ['Work',     11],"
   s += "          ['Eat',      2],"
   s += "          ['Commute',  2],"
   s += "          ['Watch TV', 2],"
   s += "          ['Sleep',    7]"
   s += "        ]);"
   s += "        var options = {"
   s += "          title: 'My Daily Activities',"
   s += "          is3D: true,"
   s += "        };"
   s += "        var chart = new google.visualization.PieChart(document.getElementById('piechart_3d'));"
   s += "        chart.draw(data, options);"
   s += "      }"
   s += "    </script>"
   s += "  </head>"
   s += "  <body>"
   s += "    <div id='piechart_3d' style='width: 600px; height: 400px;'></div>"
   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 - Google Pie Chart 3D", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(600, 400)
   ' // 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 script
   DIM s AS STRING = BuildPieChart3D
   ' // 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
         ' // 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

A Google donut chart.


2
FBGUI
.bas
CWindow: WebBrowser: Google Donut Chart
' ########################################################################################
' Microsoft Windows
' File: CW_WB_GoogleDonutChart.fbtpl
' Contents: WebBrowser - Google donut chart
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/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 declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' HTML script to build a Google donut chart
' ========================================================================================
PRIVATE FUNCTION BuildDonutChart () AS STRING

   DIM s AS STRING

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=edge' />"
   s += "   <meta http-equiv='MSThemeCompatible' content='Yes'>"
   s += "    <script type='text/javascript' src='https://www.gstatic.com/charts/loader.js'></script>"
   s += "    <script type='text/javascript'>"
   s += "      google.charts.load('current', {packages:['corechart']});"
   s += "      google.charts.setOnLoadCallback(drawChart);"
   s += "      function drawChart() {"
   s += "        var data = google.visualization.arrayToDataTable(["
   s += "          ['Task', 'Hours per Day'],"
   s += "          ['Work',     11],"
   s += "          ['Eat',      2],"
   s += "          ['Commute',  2],"
   s += "          ['Watch TV', 2],"
   s += "          ['Sleep',    7]"
   s += "        ]);"
   s += "        var options = {"
   s += "          title: 'My Daily Activities',"
   s += "          pieHole: 0.4,"
   s += "        };"
   s += "        var chart = new google.visualization.PieChart(document.getElementById('donutchart'));"
   s += "        chart.draw(data, options);"
   s += "      }"
   s += "    </script>"
   s += "  </head>"
   s += "  <body>"
   s += "    <div id='donutchart' style='width: 600px; height: 400px;'></div>"
   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 - Google Pie Chart 3D", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(600, 400)
   ' // 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 script
   DIM s AS STRING = BuildDonutChart
   ' // 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
         ' // 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

You can separate pie slices from the rest of the chart with the offset property of the slices option.

To separate a slice, create a slices object and assign the appropriate slice number an offset between 0 and 1. Below, we assign progressively larger offsets to slices 4 (Gujarati), 12 (Marathi), 14 (Oriya), and 15 (Punjabi):


2
FBGUI
.bas
CWindow: WebBrowser: Google Pie Chart - Exploding slices
' ########################################################################################
' Microsoft Windows
' File: CW_WB_GooglePieChartChartExplodingSlices.fbtpl
' Contents: WebBrowser - Google pie chart - Exploding slices
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/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 declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' HTML script to build a Google chart
' ========================================================================================
PRIVATE FUNCTION BuildPieChart () AS STRING

   DIM s AS STRING

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=edge' />"
   s += "   <meta http-equiv='MSThemeCompatible' content='Yes'>"
   s += "    <script type='text/javascript' src='https://www.gstatic.com/charts/loader.js'></script>"
   s += "    <script type='text/javascript'>"
   s += "      google.charts.load('current', {packages:['corechart']});"
   s += "      google.charts.setOnLoadCallback(drawChart);"
   s += "      function drawChart() {"
   s += "        var data = google.visualization.arrayToDataTable(["
   s += "          ['Language', 'Speakers (in millions)'],"
   s += "          ['Assamese', 13], ['Bengali', 83], ['Bodo', 1.4],"
   s += "          ['Dogri', 2.3], ['Gujarati', 46], ['Hindi', 300],"
   s += "          ['Kannada', 38], ['Kashmiri', 5.5], ['Konkani', 5],"
   s += "          ['Maithili', 20], ['Malayalam', 33], ['Manipuri', 1.5],"
   s += "          ['Marathi', 72], ['Nepali', 2.9], ['Oriya', 33],"
   s += "          ['Punjabi', 29], ['Sanskrit', 0.01], ['Santhali', 6.5],"
   s += "          ['Sindhi', 2.5], ['Tamil', 61], ['Telugu', 74], ['Urdu', 52]"
   s += "        ]);"
   s += "        var options = {"
   s += "          title: 'Indian Language Use',"
   s += "          legend: 'none',"
   s += "          pieSliceText: 'label',"
   s += "          slices: {  4: {offset: 0.2},"
   s += "                    12: {offset: 0.3},"
   s += "                    14: {offset: 0.4},"
   s += "                    15: {offset: 0.5},"
   s += "          },"
   s += "        };"
   s += "        var chart = new google.visualization.PieChart(document.getElementById('piechart'));"
   s += "        chart.draw(data, options);"
   s += "      }"
   s += "    </script>"
   s += "  </head>"
   s += "  <body>"
   s += "    <div id='piechart' style='width: 600px; height: 400px;'></div>"
   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 - Google Pie Chart - Exploding slices", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(600, 400)
   ' // 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 script
   DIM s AS STRING = BuildPieChart
   ' // 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
         ' // 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

Google gauge.


2
FBGUI
.bas
CWindow: WebBrowser: Google Gauge
' ########################################################################################
' Microsoft Windows
' File: CW_WB_GoogleGauge.fbtpl
' Contents: WebBrowser - Google gauge
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/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 declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' HTML script to build a Google gauge
' ========================================================================================
PRIVATE FUNCTION BuildGauge () AS STRING

   DIM s AS STRING

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=edge' />"
   s += "   <meta http-equiv='MSThemeCompatible' content='Yes'>"
   s += "    <script type='text/javascript' src='https://www.gstatic.com/charts/loader.js'></script>"
   s += "    <script type='text/javascript'>"
   s += "      google.charts.load('current', {packages:['gauge']});"
   s += "      google.charts.setOnLoadCallback(drawGauge);"

   s += "    var gaugeOptions = {min: 0, max: 280, yellowFrom: 200, yellowTo: 250,"
   s += "      redFrom: 250, redTo: 280, minorTicks: 5};"
   s += "    var gauge;"

   s += "    function drawGauge() {"
   s += "      gaugeData = new google.visualization.DataTable();"
   s += "      gaugeData.addColumn('number', 'Engine');"
   s += "      gaugeData.addColumn('number', 'Torpedo');"
   s += "      gaugeData.addRows(2);"
   s += "      gaugeData.setCell(0, 0, 120);"
   s += "      gaugeData.setCell(0, 1, 80);"

   s += "      gauge = new google.visualization.Gauge(document.getElementById('gauge_div'));"
   s += "      gauge.draw(gaugeData, gaugeOptions);"
   s += "    }"

   s += "    function changeTemp(dir) {"
   s += "      gaugeData.setValue(0, 0, gaugeData.getValue(0, 0) + dir * 25);"
   s += "      gaugeData.setValue(0, 1, gaugeData.getValue(0, 1) + dir * 20);"
   s += "      gauge.draw(gaugeData, gaugeOptions);"
   s += "    }"
   s += "    </script>"
   s += "  </head>"
   s += "  <body>"
   s += "  <div id='gauge_div' style='width:280px; height: 140px;'></div>"
   s += "  <input type='button' value='Go Faster' onclick='changeTemp(1)' />"
   s += "  <input type='button' value='Slow down' onclick='changeTemp(-1)' />"
   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 - Google Gauge", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(320, 200)
   ' // 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 script
   DIM s AS STRING = BuildGauge
   ' // 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
         ' // 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
' ========================================================================================


Paul Squires

The amount of code that you produce never ceases to amaze me......
Must be something in the water over there in Spain  :)
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

#26
Now we can use OpenGL in an embedded instance of the WebBrowser control using WebGL.

The key to make it DPI aware using my CWebBrowser class is my implementation of the IDocHostUIHandler interface, were I set the DOCHOSTUIFLAG_THEME OR DOCHOSTUIFLAG_DPI_AWARE flags (DOCHOSTUIFLAG_THEME is to enable visual styles).


FUNCTION CDocHostUIHandler2Impl.GetHostInfo (BYVAL pInfo AS DOCHOSTUIINFO PTR) AS HRESULT
   CWB_DP("*** CDocHostUIHandler2Impl.GetHostInfo pInfo = " & WSTR(pInfo))
   IF m_GetHostInfoProc THEN RETURN m_GetHostInfoProc(m_hwndContainer, pInfo)
   ' // Default behavior if the user does not processes this event...
   IF pInfo THEN
      pInfo->cbSize = SIZEOF(DOCHOSTUIINFO)
      pInfo->dwFlags = DOCHOSTUIFLAG_NO3DBORDER OR DOCHOSTUIFLAG_THEME OR DOCHOSTUIFLAG_DPI_AWARE
      pInfo->dwDoubleClick = DOCHOSTUIDBLCLK_DEFAULT
      pInfo->pchHostCss = NULL
      pInfo->pchHostNS = NULL
   END IF
   RETURN S_OK
END FUNCTION


In the FreeBasic code, after adding an instance of CWebBrowser, I call the SetUIHandler method.


   ' // Add a WebBrowser control
   DIM pwb AS CWebBrowser = CWebBrowser(@pWindow, IDC_WEBBROWSER, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   ' // Set the IDocHostUIHandler interface
   pwb.SetUIHandler


The other problem is that, by default, the embedded WebBrowser control uses IE 7 emulation (how nasty can be Microsoft sometimes!), that does not support HTML5. The solution is to add to the <head> tag of he hmtl page


<meta http-equiv="X-UA-Compatible" content="IE=edge" />
<meta http-equiv="MSThemeCompatible" content="yes">


and navigate to the page (it doesn't work if you create a blank page and write the html code to it, we need to save the html page to a file and navigate to it).

See below an small capture of WebGL working in an instance of the WebBrowser control embedded in a FreeBasic application.



José Roca

#27
A WebGL example. OpenGL running in an instance of the WebBrowser control embedded i a FreeBasic appiication. DPI aware.

The FreeBasic code is simple:


   ' // 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 path
   DIM wszPath AS WSTRING * MAX_PATH = ExePath & "\index.html"
   pwb.Navigate(wszPath)
   ' // Processes pending Windows messages to allow the page to load
   ' // Needed if the message pump isn't running
   AfxPumpMessages

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


We simply add an instance of the WebBrowser control, make it DPI aware by calling SetUIHandler and call the Navigate method to load and run the html page.

The html page uses


<meta http-equiv="X-UA-Compatible" content="IE=edge" />
<meta http-equiv="MSThemeCompatible" content="yes">


to tell the browser to use the version of IE installed instead of emulating IE 7.

To make the canvas resizable, I have added CSS styles:


<style>
   body {
      width: 100%;
      height: 100%;
      margin: 0px;
      padding: 0px;
   }
   canvas {
      background-color: #000000;
      display: block;
      position: absolute;
      top: 0;
      left: 0;
      right: 0;
      bottom: 0;
      width: 100%;
      height: 100%;
   }
</style>


The rest of the code in the html page, that I have copied and adapted a little from code found in the internet, are java scripts. Not having idea of opengl and javascript, I'm not going to post my own examples. I simply wanted to know what was needed to get it working using my framework, and report it here as a reminder.

The attached file contains the source code and a 32-bit executable. For a capture. see the one in the post above.



José Roca

#29
CWebBroser is proving to be one of the most useful classes that I have written. I once wrote a custom control in PowerBASIC to display animated gifs using GDI+. Now I can do it simply using an small html script. The limit seems to be our imagination.


' ========================================================================================
' Displays an animated gif file
' ========================================================================================
PRIVATE FUNCTION LoadGif (BYREF wszName AS WSTRING, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYREF wszAltName AS WSTRING = "") AS STRING

   DIM s AS STRING
   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "<meta http-equiv='MSThemeCompatible' content='yes'>"
   s += "<title>Animated gif</title>"
   s += "</head>"
   s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
   s += "<img src='" & wszName & "' alt=' " & wszAltName & _
         "' style='width:" & STR(nWidth) & "px;height:" & STR(nHeight) & "px;'>"
   s += "</body>"
   s += "</html>"

   FUNCTION = s

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



' ########################################################################################
' Microsoft Windows
' Contents: WebBrowser with an animated GIF
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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/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

' ========================================================================================
' Displays an animated gif file
' ========================================================================================
PRIVATE FUNCTION LoadGif (BYREF wszName AS WSTRING, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYREF wszAltName AS WSTRING = "") AS STRING

   DIM s AS STRING
   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "<meta http-equiv='MSThemeCompatible' content='yes'>"
   s += "<title>Animated gif</title>"
   s += "</head>"
   s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
   s += "<img src='" & wszName & "' alt=' " & wszAltName & _
         "' style='width:" & STR(nWidth) & "px;height:" & STR(nHeight) & "px;'>"
   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 control - Animated gif", @WndProc)
   ' // Change the window style
   pWindow.WindowStyle = WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(400, 300)
   ' // 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

   ' // Load the gif file --> change the path to your file
   ' // The file can be located anywhere and you can use an url if it is located in the web
   DIM s AS STRING = LoadGif(ExePath & "\Circles-3.gif", _
       pWindow.ClientWidth, pWindow.ClientHeight, "Circles")
   ' // Write the script to the web page
   pwb.WriteHtml(s)

   ' // 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_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
' ========================================================================================