I have added to the CWindows class some methods to manage a collection of objects. The purpose of it is to keep alive references without having to use global variables.
For example, I have writen a new class, CAfxImageList, that allows to easily build image lists:
LOCAL pAfxImageList AS IAfxImageList
pAfxImageList = CLASS "CAfxImageList"
' // Create the image list
pAfxImageList.CreateImageList(16, 16, %ILC_COLOR32 OR %ILC_MASK, 14)
' // Give a name to the image list
pAfxImageList.Name = "Toolbar image list"
' // Add the icons from the resource file
pAfxImageList.LoadResIcon(%IDI_BACK)
pAfxImageList.LoadResIcon(%IDI_FORWARD)
pAfxImageList.LoadResIcon(%IDI_NEW)
pAfxImageList.LoadResIcon(%IDI_FIND)
pAfxImageList.LoadResIcon(%IDI_PRINTPREV)
pAfxImageList.LoadResIcon(%IDI_PAGESETUP)
pAfxImageList.LoadResIcon(%IDI_PRINT)
pAfxImageList.LoadResIcon(%IDI_PROPERTIES)
pAfxImageList.LoadResIcon(%IDI_SAVE)
pAfxImageList.LoadResIcon(%IDI_REFRESH)
pAfxImageList.LoadResIcon(%IDI_STOP)
pAfxImageList.LoadResIcon(%IDI_ZOOMIN)
pAfxImageList.LoadResIcon(%IDI_ZOOMOUT)
pAfxImageList.LoadResIcon(%IDI_EXIT)
' // Add it to the collection of objects
pWindow.AddObject(pImageList.Name, pImageList)
' // Set the imagelist
SendMessage hToolbar, %TB_SETIMAGELIST, 0, pImageList.hImageList
But pAfxImageList needed to be a global variable.
Now, you can register the image list object reference with pWindow.AddObject(pImageList.Name, pImageList) and forget about global variables and also of having to destroy the image list when the program ends.
Will be also useful for other future classes.
I have also added some new wrapper functions, e.g.
' ========================================================================================
' Retrieves the handle to the edit box of the combobox
' ========================================================================================
FUNCTION ComboBox_GetEditBoxHandle (BYVAL hComboBox AS DWORD) AS DWORD
LOCAL tci AS COMBOBOXINFO
tci.cbSize = SIZEOF(COMBOBOXINFO)
IF SendMessage(hComboBox, %CB_GETCOMBOBOXINFO, 0, VARPTR(tci)) = 0 THEN EXIT FUNCTION
FUNCTION = tci.hwndItem
END FUNCTION
MACRO Combo_GetEditBoxHandle = ComboBox_GetEditBoxHandle
' ========================================================================================
' ========================================================================================
' Retrieves the handle to the drop down of the combobox
' ========================================================================================
FUNCTION ComboBox_GetListBoxHandle (BYVAL hComboBox AS DWORD) AS DWORD
LOCAL tci AS COMBOBOXINFO
tci.cbSize = SIZEOF(COMBOBOXINFO)
IF SendMessage(hComboBox, %CB_GETCOMBOBOXINFO, 0, VARPTR(tci)) = 0 THEN EXIT FUNCTION
FUNCTION = tci.hwndList
END FUNCTION
MACRO Combo_GetListBoxHandle = ComboBox_GetListBoxHandle
' ========================================================================================
I have also modified the AddWebBrowser method to add a new parameter, pEvtObj, which is a reference to the event class (or NOTHING, if you aren't going to use events).
' // Create an instance of the event class
LOCAL pWBEvents AS DWebBrowserEvents2Impl
pWBEvents = CLASS "CDWebBrowserEvents2"
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, s, pWBEvents, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
The event connection is done inside the AddWebBrowserControl:
IF ISOBJECT(pEvtObj) THEN OC_Advise(hCtl, pEvtObj)
This change was needed because some customization features can be only done inside the WebBrowser event class or in a custom implementation of the IDocHostUIHandler2 interface and if we connect events after the page has been loaded it is too late.
These customizations allow te use of interactive HTML elements in our PB application.
With some technologies, we can't just build a web page on the fly and pass it to the AddWebBrowser method because use the javascript event onload that is only fired if the page is loaded from disk. The solution is to save the page in a temporary file and pass the path as the url. For example, this is a template that I have writen to embed a Google map in a PB application:
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
%USEWEBBROWSER = 1 ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
' // Identifier
%IDC_WEBBROWSER = 101
' ########################################################################################
' Main
' ########################################################################################
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
pWindow.CreateWindow(%NULL, "AddWebBrowser Template: Google Map", 0, 0, 700, 500, 0, 0, CODEPTR(WindowProc))
' // Center the window
pWindow.CenterWindow
' // Build the html script
LOCAL s AS WSTRING
LOCAL cx, cy AS DOUBLE
LOCAL zoom AS LONG
cx = -34.397#
cy = 150.644#
zoom = 8
s = "<!DOCTYPE html>"
s += "<html>"
s += "<head>"
s += "<meta name='viewport' content='initial-scale=1.0, user-scalable=no' />"
s += "<style type='text/css'>" & $CRLF
s += "html { height: 100% }" & $CRLF
s += " body { height: 100%; margin: 0px; padding: 0px }" & $CRLF
s += " #map_canvas { height: 100% }" & $CRLF
s += "</style>" & $CRLF
s += "<script type='text/javascript'" & $CRLF
s += " src='http://maps.google.com/maps/api/js?sensor=false'>" & $CRLF
s += "</script>" & $CRLF
s += "<script type='text/javascript'>" & $CRLF
s += " function initialize() {" & $CRLF
s += " var latlng = new google.maps.LatLng(" & FORMAT$(cx) & "," & FORMAT$(cy) & ");" & $CRLF
s += " var myOptions = {" & $CRLF
s += " zoom: " & FORMAT$(zoom) & "," & $CRLF
s += " center: latlng," & $CRLF
s += " mapTypeId: google.maps.MapTypeId.ROADMAP" & $CRLF
s += " };" & $CRLF
s += " var map = new google.maps.Map(document.getElementById('map_canvas')," & $CRLF
s += " myOptions);" & $CRLF
s += " }" & $CRLF
s += "</script>" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' onload='initialize()'>" & $CRLF
s += " <div id='map_canvas' style='width:100%; height:100%'></div>" & $CRLF
s += "</body>" & $CRLF
s += "</html>" & $CRLF
' // Save the script as a temporary file
LOCAL szTmpPath AS WSTRINGZ * %MAX_PATH
LOCAL szTmpFileName AS WSTRINGZ * %MAX_PATH
LOCAL dwRes AS DWORD
LOCAL fn AS LONG
dwRes = GetTempPath(%MAX_PATH, szTmpPath)
IF dwRes > 0 AND dwRes <= %MAX_PATH - 14 THEN
dwRes = GetTempFileName(szTmpPath, "TMP", 1, szTmpFileName)
IF dwRes THEN
szTmpFileName = LEFT$(szTmpFileName, LEN(szTmpFileName) - 3) & "html"
fn = FREEFILE
OPEN szTmpFileName FOR OUTPUT AS #fn
PRINT #fn, s
CLOSE #fn
END IF
END IF
' // Create the WebBrowser control with the embedded map
pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, BYCOPY szTmpFileName, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Default message pump (you can replace it with your own)
pWindow.DoEvents(nCmdShow)
END FUNCTION
' ########################################################################################
' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL rc AS RECT
SELECT CASE uMsg
CASE %WM_SYSCOMMAND
' // Capture this message and send a WM_CLOSE message
' // Note: Needed with some OCXs, that otherwise remain in memory
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
' // If the Escape key has been pressed...
IF HI(WORD, wParam) = %BN_CLICKED THEN
' // ... close the application by sending a WM_CLOSE message
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
' // Get the client area of the main window
GetClientRect hwnd, rc
' // Resize the control
MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, LO(WORD, lParam), HI(WORD, lParam), %TRUE
END IF
CASE %WM_DESTROY
' // End the application
PostQuitMessage 0
EXIT FUNCTION
END SELECT
' // Pass unprocessed messages to Windows
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
To ease the task of saving these temporary files, I have writen the following function:
Description
Saves the contents of a string buffer in a temporary file.
PowerBASIC Syntax
FUNCTION AfxSaveTempFile ( _
BYVAL bstrBuffer AS WSTRING, _
OPTIONAL BYVAL bstrPathName AS WSTRING, _
OPTIONAL BYVAL bstrPrefixString AS WSTRING, _
OPTIONAL BYVAL bstrExtension AS WSTRING, _
OPTIONAL BYVAL uUnique AS DWORD _
) AS WSTRING
Parameters
bstrBuffer
[in] The string buffer to save.
bstrPathName
[in, opt] The directory path for the file name. Applications typically specify a period (.) for the current directory or an empty string. If an empty string is passed, the function uses as a path the one returned by the GetTempFileNameW API function. The string cannot be longer than MAX_PATHâ€"14 characters or the function will fail.
bstrPrefixString
[in, opt] The prefix string. The function uses up to the first three characters of this string as the prefix of the file name. This string must consist of characters in the OEM-defined character set. If an empty string is used, the function uses "TMP" as the prefix.
bstrExtension
[in, opt] The extension of the file name. If an empty string is passed, the function uses "TMP" as the extension.
uUnique
[in, opt] An unsigned integer to be used in creating the temporary file name. If uUnique is zero, the function attempts to form a unique file name using the current system time. If the file already exists, the number is increased by one and the functions tests if this file already exists. This continues until a unique filename is found; the function creates a file by that name and closes it. Note that the function does not attempt to verify the uniqueness of the file name when uUnique is nonzero.
Return Value
BSTR. The full path of the temporary file. If the function fails, it returns an empty string. Failure can happen if the path specified in bstrTmpPath does not exist or is longer than MAX_PATHâ€"14 characters.
Remarks
The AfxSaveTempFile function creates a temporary file name of the following form:
<path>\<pre><uuuu>.<ext>
The following table describes the file name syntax.
<path>
Path specified by the bstrPathName parameter.
<pre>
First three letters of the bstrPrefixString string.
<uuuu>
Hexadecimal value of uUnique.
If uUnique is zero, AfxSaveTempFile creates an empty file and closes it. If uUnique is not zero and the the resulting filename is not unique, AfxSaveTempFile will overwrite it.
Only the lower 16 bits of the uUnique parameter are used. This limits the function to a maximum of 65,535 unique file names if the bstrPathName and bstrPrefixString parameters remain the same.
Due to the algorithm used to generate file names, AfxSaveTempFile can perform poorly when creating a large number of files with the same prefix. In such cases, it is recommended that you construct unique file names based on GUIDs.
Temporary files whose names have been created by this function are not automatically deleted. To delete these files call DeleteFile or the PowerBASIC KILL statement.
Include file
AfxWin.inc
This is a template for Google Map.
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
%USEWEBBROWSER = 1 ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
' // Identifier
%IDC_WEBBROWSER = 101
' ########################################################################################
' Main
' ########################################################################################
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
pWindow.CreateWindow(%NULL, "AddWebBrowser Template: Google Map", 0, 0, 700, 500, 0, 0, CODEPTR(WindowProc))
' // Center the window
pWindow.CenterWindow
' // Build the html script
LOCAL s AS WSTRING
LOCAL cx, cy AS DOUBLE
LOCAL zoom AS LONG
cx = -34.397#
cy = 150.644#
zoom = 8
s = "<!DOCTYPE html>"
s += "<html>"
s += "<head>"
s += "<meta name='viewport' content='initial-scale=1.0, user-scalable=no' />"
s += "<style type='text/css'>" & $CRLF
s += "html { height: 100% }" & $CRLF
s += " body { height: 100%; margin: 0px; padding: 0px }" & $CRLF
s += " #map_canvas { height: 100% }" & $CRLF
s += "</style>" & $CRLF
s += "<script type='text/javascript'" & $CRLF
s += " src='http://maps.google.com/maps/api/js?sensor=false'>" & $CRLF
s += "</script>" & $CRLF
s += "<script type='text/javascript'>" & $CRLF
s += " function initialize() {" & $CRLF
s += " var latlng = new google.maps.LatLng(" & FORMAT$(cx) & "," & FORMAT$(cy) & ");" & $CRLF
s += " var myOptions = {" & $CRLF
s += " zoom: " & FORMAT$(zoom) & "," & $CRLF
s += " center: latlng," & $CRLF
s += " mapTypeId: google.maps.MapTypeId.ROADMAP" & $CRLF
s += " };" & $CRLF
s += " var map = new google.maps.Map(document.getElementById('map_canvas')," & $CRLF
s += " myOptions);" & $CRLF
s += " }" & $CRLF
s += "</script>" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' onload='initialize()'>" & $CRLF
s += " <div id='map_canvas' style='width:100%; height:100%'></div>" & $CRLF
s += "</body>" & $CRLF
s += "</html>" & $CRLF
' // Save the script as a temporary file
LOCAL bstrTempFileName AS WSTRING
bstrTempFileName = AfxSaveTempFile(s, "", "TMP", "html", 1)
' // Create the WebBrowser control with the embedded map
pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrTempFileName, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Default message pump (you can replace it with your own)
pWindow.DoEvents(nCmdShow)
END FUNCTION
' ########################################################################################
' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL rc AS RECT
SELECT CASE uMsg
CASE %WM_SYSCOMMAND
' // Capture this message and send a WM_CLOSE message
' // Note: Needed with some OCXs, that otherwise remain in memory
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
' // If the Escape key has been pressed...
IF HI(WORD, wParam) = %BN_CLICKED THEN
' // ... close the application by sending a WM_CLOSE message
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
' // Get the client area of the main window
GetClientRect hwnd, rc
' // Resize the control
MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, LO(WORD, lParam), HI(WORD, lParam), %TRUE
END IF
CASE %WM_DESTROY
' // End the application
PostQuitMessage 0
EXIT FUNCTION
END SELECT
' // Pass unprocessed messages to Windows
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================