The headers for the upcoming PBWIN 10.01 update will feature some changes and many additions. Latest additions are:
CAfxImageList
A class to create and manage image lists.
Methods/Properties:
AddBitmap
Adds a bitmap to the image list.
AddIcon
Adds an icon to the image list.
AddMasked
Adds an image or images to an image list, generating a mask from the specified bitmap.
BackgroundColor
Gets/sets the background color for an image list.
Copy
Copies images within a given image list.
CreateImageList
Creates a new image list.
Duplicate
Creates a duplicate of an existing image list.
GetIconSize
Retrieves the dimensions of images in an image list.
hImageList
Returns the handle of the image list.
hInstance
Gets/Sets the handle of the instance that contains the resource.
ImageCount
Retrieves the number of images in an image list.
LoadBitmap
Loads a bitmap from file or resource and adds it to the image list.
LoadIcon
Loads an icon from file or resource and adds it to the image list.
LoadImage
Loads an image from file or resource.
LoadMasked
Loads an image or images to an image list, generating a mask from the specified bitmap.
LoadNamedResBitmap
Loads a bitmap from a resource file and adds it to the image list.
LoadNamedResIcon
Loads an icon from a resource file and adds it to the image list.
LoadResBitmap
Loads a bitmap from a resource file and adds it to the image list.
LoadResIcon
Loads an icon from a resource file and adds it to the image list.
Name
An optional name to identify the image list in a collection.
OverlayImage
Adds a specified image to the list of images to be used as overlay masks.
OverlayIndex
Returns the overlay index for the specified image index.
Remove
Removes an image from an image list
CAfxFont
A class to create and manage fonts.
Methods/Properties:
Bold
Gets/sets the weight of the font as bold.
CharSet
Gets/sets the character set of the font.
ClipPrecision
Gets/sets the clipping precision of the font.
CreateFont
Creates a font and returns an handle to it.
Escapement
Gets/sets the escapement of the font.
FaceName
Gets/sets the face name of the font.
hFont
Returns the handle of the font.
Italic
Gets/sets the style of the font as italic.
Name
An optional name to identify the font in a collection,
Orientation
Gets/sets the orientation of the font.
OutPrecision
Gets/sets the output precision of the font.
PitchAndFamily
Gets/sets the pitch and family of the font.
Quality
Gets/sets the quality of the font.
Size
Gets/sets the size of the font.
StrikeOut
Gets/sets the style of the font as strikeout.
Underline
Gets/sets the style of the font as underlined.
Weight
Gets/sets the weight of the font.
Width
Gets/sets the width of the font.
CAfxBrush
A class to create and manage brushes.
Methods/Properties:
CreateBrush
Creates a brush and returns an handle to it.
hBrush
Returns the handle of the brush.
Style
Returns the style of the brush.
Color
The color in which the brush is to be drawn.
Hatch
Gets/sets the hatch style of the brush.
Name
An optional name to identify the brush in a collection.
CAfxCDAudio
A light weight class on top of MCI.
Methods/Properties:
Backward
Moves to the previous track.
Close
Closes the device or file and any associated resources.
CloseDoor
Closes the CDRom door.
Forward
Moves to the next track.
Forward
Moves to the next track.
GetAllTracksLength
Returns the total length in seconds of all the tracks.
GetAllTracksLengthString
Returns the total length of all the tracks.
GetCurrentPos
Returns the current track position in seconds.
GetCurrentPosString
Returns the current track position.
GetCurrentTrack
Returns the current track number.
GetError
Retrieves a The last MCI error code.
GetErrorString
Retrieves a The last MCI error code.
GetTrackLength
Returns the length in seconds of the given track.
GetTrackLengthString
Returns the length of the given track.
GetTracksCount
Returns the count of tracks.
GetTrackStartTime
Returns the start time of the given track.
GetTrackStartTimeString
Returns the start time of the given track.
IsMediaInserted
Checks whether CD media is inserted.
IsPaused
Checks whether is in paused mode.
IsPlaying
Checks whether is in play mode.
IsReady
Checks if the device is ready.
IsSeeking
Checks whether is in seeking mode.
IsStopped
Checks whether is in stopped mode.
Open
Initializes the device.
OpenDoor
Opens the CDRom door.
Pause
Pauses playing CD Audio.
Play
Starts playing CD Audio.
PlayFrom
Starts playing CD Audio on the given track.
PlayFromTo
Starts playing CD Audio from a given track to a given track.
Stop
Stops playing CD Audio.
ToEnd
Sets the position to the end of the audio CD.
ToStart
Sets the position to the start of the audio CD.
AfxGlut.inc
OpenGL utilities.
Procedures:
AfxGlutSolidCone/AfxGlutWireCone
Draws a cone.
AfxGlutSolidCube/AfxGlutWireCube
Draws a cube.
AfxGlutSolidCylinder/AfxGlutWireCylinder
Draws a cylinder.
AfxGlutSolidDodecahedron/AfxGlutWireDodecahedron
Draws a dodecahedron.
AfxGlutSolidIcosahedron/AfxGlutWireIcosahedron
Draws a icosahedron.
AfxGlutSolidOctahedron/AfxGlutWireOctahedron
Draws a octahedron.
AfxGlutSolidRhombicDodecahedron/AfxGlutWireRhombicDodecahedron
Draws a rhombic dodecahedron.
AfxGlutSolidSphere/AfxGlutWireSphere
Draws a sphere.
AfxGlutSolidTeapot/AfxGlutWireTeapot
Draws a teapot.
AfxGlutSolidTetrahedron/AfxGlutWireTetrahedron
Draws a tetrahedron.
AfxGlutSolidTorus/AfxGlutWireTorus
Draws a torus.
------------------------------------
I also have written several classes for GDI+, but I still have to test them.
Jose - when I am looking at the output that is coming from you these days...
Where do you find time to sleep, work, eat, etc.?
Thanks for all this great stuff!!!!!!
Thanks to the wrappers, the headers are becoming a framework that allows to do easily things that some time ago were almost a dream.
What about embeding a javascript grid, that uses an .xml file for the data, in an html page that is displayed in an embeded instance of the WebBrowser control in a PB application. And the size of the .exe is 84 KB.
The code of the 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", 0, 0, 640, 380, 0, 0, CODEPTR(WindowProc))
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control
LOCAL hCtl AS DWORD
LOCAL bstrPath AS WSTRING
' // You can pass a URL
bstrPath = EXE.Path$ & "grid_alter_colors.html"
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrPath, 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
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
' // 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
' ========================================================================================
The HTML page:
<!--conf<sample in_favorites="false">
<product version="1.4" edition="std"/>
<modifications>
<modified date="070101"/>
</modifications>
</sample>
-->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>Alternative styles for even/uneven rows</title>
<link rel="STYLESHEET" type="text/css" href="dhtmlxgrid.css">
<script src="dhtmlxcommon.js"></script>
<script src="dhtmlxgrid.js"></script>
<script src="dhtmlxgridcell.js"></script>
<style>
.even{
background-color:#E6E6FA;
}
.uneven{
background-color:#F0F8FF;
}
</style>
</head>
<body scroll="no"><link rel='STYLESHEET' type='text/css' href='style.css'>
<table cellspacing="0" cellpadding="0" class="sample_header" border="0">
<tr valign="middle">
<!-- COMPONENT ICON -->
<td width="40" align="center"><img src="dhtmlxgrid_icon.gif" border="0"></td>
<!-- COMPONENT NAME -->
<td width="120" align="left">Sample: dhtmlxGrid</td>
<!-- SAMPLE TITLE -->
<td width="0" align="left"><b>Alternative styles for even/uneven rows</b></td>
</tr>
</table>
<table width="100%">
<tr>
<td>
<div id="gridbox" width="100%" height="250px" style="background-color:white;"></div>
</td>
</tr>
<tr>
<td>
<a href="javascript:void(0)" onclick="mygrid.addRow((new Date()).valueOf(),[0,'','','',false,'na',false,''],mygrid.getRowIndex(mygrid.getSelectedId()))">Add row</a><br>
<a href="javascript:void(0)" onclick="mygrid.deleteSelectedItem()">Remove Selected Row</a>
</td>
</tr>
</table>
<br>
<script>
mygrid = new dhtmlXGridObject('gridbox');
mygrid.setImagePath("imgs/");
mygrid.setHeader("Sales,Book Title,Author,Price,In Store,Shipping,Bestseller,Date of Publication");
mygrid.setInitWidths("50,150,100,80,80,80,80,200")
mygrid.setColAlign("right,left,left,right,center,left,center,center")
mygrid.setColTypes("dyn,ed,ed,price,ch,co,ra,ro");
mygrid.getCombo(5).put(2,2);
mygrid.setColSorting("int,str,str,int,str,str,str,date")
mygrid.enableAlterCss("even","uneven");
mygrid.init();
mygrid.loadXML("grid.xml");
</script>
</body>
</html>
Today has been the day of graphic and picture controls.
Added support for the WM_PRINTCLIENT message. Copies the contents of the graphic of pricture controls to the provided device context.
Added a clear function to the picture controls (the graphic one already had it) to clear the contents.
New graphic control: GlCtx.
Supports GDI, GDI+ and OpenGL to be used at the same time.
In the attached picture, the diagonal line has been drawn using GDI+ and the Icosahedron using OpenGL.
To the already existing wrappers to deal with drives, folder and files, I have added:
AfxGetFileAttributes
Returns the file-system attribute(s) of a disk file or directory.
AfxIsFile
Returns TRUE if the specified path is a file; FALSE, otherwise.
AfxIsFolder
Returns TRUE if the specified path is a directory; FALSE, otherwise.
Note: PB provides GetAttr, IsFile and IsFolder, but the above three functions can work with long filenames up to 32767 characters.
AfxIsSystemFile
Returns TRUE if the specified path is a system file; FALSE, otherwise.
AfxIsHiddenFile
Returns TRUE if the specified path is a hidden file; FALSE, otherwise.
AfxIsReadOnlyFile
Returns TRUE if the specified path is a read only file; FALSE, otherwise.
AfxIsTemporaryFile
Returns TRUE if the specified path is a temporary file; FALSE, otherwise.
AfxIsNormalFile
Returns TRUE if the specified path is a normal file; FALSE, otherwise.
AfxIsCompressedFile
Returns TRUE if the specified path is a compressed file or diectory; FALSE, otherwise.
AfxIsEncryptedFile
Returns TRUE if the specified path is an encrypted file or diectory; FALSE, otherwise.
AfxIsNotContentIndexedFile
Returns TRUE if the specified file or directory is not to be indexed by the content ndexing service; FALSE, otherwise.
AfxIsOffLineFile
Returns TRUE if the specified file is not available immediately; FALSE, otherwise.
AfxIsReparsePointFile
Returns TRUE if the specified path is a file or directory that has an associated reparse point, or a file that is a symbolic link.; FALSE, otherwise.
AfxIsSpaseFile
Returns TRUE if the specified path is a sparse file; FALSE, otherwise.
AfxGetFileSize
Returns the size in bytes of the specified file.
AfxGetFileCreationTimeUTC
Returns the time the file was created, in UTC format.
AfxGetFileCreationTime
Returns the time the file was created, in local time format.
AfxGetFileCreationTimeUTCStr
Returns the time the file was created, in UTC format, as a string.
AfxGetFileCreationTimeStr
Returns the time the file was created, in local time format, as a string.
AfxGetFileLastAccessTimeUTC
Returns the time the file was last accessed, in UTC format.
AfxGetFileLastAccessTime
Returns the time the file was last accessed, in local time format.
AfxGetFileLastAccessTimeUTCStr
Returns the time the file was last accessed, in UTC format, as a string.
AfxGetFileLastAccessTimeStr
Returns the time the file was last accessed, in local time format, as a string.
AfxGetFileLastWriteTimeUTC
Returns the time the file was last accessed in UTC format.
AfxGetFileLastWriteTimeUTC
Returns the time the file was last accessed in UTC format.
AfxGetFileLastWriteTime
Returns the time the file was written to, truncated, or overwritten, in local time format.
AfxGetFileLastWriteTimeUTCStr
Returns the time the file was written to, truncated, or overwritten, in UTC format, as a string.
AfxGetFileLastWriteTimeStr
Returns the time the file was written to, truncated, or overwritten, in local time format, as a string.
AfxGetFolderCreationTimeUTC
Returns the time the folder was created, in UTC format.
AfxGetFolderCreationTime
Returns the time the folder was created, in local time format.
AfxGetFolderCreationTimeUTCStr
Returns the time the folder was created, in UTC format, as a string.
AfxGetFolderCreationTimeStr
Returns the time the folder was created, in local time format, as a string.
AfxGetFolderLastAccessTimeUTC
Returns the time the file was last accessed, in UTC format.
AfxGetFolderLastAccessTime
Returns the time the file was last accessed, in local time format.
AfxGetFolderLastAccessTimeUTCStr
Returns the time the file was last accessed, in UTC format, as a string.
AfxGetFolderLastAccessTimeStr
Returns the time the file was last accessed, in local time format, as a string.
AfxGetFolderLastWriteTimeUTC
Returns the time the file was last wriiten to, in UTC format.
AfxGetFolderLastWriteTime
Returns the time the file was last written to, in local time format.
AfxGetFolderLastWriteTimeUTCStr
Returns the time the folder was last written to, in UTC format, as a string.
AfxGetFolderLastWriteTimeStr
Returns the time the folder was last written to, in local time format, as a string.
AfxGetCompressedFileSize
Gets the size of a compressed file.
AfxGetDiskClusterSize
Gets the disk cluster size.
AfxGetDiskSectorsPerCluster
Gets the number of sectors per cluster.
AfxGetDiskBytesPerSector
Gets the number of bytes per sector.
AfxGetDiskFreeClusters
Gets the number of free clusters.
AfxGetDiskTotalNumberOfClusters
Gets the total number of clusters.
AfxGetFileDiskUsage
Gets the actual disk space used by a file.
AfxGetFileCount
Returns the number of files that meet the specified criteria.
AfxGetFolderSize
Returns the total size of the files that meet the specified criteria.
AfxGetFolderDiskUsage
Returns the total disk size in bytes of the files that meet the specified criteria.
AfxGetFolderTreeFileCount
Returns the number of files that meet the specified criteria in the specified folder and its subfolders.
AfxGetFolderTreeSize
Returns the size of the files that meet the specified criteria in the specified folder and its subfolders.
AfxGetFolderTreeDiskUsage
Returns the disk space used by the files that meet the specified criteria in the specified folder and its subfolders.
AfxGetFolderTreeSubfoldersCount
Returns the number of subfolders of the specified folder and its subfolders.
Version 2.02 of the Windows API Headers is available to download at:
http://www.jose.it-berater.org/smfforum/index.php?topic=4133.0
I have written new classes to wrap the ODBC API.
The object model is
COdbcEx Class
|__IOdbcEx Interface
|__ COdbcDbc Class
|__ IOdbcConnection Interface
|__ COdbcStatement Class
|__ IOdbcStatement
|__ COdbcDesc
|__ IOdbcDesc Interface
The COdbcEx class creates the environment handle and allows to create Connection objects.
The COdbcDbc class implements methods and properties to manage connections and allows to create Descriptor and Statement objects.
The COdbcEx class keeps a collection of Connection objects and the COdbcDbc class keeps a collection of descriptors and statements, keeping them alive until you remove them from the collection or destroy the class. This way, when you destroy a connection object, the class first closes cursors and frees handles of the descriptor and statement objects belonging to that connection, and when you destroy the COdbcEx class, it closes the connections and frees the environment handle.
The new classes also allow the use of Structured Error Handling, one of my favorite features.
An small example showing the basic steps:
' ========================================================================================
' Example of use of the COdbcEx class methods
' ========================================================================================
' CSED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "CODBCEX.INC"
' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN
' // Create an instance of the class
LOCAL pOdbc AS IOdbcEx
pOdbc = NewOdbcEx(%SQL_OV_ODBC3_80)
IF ISNOTHING(pOdbc) THEN EXIT FUNCTION
' // Create a connection
LOCAL pCon AS IOdbcConnection
pCon = pOdbc.Connection("Connection1")
IF ISNOTHING(pCon) THEN EXIT FUNCTION
TRY
' // Open the database
pCon.OpenDatabase("DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb;UID=;PWD=;")
' // Allocate an statement handle
LOCAL pStmt AS IOdbcStatement
pStmt = pCon.Statement("Statement1")
' // Cursor type
pStmt.SetMultiuserKeysetCursor
' // Generate a result set
pStmt.ExecDirect ("SELECT TOP 20 * FROM Authors ORDER BY Author")
' // Parse the result set
LOCAL strOutput AS STRING
DO
IF ISFALSE pStmt.Fetch THEN EXIT DO
strOutput = ""
strOutput += pStmt.GetDataString(1) & " "
strOutput += pStmt.GetDataString(2) & " "
strOutput += pStmt.GetDataString(3)
STDOUT strOutput
LOOP
CATCH
' // Display error information
STDOUT OdbcExOleErrorInfo(OBJRESULT)
WAITKEY$
END TRY
' // Destroy the class
pOdbc = NOTHING
WAITKEY$
END FUNCTION
' ========================================================================================
Assuming the referred ODBC wrapper CODBCEX.INC ain't the same as CODBC.INC, then it don't seem to be present in the WINAPI_II_02b package. The latter is though ...
Will be available in the next update, when PBWIN 10.02/PBCC 6.02 will be released. It will be called CODBC.INC, without the EX, since it will replace the previous one. During the lasts months I have been experimenting with all the new features of the compiler looking for the best ways. This new version is far superior because, among other things, it allows the use of structured error handling and has a cleaner syntax.
I also have made some changes to deal with tab controls. The method InsertTabPage adds or inserts tabs and creates associated windows to host the controls for the tab pages, and is fully High DPI aware.
' // Add tab pages
LOCAL pTabPage1, pTabPage2, pTabPage3 AS IWindow
pTabPage1 = pWindow.InsertTabPage(hTab, 0, "Tab 1", -1, 0, 0, CODEPTR(TabPage1_WndProc))
pTabPage2 = pWindow.InsertTabPage(hTab, 1, "Tab 2", -1, 0, 0, CODEPTR(TabPage2_WndProc))
pTabPage3 = pWindow.InsertTabPage(hTab, 2, "Tab 3", -1, 0, 0, CODEPTR(TabPage3_WndProc))
' // Add controls to the first page
pWindow.AddLabel(pTabPage1.hwnd, -1, "First name", 15, 15, 121, 21)
pWindow.AddLabel(pTabPage1.hwnd, -1, "Last name", 15, 50, 121, 21)
pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT1, "", 165, 15, 186, 21)
pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT2, "", 165, 50, 186, 21)
pWindow.AddButton(pTabPage1.hwnd, %IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, %BS_DEFPUSHBUTTON)
And this code takes care of hiding and showing the tab pages when you change the selected tab. It works with any number of tab pages and does not need to be changed even if you add or delete tabs at run time.
CASE %WM_NOTIFY
LOCAL nPage AS DWORD ' // Page number
LOCAL pTabPage AS IWindow ' // Tab page object reference
LOCAL tci AS TCITEM ' // TCITEM structure
LOCAL ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = lParam
SELECT CASE @ptnmhdr.idFrom
CASE %IDC_TAB
SELECT CASE @ptnmhdr.code
CASE %TCN_SELCHANGE
' // Show the selected page
nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
tci.mask = %TCIF_PARAM
TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
IF tci.lParam THEN
pTabPage = Ptr2Obj(tci.lParam)
IF ISOBJECT(pTabPage) THEN
ShowWindow pTabPage.hwnd, %SW_SHOW
pTabPage = NOTHING
END IF
END IF
CASE %TCN_SELCHANGING
' // Hide the current page
nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
tci.mask = %TCIF_PARAM
TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
IF tci.lParam THEN
pTabPage = Ptr2Obj(tci.lParam)
IF ISOBJECT(pTabPage) THEN
ShowWindow pTabPage.hwnd, %SW_HIDE
pTabPage = NOTHING
END IF
END IF
END SELECT
Full code of the template:
' ########################################################################################
' Microsoft Windows
' File: CW_TabCtrl.pbtpl
' Contents: Template - CWindow with a tab control
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 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.
' ########################################################################################
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "TabCtrl.inc" ' // Tab control wrappers
#INCLUDE ONCE "ComboBoxCtrl.inc" ' // Combo box control wrappers
#INCLUDE ONCE "ListBoxCtrl.inc" ' // List box control wrappers
' // Control identifiers
%IDC_TAB = 1001
%IDC_EDIT1 = 1002
%IDC_EDIT2 = 1003
%IDC_BTNSUBMIT = 1004
%IDC_COMBO = 1005
%IDC_LISTBOX = 1006
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
' SetProcessDPIAware
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
pWindow.CreateWindow(%NULL, "CWindow with a Tab control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Change the class style to remove flicker
pWindow.ClassStyle = %CS_DBLCLKS
' // Set the client size
pWindow.SetClientSize 470, 280
' // Center the window
pWindow.CenterWindow
' // Add a Tab control
LOCAL hTab AS DWORD
hTab = pWindow.AddTab(pWindow.hwnd, %IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 20)
' // Add tab pages
LOCAL pTabPage1, pTabPage2, pTabPage3 AS IWindow
pTabPage1 = pWindow.InsertTabPage(hTab, 0, "Tab 1", -1, 0, 0, CODEPTR(TabPage1_WndProc))
pTabPage2 = pWindow.InsertTabPage(hTab, 1, "Tab 2", -1, 0, 0, CODEPTR(TabPage2_WndProc))
pTabPage3 = pWindow.InsertTabPage(hTab, 2, "Tab 3", -1, 0, 0, CODEPTR(TabPage3_WndProc))
' // Add controls to the first page
pWindow.AddLabel(pTabPage1.hwnd, -1, "First name", 15, 15, 121, 21)
pWindow.AddLabel(pTabPage1.hwnd, -1, "Last name", 15, 50, 121, 21)
pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT1, "", 165, 15, 186, 21)
pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT2, "", 165, 50, 186, 21)
pWindow.AddButton(pTabPage1.hwnd, %IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, %BS_DEFPUSHBUTTON)
' // Add controls to the 2nd page
LOCAL hComboBox AS DWORD
hComboBox = pTabPage2.AddComboBox(pTabPage2.hwnd, %IDC_COMBO, "", 20, 20, 191, 105)
' // Add controls to the 3rd page
LOCAL hListBox AS DWORD
hListBox = pTabPage3.AddListBox(pTabPage3.hwnd, %IDC_LISTBOX, "", 15, 20, 161, 120)
' // Fill the controls with some data
LOCAL i AS LONG
FOR i = 1 TO 9
Combobox_AddString hComboBox, "Item" & STR$(i)
ListBox_AddString hListBox, "Item" & STR$(i)
NEXT
ComboBox_SetCurSel hComboBox, 0
ListBox_SetCurSel hListBox, 0
' // Display the first tab page
ShowWindow pTabPage1.hwnd, %SW_SHOW
' // Set the focus to the first tab
TabCtrl_SetCurFocus hTab, 0
' // 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
STATIC hInstance AS DWORD ' // Instance handle
STATIC lpc AS CREATESTRUCT PTR ' // Pointer to the creation parameters
STATIC pWindow AS IWindow ' // Reference to the IWindow interface
' // Process window mesages
SELECT CASE uMsg
CASE %WM_CREATE
' // Pointer to the creation parameters
lpc = lParam
' // Instance handle
hInstance = @lpc.hInstance
' // Get a reference to the IWindow interface from the CREATESTRUCT structure
pWindow = CWindow_GetObjectFromCreateStruct(lParam)
EXIT FUNCTION
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_DESTROY
' // End the application
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_NOTIFY
LOCAL nPage AS DWORD ' // Page number
LOCAL pTabPage AS IWindow ' // Tab page object reference
LOCAL tci AS TCITEM ' // TCITEM structure
LOCAL ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = lParam
SELECT CASE @ptnmhdr.idFrom
CASE %IDC_TAB
SELECT CASE @ptnmhdr.code
CASE %TCN_SELCHANGE
' // Show the selected page
nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
tci.mask = %TCIF_PARAM
TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
IF tci.lParam THEN
pTabPage = Ptr2Obj(tci.lParam)
IF ISOBJECT(pTabPage) THEN
ShowWindow pTabPage.hwnd, %SW_SHOW
pTabPage = NOTHING
END IF
END IF
CASE %TCN_SELCHANGING
' // Hide the current page
nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
tci.mask = %TCIF_PARAM
TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
IF tci.lParam THEN
pTabPage = Ptr2Obj(tci.lParam)
IF ISOBJECT(pTabPage) THEN
ShowWindow pTabPage.hwnd, %SW_HIDE
pTabPage = NOTHING
END IF
END IF
END SELECT
END SELECT
END SELECT
' // Pass unprocessed messages to Windows
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
SELECT CASE uMsg
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDC_BTNSUBMIT
IF HI(WORD, wParam) = %BN_CLICKED THEN
MSGBOX "Submit"
EXIT FUNCTION
END IF
END SELECT
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hBrush AS DWORD
LOCAL rc AS RECT
LOCAL tlb AS LOGBRUSH
SELECT CASE uMsg
CASE %WM_ERASEBKGND
GetClientRect hWnd, rc
' Create custom brush
tlb.lbStyle = %BS_SOLID
tlb.lbColor = &H00CB8734???
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(tlb)
' Erase background
FillRect wParam, rc, hBrush
DeleteObject hBrush
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 3 window procedure
' ========================================================================================
FUNCTION TabPage3_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hBrush AS DWORD
LOCAL rc AS RECT
LOCAL tlb AS LOGBRUSH
SELECT CASE uMsg
CASE %WM_ERASEBKGND
GetClientRect hWnd, rc
' Create custom brush
tlb.lbStyle = %BS_SOLID
tlb.lbColor = %GREEN
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(tlb)
' Erase background
FillRect wParam, rc, hBrush
DeleteObject hBrush
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
As soon as the new compiler updates will be released, I will begin to post examples. There were a couple of bugs that caused problems.
QuoteThis new version is far superior because, among other things, it allows the use of structured error handling and has a cleaner syntax.
For a second I couldn't help but thinking you compared your wrappers to ADO(X), but then I stopped reading into what you wrote, and just read that you meant your new and updated ODBC wrappers are far superior. God knows where that ADO(X) thought came from ...
When I try to log onto the Jose Roca website to obtain the include file, it indicates "registration has been disabled". Is this temporary, or it it no longer possible to obtain the include file for Windows? Thanks.
Auto registration was disabled because of excesive spam. Send me a personal message with your real name and a valid email address and I will register you manually.
I've taken a dip into the ODBC-wrappers for a little project, but ran into a snag when wanting to use column/field names to retrieve data rather than a column index.
After a look around in collected documentation, I thought a question would be far less time-consuming than messing about any further.
MsgBox( "Field «" & pStmt.ColName( 2 ) & "», Contains «" & pStmt.GetDataString( 2 ) & "»" )
Gives; "Field «Granberg», Contains «114.0167-10»" â€" from the first available post.
But
MsgBox( pStmt.GetDataString( "Granberg" ) )
Gives; "Nothing", but the error;
SQL error code: -1
Source: IODBCSTATEMENT.GETDATASTRING
GUID: {4A676737-470E-4921-AE0B-0129EF0E62C3}
Description: [Microsoft][ODBC Driver Manager] Invalid descriptor index
SqlState: 07009
Native error: 0
The sample code ("Basic Steps") are doing what I do, but it's getting me nowhere serving a regular string to the function â€" as if it only expects and accepts a index number.
Documentation that I've seen confirms the use of Column Names as an option to the Column Index, so I'm on hold ...
First check if you are using the correct version. My example uses pOdbc = NewOdbc(%SQL_OV_ODBC3_80) because I'm working with Windows 7 and ODBC version 3.8. If you are using XP, try using pOdbc = NewOdbc(%SQL_OV_ODBC3).
QuoteIf you are using XP, try using pOdbc = NewOdbc(%SQL_OV_ODBC3).
I have noticed the added(?) text in your source sample about this, so I'm up and running with creating the object as in the quote above.
Are you suggesting that access to the column data by it's name might not be supported prior to 3.8?
No. This capability depends on the ODBC driver used. Some drivers support it and others don't. With some drivers, you can't even read by ordinal first column 4 and then column 2, for example. Once you read a column, you no longer can read columns with a lower ordinal number.
That's just insane. Seems some developers shouldn't have gotten paid for their job ...
I'm away from my file collection/documentation now, but are there functions for testing the drivers capabilities?
What the class does is simple. Both the Execute and ExecDirect methods execute the statement and, if it succeeds, retrieve the column names of the result set and store them in a PowerCollection.
' =====================================================================================
' Executes a prepared statement, using the current values of the parameter marker
' variables if any parameter markers exist in the statement.
' =====================================================================================
METHOD Execute () AS INTEGER
LOCAL r AS INTEGER
r = SQLExecute(m_hStmt)
IF r = %SQL_ERROR OR r = %SQL_INVALID_HANDLE THEN
METHOD OBJRESULT = r
OleSetErrorInfo $IID_IOdbcStatement, "IODBCSTATEMENT." & FUNCNAME$, ME.ErrorInfo(r)
END IF
METHOD = r
' // Clear the collection of column names
IF ISNOTHING(m_pColNames) THEN EXIT METHOD
IF m_pColNames.Count THEN m_pColNames.Clear
' // Retrieve the column names
LOCAL i AS LONG, NumCols, colNameLen AS INTEGER
LOCAL szColName AS ASCIIZ * 255, bstrKey AS WSTRING
IF SQL_SUCCEEDED(r) THEN
r = SQLNumResultCols(m_hStmt, NumCols)
IF NumCols < 1 THEN EXIT METHOD
FOR i = 1 TO NumCols
r = SQLColAttribute(m_hStmt, i, %SQL_DESC_NAME, szColName, SIZEOF(szColName), colNameLen, BYVAL %NULL)
IF SQL_SUCCEEDED(r) = 0 THEN EXIT FOR
bstrKey = UCASE$(LEFT$(szColName, colNameLen))
m_pColNames.Add(bstrKey, i)
NEXT
END IF
END METHOD
' =====================================================================================
' =====================================================================================
' Executes the specified statement.
' =====================================================================================
METHOD ExecDirect (BYVAL SqlStr AS STRING) AS INTEGER
LOCAL r AS INTEGER
r = SQLExecDirect (m_hStmt, BYCOPY SqlStr, LEN(SqlStr))
IF r = %SQL_ERROR OR r = %SQL_INVALID_HANDLE THEN
METHOD OBJRESULT = r
OleSetErrorInfo $IID_IOdbcStatement, "IODBCSTATEMENT." & FUNCNAME$, ME.ErrorInfo(r)
END IF
METHOD = r
' // Clear the collection of column names
IF ISNOTHING(m_pColNames) THEN EXIT METHOD
IF m_pColNames.Count THEN m_pColNames.Clear
' // Retrieve the column names
LOCAL i AS LONG, NumCols, colNameLen AS INTEGER
LOCAL szColName AS ASCIIZ * 255, bstrKey AS WSTRING
IF SQL_SUCCEEDED(r) THEN
r = SQLNumResultCols(m_hStmt, NumCols)
IF NumCols < 1 THEN EXIT METHOD
FOR i = 1 TO NumCols
r = SQLColAttribute(m_hStmt, i, %SQL_DESC_NAME, szColName, SIZEOF(szColName), colNameLen, BYVAL %NULL)
IF SQL_SUCCEEDED(r) = 0 THEN EXIT FOR
bstrKey = UCASE$(LEFT$(szColName, colNameLen))
m_pColNames.Add(bstrKey, i)
NEXT
END IF
END METHOD
' =====================================================================================
GetDataString retrieves the column number from the collection and calls SQLGetData.
' =====================================================================================
' Returns the data in a specefied column as a string.
' =====================================================================================
METHOD GetDataString (BYVAL vColumn AS VARIANT, OPTIONAL BYVAL lMaxChars AS LONG) AS STRING
LOCAL r AS INTEGER, ColumnNumber AS WORD, s AS STRING, cbLen AS LONG
IF VARIANTVT(vColumn) = %VT_BSTR THEN
LOCAL bstrKey AS WSTRING
bstrKey = UCASE$(VARIANT$(vColumn))
LOCAL vCol AS VARIANT
IF ISNOTHING(m_pColNames) THEN EXIT METHOD
vCol = m_pColNames.Item(bstrKey)
ColumnNumber = VARIANT#(vCol)
ELSE
ColumnNumber = VARIANT#(vColumn)
END IF
IF lMaxChars < 1 THEN lMaxChars = 256
s = SPACE$(lMaxChars + 1) ' Make room for the null character
r = SQLGetData(m_hStmt, ColumnNumber, %SQL_C_CHAR, BYVAL STRPTR(s), LEN(s), cbLen)
IF cbLen <> %SQL_NULL_DATA THEN METHOD = LEFT$(s, cbLen)
IF r = %SQL_ERROR OR r = %SQL_INVALID_HANDLE THEN
METHOD OBJRESULT = r
OleSetErrorInfo $IID_IOdbcStatement, "IODBCSTATEMENT." & FUNCNAME$, ME.ErrorInfo(r)
END IF
END METHOD
' =====================================================================================
If you are using ExecDirect, check in this part of the code if the column names are being retrieved correctly.
LOCAL szColName AS ASCIIZ * 255, bstrKey AS WSTRING
IF SQL_SUCCEEDED(r) THEN
r = SQLNumResultCols(m_hStmt, NumCols)
IF NumCols < 1 THEN EXIT METHOD
FOR i = 1 TO NumCols
r = SQLColAttribute(m_hStmt, i, %SQL_DESC_NAME, szColName, SIZEOF(szColName), colNameLen, BYVAL %NULL)
IF SQL_SUCCEEDED(r) = 0 THEN EXIT FOR
bstrKey = UCASE$(LEFT$(szColName, colNameLen))
m_pColNames.Add(bstrKey, i)
NEXT
END IF
and, in GetDataString, if this part of the code is retrieving the correct column number.
IF VARIANTVT(vColumn) = %VT_BSTR THEN
LOCAL bstrKey AS WSTRING
bstrKey = UCASE$(VARIANT$(vColumn))
LOCAL vCol AS VARIANT
IF ISNOTHING(m_pColNames) THEN EXIT METHOD
vCol = m_pColNames.Item(bstrKey)
ColumnNumber = VARIANT#(vCol)
ELSE
ColumnNumber = VARIANT#(vColumn)
END IF