Unrar the Afx folder in the inc folder of your compiler(s).
This is a big update:
On-line help: http://www.jose.it-berater.org/CWindow/CWindowFramework.html
Added support for BSTR: CBSTR class in CWSTR.inc.
Added suport for variants: CVAR class in CVAR.inc.
CDispInvoke class in CDispInvoke.inc: Allows to work with COM Automation.
CSafeArray class in CSafeArray.inc: Safe arrays support.
CDicObj class in CDicObj.inc: Dictionary objet (associative arrays).
CWmiDisp class to work with WMI.
ADO classes in various files: folder Afx/CADODB.
CWinHttpRequest: Modified to work with CBSTR.
CTextStream: Modified to work with CBSTR.
CFileSys: Modified to work with CBSTR.
CRegExp: Modified to work with CBSTR.
CShortcut and CUrlShortcut: Modified to wirh with CBSTR
CWStrArray and CWStrDic are no longer needed since CSafeArray and CDicObj can use all data types.
CWmiCli is now obsolete since CWmiDisp can work both with the local computer and remote servers.
21 Jul 2017: Small update.
21 Jul 2017: CVAR update.
22 Jul 2017: CVAR update, GDI+ classes update
23 Jul 2017: Added the GrowSize property to CWSTR
28 Jul 2017: Added support for SAPI
28 Jul 2017: Modified the LET operators of CDispInvoke
28 Jul 2017: Added the bstr and cbstr methods to CWSTR
1 Aug 2017: New function, AfxWstrAlloc, and new methods, CBStr.wchar and CWStr.wchar
2 Aug 2017: Modified some declares in Afx_Sapi.bi
2 Aug 2017: Modified the TypeLib Browser to generate AFX_ prefixes for the abstract interfaces. Still more work to do because there are not abstract interface declarations in the FB includes.
4 Aug 2917: New class: CSQlite3 (in CSQlite3.inc).
What we have:
GUI
CWindow, CLayout, CScrollWindow, CTabPage, hundreds of Windows API procedures.
STRINGS
CWSTR, CBSTR, CWStrArray, CWStrDic, CRegExp and string manipulation procedures.
VARIANTS
CVAR, CSafeArray, CDicObj
FILES
CFileSys, CTextStream, CFindFile and many procedures. Contrarily to the FB intrinsic functions that only work with ansi filenames and paths, these ones work with unicode.
GRAPHICS
CGraphCtx (now supports OpenGL optionally), CMemBmp, CImageCtx, GDI+ classes and procedures.
AUDIO
CCDAudio, CDSAudio.
DATABASES
CADODB, CODBC, CSQLITE3.
COM
COLECON (OLE Container), CWebBrowser, CDispInvoke, CCDOMessage, CShortcut, CUrlShortcut, CWinHttpRequest, CWmiDisp, helper procedures.
CDispInvoke and CWmiDisp will allow me to develop new classes to use COM technologies.
Doing testing to improve the new classes if needed. I'm going to make an small change to CDispInvoke to allow to call methods that don't have parameters.
With just a line of code we can get all the properties of a printer and/or call methods to, e.g. set it as the default printer, pause/resume the print queue, cancel all jobs, etc.
' // Connect with WMI in the local computer and get the properties of the specified printer
DIM pDisp AS CDispInvoke = CWmiServices( _
$"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:" & _
"Win32_Printer.DeviceID='OKI B410'").ServicesObj
See all the methods and properties of the Win32_Printer class:
https://msdn.microsoft.com/en-us/library/aa394363(v=vs.85).aspx
Example:
#include "windows.bi"
#include "Afx/CWmiDisp.inc"
using Afx
' // Connect with WMI in the local computer and get the properties of the specified printer
DIM pDisp AS CDispInvoke = CWmiServices( _
$"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:" & _
"Win32_Printer.DeviceID='OKI B410'").ServicesObj
' // Get the values of some properties and display them
PRINT "Port name: "; pDisp.Get("PortName").ToStr
PRINT "Attributes: "; pDisp.Get("Attributes").ToStr
PRINT "Paper sizes supported: "; pDisp.Get("PaperSizesSupported").ToStr
PRINT
PRINT "Press any key..."
SLEEP
Another small WMI example:
#include "windows.bi"
#include "Afx/CWmiDisp.inc"
using Afx
' // Connect with WMI in the local computer and get the properties of the specified file
DIM FileName AS STRING = ExePath & "\" & "x.bas" ' --> change me
DIM pDisp AS CDispInvoke = CWmiServices( _
$"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:" & _
"CIM_DataFile.Name='" & FileName & "'").ServicesObj
IF pDisp.DispPtr = NULL THEN END
' // Get the values of some properties and display them
PRINT "File name: "; pDisp.Get("FileName").ToStr
PRINT "File extension: "; pDisp.Get("Extension").ToStr
PRINT "Drive: "; pDisp.Get("Drive").ToStr
PRINT "File size: "; pDisp.Get("FileSize").ToStr
PRINT "File type: "; pDisp.Get("FileType").ToStr
PRINT "Creation date: "; AfxWmiTimeToDateStr(pDisp.Get("CreationDate").ToStr, "dd-MM-yyyy")
PRINT "Last modified: "; AfxWmiTimeToDateStr(pDisp.Get("LastModified").ToStr, "dd-MM-yyyy")
PRINT "Last accessed: "; AfxWmiTimeToDateStr(pDisp.Get("LastAccessed").ToStr, "dd-MM-yyyy")
PRINT
PRINT "Press any key..."
SLEEP
For a list of methods and properties see:
https://msdn.microsoft.com/en-us/library/aa387236(v=vs.85).aspx
Isn't this technology wonderful?
thank you Jose, thats an amazing amount of work. :)
I have reuploaded the files in the first post.
Changes:
- There was a mistyped constant in COdbcStmt.inc
- Modified the Invoke method of the CDispInvoke class to allow to call methods that don't have parameters.
If you have reuploaded the files, you can now test this little WMI script, that sets the specified printer as the default printer.
' // Connect with WMI in the local computer and get the properties of the specified printer
DIM pDisp AS CDispInvoke = CWmiServices( _
$"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:" & _
"Win32_Printer.DeviceID='OKI B410'").ServicesObj
' // Set the printer as the default printer
DIM cvRes AS CVAR = pDisp.Invoke("SetDefaultPrinter")
If you compare it with what Pierre had to do many years ago ( https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24462-set-default-printer?t=23826 ) you will understand how powerful is WMI to manage the hardware.
It is also worth noting the greater syntax flexibility allowed by CDispInvoke over the PowerBASIC OBJECT CALL/GET/SET.
I'm going to change the name of he AssignXXX methods to PutXXX, e.g. PutLong instead of AssignLong, etc. It is somewhat easier to write.
Code reuploaded. Changed the AssignXXX functions to PutXXX. Added additional Put procedures for BYTE, LONG, etc.
This example uses WMI to launch Notepad and returns the process identifier. Not useful, but wanted to test calling a method with an OUT parameter.
#define UNICODE
#INCLUDE ONCE "Afx/CWmiDisp.inc"
USING Afx
' // Connect to WMI using a moniker
DIM pServices AS CWmiServices = ( _
$"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_Process")
IF pServices.ServicesPtr = NULL THEN END
' // Assign the WMI services object pointer to CDispInvoke
' // CWmiServices.ServicesObj returns an AddRefed pointer, whereas CWmiServices.ServicesPtr not.
DIM pDispServices AS CDispInvoke = CDispInvoke(pServices.ServicesObj)
' // Note: Although the WMI documentation says that this OUT parameter is an UInt32,
' // it only works if I use "LONG".
DIM ProcessId AS LONG
pDispServices.Invoke("Create", 4, CVAR("notepad.exe"), , , CVAR(@ProcessId, "LONG"))
PRINT "Process id: ", ProcessId
Thanks Jose
This script returns all the .bas files from the specified drive and folder. I wasn't able to get it working until I found in the web that I had to use double backlashes in the path (weird!).
#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 (note that we have to use double backslashes "\\" in the path)
DIM cbsQuery AS CBSTR = "SELECT * FROM CIM_DataFile" & _
$" WHERE Drive = 'C:' AND Path = '\\Users\\Pepe\\FreeBasic64\\AfxTests\\CWmiDisp\\'" & _
" AND Extension = 'bas'"
DIM hr AS HRESULT = pServices.ExecQuery(cbsQuery)
IF hr <> S_OK THEN PRINT AfxWmiGetErrorCodeText(hr) : SLEEP : END
' // Get the number of objects retrieved
DIM nCount AS LONG = pServices.ObjectsCount
print "Count: ", nCount
IF nCount = 0 THEN PRINT "No objects found" : SLEEP : END
' // Enumerate the objects using the standard IEnumVARIANT enumerator (NextObject method)
' // and retrieve the properties using the CDispInvoke class.
FOR i AS LONG = 0 TO nCount - 1
DIM pDispServ AS CDispInvoke = pServices.NextObject
IF pDispServ.DispPtr THEN
PRINT "File name "; pDispServ.Get("FileName").ToStr
END IF
NEXT
PRINT
PRINT "Press any key..."
SLEEP
How it works:
- pServices.ExecQuery generates a collection of objects.
- pServices.NextObject returns the next object in the collection (or the first one if it is the first time that we call it) as a CVAR.
- The returned CVAR is assigned to an instance of the CDispInvoke class ( DIM pDispServ AS CDispInvoke = pServices.NextObject ), that assigns the pointer to its internal Dispatch pointer.
- pDispServ.Get("FileName") retrieves the value of the specified property and returns it as a CVAR.
Quote from: James Klutho on July 21, 2017, 11:32:49 AM
Thanks Jose
You're welcome. Trying to get all right and taking notes of the weird things that I find for future reference. In the last two examples I thought for a moment that something in my class was not working properly.
Quote from: Jose Roca on July 21, 2017, 08:34:25 AM
This example uses WMI to launch Notepad and returns the process identifier. Not useful, but wanted to test calling a method with an OUT parameter.
#define UNICODE
#INCLUDE ONCE "Afx/CWmiDisp.inc"
USING Afx
' // Connect to WMI using a moniker
DIM pServices AS CWmiServices = ( _
$"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_Process")
IF pServices.ServicesPtr THEN END
' // Assign the WMI services object pointer to CDispInvoke
' // CWmiServices.ServicesObj returns an AddRefed pointer, whereas CWmiServices.ServicesPtr not.
DIM pDispServices AS CDispInvoke = CDispInvoke(pServices.ServicesObj)
' // Note: Although the WMI documentation says that this OUT parameter is an UInt32,
' // it only works if I use "LONG".
DIM ProcessId AS LONG
pDispServices.Invoke("Create", 4, CVAR("notepad.exe"), , , CVAR(@ProcessId, "LONG"))
PRINT "Process id: ", ProcessId
Hi Jose,
Small error in your test code:
IF pServices.ServicesPtr THEN END
Should be:
IF pServices.ServicesPtr = Null THEN END
Indeed. Thanks very much. Of course the original test was different; otherwise would have not worked. I had IF pServices.ServicesPtr THEN [more lines of code] END IF.
Code reuploaded. Modified the GDI+ classes to do automatic initialization and shutdown, and added new methods to CVAR.
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).
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
' ========================================================================================
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.
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).
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
' ========================================================================================
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
' ========================================================================================
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
' ========================================================================================
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
' ========================================================================================
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
' ========================================================================================
The amount of code that you produce never ceases to amaze me......
Must be something in the water over there in Spain :)
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.
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.
A WebGL tutorial:
https://developer.mozilla.org/en-US/docs/Web/API/WebGL_API/Tutorial
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
' ========================================================================================
New function and new methods.
' ========================================================================================
' Takes a null terminated wide string as input, and returns a pointer to a new wide string
' allocated with CoTaskMemAlloc. Free the returned string with CoTaskMemFree.
' Note: This is useful when we need to pass a pointer to a null terminated wide string to a
' function or method that will release it. If we pass a WSTRING it will GPF.
' If the length of the input string is 0, CoTaskMemAlloc allocates a zero-length item and
' returns a valid pointer to that item. If there is insufficient memory available,
' CoTaskMemAlloc returns NULL.
' ========================================================================================
PRIVATE FUNCTION AfxWstrAlloc (BYREF wszStr AS WSTRING) AS WSTRING PTR
DIM nLen AS LONG = LEN(wszStr) * 2
DIM pwchar AS WSTRING PTR
pwchar = CoTaskMemAlloc(nLen)
IF pwchar = NULL THEN RETURN NULL
IF nLen THEN memcpy pwchar, VARPTR(wszStr), nLen
IF nLen = 0 THEN *pwchar = CHR(0)
RETURN pwchar
END FUNCTION
' ========================================================================================
' =====================================================================================
' Returns the contents of the CWSTR as a WSTRING allocated with CoTaskMemAlloc.
' Free the returned string later with CoTaskMemFree.
' Note: This is useful when we need to pass a pointer to a null terminated wide string to a
' function or method that will release it. If we pass a WSTRING it will GPF.
' If the length of the input string is 0, CoTaskMemAlloc allocates a zero-length item and
' returns a valid pointer to that item. If there is insufficient memory available,
' CoTaskMemAlloc returns NULL.
' =====================================================================================
PRIVATE FUNCTION CWStr.wchar () AS WSTRING PTR
DIM pwchar AS WSTRING PTR
pwchar = CoTaskMemAlloc(m_BufferLen)
IF pwchar = NULL THEN RETURN NULL
IF m_BufferLen THEN memcpy pwchar, m_pBuffer, m_BufferLen
IF m_BufferLen = 0 THEN *pwchar = CHR(0)
RETURN pwchar
END FUNCTION
' =====================================================================================
' =====================================================================================
' Returns the contents of the CWSTR as a WSTRING allocated with CoTaskMemAlloc.
' Free the returned string later with CoTaskMemFree.
' Note: This is useful when we need to pass a pointer to a null terminated wide string to a
' function or method that will release it. If we pass a WSTRING it will GPF.
' If the length of the input string is 0, CoTaskMemAlloc allocates a zero-length item and
' returns a valid pointer to that item. If there is insufficient memory available,
' CoTaskMemAlloc returns NULL.
' =====================================================================================
PRIVATE FUNCTION CBStr.wchar () AS WSTRING PTR
DIM pwchar AS WSTRING PTR
DIM nLen AS LONG = SysStringLen(m_bstr) * 2
pwchar = CoTaskMemAlloc(nLen)
IF pwchar = NULL THEN RETURN NULL
IF nLen THEN memcpy pwchar, m_bstr, nLen
IF nLen = 0 THEN *pwchar = CHR(0)
RETURN pwchar
END FUNCTION
' =====================================================================================
2 Aug 2017: Modified some declares in Afx_Sapi.bi
2 Aug 2017: Modified the TypeLib Browser to generate AFX_ prefixes for the abstract interfaces. Still more work to do because there are not abstract interface declarations in the FB includes.
The TypeLib Browser has two options: VBAuto and VTable, switchable clicking a toggle toolbar button. The VBAuto option generates interface declarations like the ones found in the Free Basic headers. The VTable option generates declarations using ABSTRACT methods.
I'm going to add this wrapper function just for convenience:
' ========================================================================================
' Parameter:
' - pwszFileSpec: The full path and name of the file to delete.
' Return value:
' If the function succeeds, the return value is nonzero.
' If the function fails, the return value is zero (0). To get extended error information, call GetLastError.
' Remarks:
' If an application attempts to delete a file that does not exist, this function fails
' with ERROR_FILE_NOT_FOUND. If the file is a read-only file, the function fails with
' ERROR_ACCESS_DENIED.
' ========================================================================================
PRIVATE FUNCTION AfxDeleteFile (BYVAL pwszFileSpec AS WSTRING PTR) AS LONG
IF pwszFileSpec = NULL THEN EXIT FUNCTION
FUNCTION = DeleteFileW(pwszFileSpec)
END FUNCTION
' ========================================================================================
I'm working in a class on top of SQLite that works with Windows unicode, instead of the UTF8 encoding. The infamous Exec method, inefficient and non-unicode aware, will be limited in the class to execute SQL statements that don't return a result set, such CREATE, INSERT and UPDATE. In the class, is just a wrapper for Prepare and Step. To execute queries that return results, you will use Prepare, parsing the results with GetRow (I'm not using Step because it is a reserved Free Basic keyword).
I have the most important methods already working. Now, it is a matter of adding the bind, column, blob and backup methods.
It consists of a base class, CSQlite, that loads the sqlite3.dll, and provides general purpose methods (using it directly is optional). The other classes inherit from it.
An small test:
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "Afx/AfxWin.inc"
#INCLUDE ONCE "Afx/CSQLite3.inc"
USING Afx
' // Optional: Specify the DLL path and/or name
' // This allows to use a DLL with a different name that sqlite3.dll,
' // located anywhere, avoiding the neeed to have multiple copies of the same dll.
'DIM pSql AS CSQLite = "sqlite3_64.dll"
'print pSql.m_hLib
' // Create a new database
' // I'm deleting and recreating the database for testing purposes
DIM cwsDbName AS CWSTR = AfxGetExePathName & "Test.sdb"
IF AfxFileExists(cwsDbName) THEN AfxDeleteFile(cwsDbName)
DIM pDbc AS CSQLiteDb = cwsDbName
' // Create a table
IF pDbc.Exec("CREATE TABLE t (xyz text)") <> SQLITE_DONE THEN
AfxMsg "Unable to create the table"
END
END IF
' // Insert rows
IF pDbc.Exec("INSERT INTO t (xyz) VALUES ('fruit')") <> SQLITE_DONE THEN AfxMsg "INSERT failed"
IF pDbc.Exec("INSERT INTO t (xyz) VALUES ('fish')") <> SQLITE_DONE THEN AfxMsg "INSERT failed"
' // Prepare a query
DIM pStmt AS CSqliteStmt = pDbc.Prepare("SELECT * FROM t")
PRINT "Column count: ", pStmt.ColumnCount
' // Read the column names and values
DO
' // Fetch rows of the result set
IF pStmt.GetRow = SQLITE_DONE THEN EXIT DO
' // Read the columns and values
FOR i AS LONG = 0 TO pStmt.ColumnCount- 1
PRINT pStmt.ColumnName(i)
PRINT pStmt.ColumnText(i)
NEXT
LOOP
PRINT
PRINT "Press any key..."
SLEEP
Awesome Jose! Love anything sqlite related.
I write mostly business applications and I use sqlite as the database backend for the vast majority of them.
I always have find annoying to have to use UTF-8 with Windows. Therefore, this version will work with UTF-16. Internally, SQLite will work with UTF-8, but you should not notice it.
File reuploaded. Includes a new class, CSQLite3, a thin wrapper on top of SQLite3.dll.
Basic steps:
' Basic steps
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "Afx/AfxWin.inc"
#INCLUDE ONCE "Afx/CSQLite3.inc"
USING Afx
' // Optional: Specify the DLL path and/or name
' // This allows to use a DLL with a different name that sqlite3.dll,
' // located anywhere, avoiding the neeed to have multiple copies of the same dll.
'DIM pSql AS CSQLite = "sqlite3_64.dll"
'print pSql.m_hLib
' // Create a new database
' // I'm deleting and recreating the database for testing purposes
DIM cwsDbName AS CWSTR = AfxGetExePathName & "Test.sdb"
IF AfxFileExists(cwsDbName) THEN AfxDeleteFile(cwsDbName)
DIM pDbc AS CSQLiteDb = cwsDbName
' // Create a table
IF pDbc.Exec("CREATE TABLE t (xyz text)") <> SQLITE_DONE THEN
AfxMsg "Unable to create the table"
END
END IF
' // Insert rows
IF pDbc.Exec("INSERT INTO t (xyz) VALUES ('fruit')") <> SQLITE_DONE THEN AfxMsg "INSERT failed"
IF pDbc.Exec("INSERT INTO t (xyz) VALUES ('fish')") <> SQLITE_DONE THEN AfxMsg "INSERT failed"
' // Prepare a query
DIM pStmt AS CSqliteStmt = pDbc.Prepare("SELECT * FROM t")
PRINT "Column count: ", pStmt.ColumnCount
' // Read the column names and values
DO
' // Fetch rows of the result set
IF pStmt.GetRow = SQLITE_DONE THEN EXIT DO
' // Read the columns and values
FOR i AS LONG = 0 TO pStmt.ColumnCount- 1
' // Get the value using the number of column...
PRINT pStmt.ColumnName(i)
PRINT pStmt.ColumnText(i)
' // ...or using the column name
PRINT pStmt.ColumnText("xyz")
NEXT
LOOP
PRINT
PRINT "Press any key..."
SLEEP
Binding:
' Binding
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "Afx/AfxWin.inc"
#INCLUDE ONCE "Afx/CSQLite3.inc"
USING Afx
' // Optional: Specify the DLL path and/or name
' // This allows to use a DLL with a different name that sqlite3.dll,
' // located anywhere, avoiding the neeed to have multiple copies of the same dll.
'DIM pSql AS CSQLite = "sqlite3_64.dll"
'print pSql.m_hLib
' // Create a new database
' // I'm deleting and recreating the database for testing purposes
DIM cwsDbName AS CWSTR = AfxGetExePathName & "Test.sdb"
IF AfxFileExists(cwsDbName) THEN AfxDeleteFile(cwsDbName)
DIM pDbc AS CSQLiteDb = cwsDbName
' // Create a table
IF pDbc.Exec("CREATE TABLE t (xyz text)") <> SQLITE_DONE THEN
AfxMsg "Unable to create the table"
END
END IF
' // Prepare the statement
DIM sql AS CWSTR = "INSERT INTO t (xyz) VALUES (?)"
DIM pStmt AS CSqliteStmt = pDbc.Prepare(sql)
' // Bind the text
pStmt.BindText(1, "fruit")
' // Execute the prepared statement
pStmt.Step_
PRINT "Row id was", pDbc.LastInsertRowId
' // Prepare a query
pStmt.hStmt = pDbc.Prepare("SELECT * FROM t")
' // Read the value
pStmt.GetRow
PRINT pStmt.ColumnText("xyz")
PRINT
PRINT "Press any key..."
SLEEP
Memory database:
' Binding
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "Afx/AfxWin.inc"
#INCLUDE ONCE "Afx/CSQLite3.inc"
USING Afx
' // Optional: Specify the DLL path and/or name
' // This allows to use a DLL with a different name that sqlite3.dll,
' // located anywhere, avoiding the neeed to have multiple copies of the same dll.
'DIM pSql AS CSQLite = "sqlite3_64.dll"
'print pSql.m_hLib
' // Create a new database in memory
' // I'm deleting and recreating the database for testing purposes
DIM pDbc AS CSQLiteDb = ":memory:"
' // Create a table
IF pDbc.Exec("CREATE TABLE t (xyz text)") <> SQLITE_DONE THEN
AfxMsg "Unable to create the table"
END
END IF
' // Prepare the statement
DIM sql AS CWSTR = "INSERT INTO t (xyz) VALUES (?)"
DIM pStmt AS CSqliteStmt = pDbc.Prepare(sql)
' // Bind the text
pStmt.BindText(1, "fruit")
' // Execute the prepared statement
pStmt.Step_
PRINT "Row id was", pDbc.LastInsertRowId
' // Prepare a query
pStmt.hStmt = pDbc.Prepare("SELECT * FROM t")
' // Read the value
pStmt.GetRow
PRINT pStmt.ColumnText("xyz")
PRINT
PRINT "Press any key..."
SLEEP
Blob:
' Blob
'#CONSOLE ON
#define UNICODE
#INCLUDE ONCE "Afx/AfxWin.inc"
#INCLUDE ONCE "Afx/CSQLite3.inc"
USING Afx
' // Optional: Specify the DLL path and/or name
' // This allows to use a DLL with a different name that sqlite3.dll,
' // located anywhere, avoiding the neeed to have multiple copies of the same dll.
'DIM pSql AS CSQLite = "sqlite3_64.dll"
'print pSql.m_hLib
' // Create a new database
' // I'm deleting and recreating the database for testing purposes
DIM cwsDbName AS CWSTR = AfxGetExePathName & "TestBlob.sdb"
IF AfxFileExists(cwsDbName) THEN AfxDeleteFile(cwsDbName)
DIM pDbc AS CSQLiteDb = cwsDbName
' // Create a table
IF pDbc.Exec("CREATE TABLE t (xyz blob)") <> SQLITE_DONE THEN
AfxMsg "Unable to create the table"
END
END IF
' // Prepare the statement
DIM sql AS CWSTR = "INSERT INTO t (xyz) VALUES (?)"
DIM pStmt AS CSqliteStmt = pDbc.Prepare(sql)
' // Bind the blob
DIM fakeBlob AS STRING
fakeBlob = STRING(500, "A")
pStmt.BindBlob(1, STRPTR(fakeBlob), 500, SQLITE_TRANSIENT)
' // Execute the prepared statement
pStmt.Step_
PRINT "Row id was", pDbc.LastInsertRowId
' // Open the blob
DIM pBlob AS CSQLiteBlob = pDbc.OpenBlob("main", "t", "xyz", 1)
DIM nBlobBytes AS LONG = pBlob.Bytes
PRINT "Blob bytes: ", nBlobBytes
' // Read the blob
DIM strBlob AS STRING
strBlob = STRING(nBlobBytes, CHR(0))
pBlob.Read(STRPTR(strBlob), nBlobBytes)
PRINT strBlob
PRINT
PRINT "Press any key..."
SLEEP
I'm going to deprecate some code that has become obsolete. These are the CWstrArray, CWStrDic and CWmiCli classes. The functions AfxStrSplit and AfxStrJoin will be modified to use CSafeArray instead of CWstrArray. Guess that nobody is using them, so it will not break existing code.
I wrote CWstrArray and CWstrDic when I temporarily stopped adding COM support to the framework. The new CSafeArray and CDicObj classes can work with any data type and are a bit more efficient that the old ones because don't need to make internal conversions of CWSTR to BSTR.
I don't think that anybody can have objections, but just in case...
Quote from: Jose Roca on August 04, 2017, 03:18:46 PM
File reuploaded. Includes a new class, CSQLite3, a thin wrapper on top of SQLite3.dll.
So, I took a look with the intention of porting my SQLite client/server over to this class. The only issue is that to use it, I would need an instance of it for every connection managed since the DB handle is kept internally.
The code in question is:
' ===========================================================================================
' Gets the database handle
' ===========================================================================================
PRIVATE PROPERTY CSQLiteDb.hDbc () AS sqlite3 PTR
PROPERTY = m_hDbc
END PROPERTY
' ===========================================================================================
' ===========================================================================================
' Sets the database handle
' ===========================================================================================
PRIVATE PROPERTY CSQLiteDb.hDbc (BYVAL pDbc AS sqlite3 PTR)
this.CloseDb ' // Close the database
m_hDbc = pDbc
END PROPERTY
It's the call to CloseDb that is causing me to pause.
If you don't mind, I'll look things over more carefully and see if there is an easy way to remove that limitation and incorporate some of the concepts I've designed in the client/server SQLite class like connection pools and results spooling.
Rick
I don't mind at all. I only have written it in case I may need to use a lightweight database in the future for which ODBC or ADO will be overkill. I don't have a personal need for many of the classes that I have written. Just trying to make the framework more attractive.
Quote from: Jose Roca on August 30, 2017, 05:27:51 PM
I don't mind at all. I only have written it in case I may need to use a lightweight database in the future for which ODBC or ADO will be overkill. I don't have a personal need for many of the classes that I have written. Just trying to make the framework more attractive.
Thank you. I think the best way to support you and Paul is to build on what both of you are doing.
Rick