This version includes a subfolder called CGdiPlus with the GDI+ wrapper classes. In turn, CGdiPlus contains a subfolder called Examples with many small examples.
Besides the classes, the examples use CWindow and my graphic control, and are High DPI aware.
This example produces the output displayed in the capture. Notice the difference in sharpness running it at a DPI of 192.
' ########################################################################################
' Microsoft Windows
' File: StringFormatSetLineAlignment.bas
' Contents: GDI+ - StringFormatSetLineAlignment example
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CGdiPlus/CGdiPlus.inc"
#INCLUDE ONCE "Afx/CGraphCtx.inc"
USING Afx
CONST IDC_GRCTX = 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
' ========================================================================================
' The following example creates a StringFormat object, sets the trimming style, and uses
' the StringFormat object to draw a string. The code also draws the string's layout rectangle.
' ========================================================================================
SUB Example_SetLineAlignment (BYVAL hdc AS HDC)
' // Create a graphics object from the window device context
DIM graphics AS CGpGraphics = hdc
' // Get the DPI scaling ratio
DIM rxRatio AS SINGLE = graphics.GetDpiX / 96
' // Set the scale transform
graphics.ScaleTransform(rxRatio, rxRatio)
' // Create a red solid brush
DIM solidBrush AS CGpSolidBrush = GDIP_ARGB(255, 255, 0, 0)
' // Create a font family from name
DIM fontFamily AS CGpFontFamily = "Times New Roman"
' // Create a font from the font family
DIM pFont AS CGpFont = CGpFont(@fontFamily, 24, FontStyleRegular, UnitPixel)
' // Create a string format object and set the alignment
DIM stringFormat AS CGpStringFormat
stringFormat.SetLineAlignment(StringAlignmentCenter)
' // Use the cloned StringFormat object in a call to DrawString
DIM wszText AS WSTRING * 260 = "This text was formatted by a StringFormat object."
graphics.DrawString(@wszText, LEN(wszText), @pFont, 30, 30, 150, 200, @stringFormat, @solidBrush)
' // Draw the rectangle that encloses the text
DIM pen AS CGpPen = GDIP_ARGB(255, 255, 0, 0)
graphics.DrawRectangle(@pen, 30, 30, 150, 200)
END SUB
' ========================================================================================
' ========================================================================================
' 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 GDI+
DIM token AS ULONG_PTR = AfxGdipInit
' // Creates the main window
DIM pWindow AS CWindow
' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
pWindow.Create(NULL, "GDI+ StringFormatSetLineAlignment", @WndProc)
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, 250)
' // Centers the window
pWindow.Center
' // Add a graphic control
DIM pGraphCtx AS CGraphCtx = CGraphCtx(@pWindow, IDC_GRCTX, "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
pGraphCtx.Clear BGR(255, 255, 255)
' // Get the memory device context of the graphic control
DIM hdc AS HDC = pGraphCtx.GetMemDc
' // Draw the graphics
Example_SetLineAlignment(hdc)
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Shutdown GDI+
AfxGdipShutdown(token)
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
' ========================================================================================
It's fine to use the dotted syntax when the classes are created after GDI+ has been initialized with a call to AfxGdipInit and destroyed before a call to AfxGdipShutdown. Otherwise, you must use NEW to create the class and DELETE to destroy it.
Example:
' ########################################################################################
' Microsoft Windows
' File: MatrixEquals.bas
' Contents: GDI+ - MatrixEquals example
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define UNICODE
#INCLUDE ONCE "Afx/CGdiPlus/CGdiPlus.inc"
USING Afx
' // Initialize GDI+
DIM token AS ULONG_PTR = AfxGdipInit
' // Must be constructed with NEW to we able to delete them before the call to AfxGdipShutdown
DIM pMat1 AS CGpMatrix PTR = NEW CGpMatrix(1.0, 2.0, 1.0, 1.0, 2.0, 2.0)
DIM pMat2 AS CGpMatrix PTR = NEW CGpMatrix(1.0, 2.0, 1.0, 1.0, 2.0, 2.0)
IF pMat1->Equals(pMat2) THEN
PRINT "They are the same"
ELSE
PRINT "They are the different"
END IF
' // Must be deleted before the call to AfxGdipShutdown
Delete pMat1
Delete pMat2
' // Shutdown GDI+
AfxGdipShutdown(token)
PRINT
PRINT "Press any key"
SLEEP
If we had not used NEW and DELETE, the program will crash because Free Basic will try to destroy them when the variables went out of scope, AFTER Gdi+ has been shutdown.
WOW!!!!!! Very Impressive
Jose,
Haven't had a chance to do anything yet but I did notice no AfxCOM.inc with RC16.
New direction or oversight?
James
Jose,
I just tried to run a couple of the gdiplus examples and get this:
fbc -s gui "C:\FreeBASIC-1.05.0-win64\inc\Afx\CGdiPlus\Examples\Graphics\Clip.BAS"
C:\FreeBASIC-1.05.0-win64\inc\Afx\CGdiPlus\CGpBitmap.inc(825) error 41: Variable not declared, GdipGetMetafileHeaderFromWmf in 'RETURN SetStatus(GdipGetMetafileHeaderFromWmf(hWmf, wmfPFH, mh))'
Error(s) occured.
James
Compiles fine with 32 bit.
The headers for 32 bit and 64 bit are different. It is a truly MESS!
REM this function in CGpBitmap.inc.
' =====================================================================================
' The GetMetafileHeader method gets the metafile header of this metafile.
' Doesn't work with the 64-bit compiler.
' =====================================================================================
'PRIVATE FUNCTION CGpMetafile.GetMetafileHeader (BYVAL hWmf AS HMETAFILE, BYVAL wmfPFH AS WmfPlaceableFileHeader PTR, BYVAL mh AS MetafileHeader PTR) AS GpStatus
' RETURN SetStatus(GdipGetMetafileHeaderFromWmf(hWmf, wmfPFH, mh))
'END FUNCTION
' =====================================================================================
Why? I don't know. Did I say that the FB gdiplus headers are a MESS?
I have reuploaded Afx.rar with that function remed. Why the 64.bit compiler does not find it, when it is declared together with all the others in GdiplusFlat.bi, is beyond me. There are others that work with 64 bit, but not with 32 bit. I have needed to add an union and several helper functions because differences in the headers, etc. Why to have different headers for 32 and 64 bit?
Quote from: James Fuller on August 05, 2016, 08:26:06 PM
WOW!!!!!! Very Impressive
Jose,
Haven't had a chance to do anything yet but I did notice no AfxCOM.inc with RC16.
New direction or oversight?
James
If it was included in a previous version it was by mistake. They are just tests.
Well the problem is that the 64 bit compiler loads gdiplus-c.bi instead of GdiplusFlat.bi, and GdipGetMetafileHeaderFromWmf isn't defined in that header.
I was using the 32-bit compiler because it was the one that gave me more problems and didn't noticed it because I have added the metafile functions at the last minute. I haven't added support for effects, because the 32 bit compiler headers have not declarations for GDI+ 1.1.
Note: The StringFormatSetMeasurableCharacterRanges.bas example won't compile with the 64-bit compiler because the 64 bit headers lack a declare for the GdipMeasureCharacterRanges function.
I have completed the ODBC classes. Put the attached include files in a subfolder (suggested name CODBC) of the Afx folder.
The attached help file contains an updated version of CWindowHelp with the documentation for the ODBC classes.
Because I don't have updated drivers and databases in my computer, I only have been able to test them using the 32-bit compiler.
I have never used ODBC extensively, so I don't have expertise with SQL statements. With PB I used ADO, but as ADO is a COM technology and my work with COM isn't still mature, I have decided to offer ODBC support first.
It is not an small wrapper class to do just the essential, as many that I have seen, but wraps the entire ODBC API.
You create an instance of the CODBC class using:
' // Create a connection object and connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC PTR = NEW CODBC(wszConStr)
You create an statement object creating an instance of the COdbcStmt object passing the connection object pointer as the parameter:
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(pDbc)
IF pStmt = NULL THEN END
When the class is destroyed, its Destructor method closes the cursor and the connection and frees the allocated connection handle. Therefore, it is not needed to explicitly close the database and free handles. The class keeps track of the number of active connections and frees the environment handle if there are no active connections.
As FreeBASIC does not support structured error handling, I have provided an optional callback mechanism to report errors for debugging purposes.
Example of an application defined callback:
SUB ODBC_ErrorCallback (BYVAL nResult AS SQLRETURN, BYREF wszSrc AS WSTRING, BYREF wszErrorMsg AS WSTRING)
PRINT "Error: " & STR(nResult) & " - Source: " & wszSrc
IF LEN(wszErrorMsg) THEN PRINT wszErrorMsg
END SUB
You activate it passing the address of the callback to the connection and/or statement objects:
pDbc->SetErrorProc(@ODBC_ErrorCallback) ' // Sets the error callback for the connection object
pStmt->SetErrorProc(@ODBC_ErrorCallback) ' // Sets the error callback for the statement object
The classes pass to the error callback procedure the name of the method where the error has happened and a full description of the error as retrieved from the driver.
An small example that demonstrates how to open a database and retrieve data:
#include once "Afx/COdbc/COdbc.inc"
USING Afx
' // Error callback procedure
SUB ODBC_ErrorCallback (BYVAL nResult AS SQLRETURN, BYREF wszSrc AS WSTRING, BYREF wszErrorMsg AS WSTRING)
PRINT "Error: " & STR(nResult) & " - Source: " & wszSrc
IF LEN(wszErrorMsg) THEN PRINT wszErrorMsg
END SUB
' // Create a connection object and connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC PTR = NEW CODBC(wszConStr)
IF pDbc = NULL THEN END
' // Set the address of the error callback for the connection object
pDbc->SetErrorProc(@ODBC_ErrorCallback)
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(pDbc)
IF pStmt = NULL THEN END
' // Set the address of the error callback for the statement object
pStmt->SetErrorProc(@ODBC_ErrorCallback)
' // Generate a result set with the first 20 records
pStmt->ExecDirect ("SELECT TOP 20 * FROM Authors ORDER BY Author")
'pStmt->ExecDirect ("SELECT * FROM Authors ORDER BY Author")
' // Parse the result set
DIM cwsOutput AS CWSTR
DO
' // Fetch the record
IF pStmt->Fetch = FALSE THEN EXIT DO
' // Get the values of the columns and display them
cwsOutput = ""
' // We can retrieve the data passing the column number
cwsOutput += pStmt->GetData(1) & " "
cwsOutput += pStmt->GetData(2) & " "
cwsOutput += pStmt->GetData(3)
' // or the column name
' cwsOutput += pStmt->GetData("Au_ID") & " "
' cwsOutput += pStmt->GetData("Author") & " "
' cwsOutput += pStmt->GetData("Year Born")
PRINT cwsOutput
LOOP
' // Delete the statement object
Delete pStmt
' // Delete the connection object
Delete pDbc
PRINT
PRINT "Press any key..."
SLEEP
The easier way to deal with the data is to use ExecDirect with an SQL statement, e.g.
#include once "Afx/COdbc/COdbc.inc"
USING Afx
' // Error callback procedure
SUB ODBC_ErrorCallback (BYVAL nResult AS SQLRETURN, BYREF wszSrc AS WSTRING, BYREF wszErrorMsg AS WSTRING)
PRINT "Error: " & STR(nResult) & " - Source: " & wszSrc
IF LEN(wszErrorMsg) THEN PRINT wszErrorMsg
END SUB
' // Connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC = wszConStr
' // Set the address of the error callback for the connection object
pDbc.SetErrorProc(@ODBC_ErrorCallback)
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(@pDbc)
IF pStmt = NULL THEN END
' // Set the address of the error callback for the connection object
pStmt->SetErrorProc(@ODBC_ErrorCallback)
' // Insert a new record
pStmt->ExecDirect ("INSERT INTO Authors (Au_ID, Author, [Year Born]) VALUES ('999', 'Jose Roca', 1950)")
IF pStmt->Error = FALSE THEN PRINT "Record added"
' // Delete the statement
Delete pStmt
PRINT
PRINT "Press any key..."
SLEEP
An speedier but more cumbersone way is to bind parameters or use prepared statements, e.g.
Add record example:
#include once "Afx/COdbc/COdbc.inc"
USING Afx
' // Error callback procedure
SUB ODBC_ErrorCallback (BYVAL nResult AS SQLRETURN, BYREF wszSrc AS WSTRING, BYREF wszErrorMsg AS WSTRING)
PRINT "Error: " & STR(nResult) & " - Source: " & wszSrc
IF LEN(wszErrorMsg) THEN PRINT wszErrorMsg
END SUB
' // Connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC = wszConStr
' // Set the address of the error callback for the connection object
pDbc.SetErrorProc(@ODBC_ErrorCallback)
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(@pDbc)
IF pStmt = NULL THEN END
' // Set the address of the error callback for the statement object
pStmt->SetErrorProc(@ODBC_ErrorCallback)
' // Cursor type
pStmt->SetMultiuserKeysetCursor
' // Bind the columns
DIM AS LONG lAuId, cbAuId
pStmt->BindCol(1, @lAuId, @cbAuId)
DIM wszAuthor AS WSTRING * 256, cbAuthor AS LONG
pStmt->BindCol(2, @wszAuthor, 256, @cbAuthor)
DIM iYearBorn AS SHORT, cbYearBorn AS LONG
pStmt->BindCol(3, @iYearBorn, @cbYearBorn)
' // Generate a result set
pStmt->ExecDirect ("SELECT * FROM Authors")
' // Fill the values of the binded application variables and its sizes
lAuId = 999
cbAuID = SIZEOF(lAuId)
wszAuthor = "Edgar Allan Poe"
cbAuthor = LEN(wszAuthor) * 2 ' Unicode uses 2 bytes per character
iYearBorn = 1809
cbYearBorn = SIZEOF(iYearBorn)
' // Add the record
pStmt->AddRecord
IF pStmt->Error = FALSE THEN PRINT "Record added"
' // Delete the statement
Delete pStmt
PRINT
PRINT "Press any key..."
SLEEP
Update record example:
' // Note: Don't use "update" in the name of the program. Windows don't like it.
#include once "Afx/COdbc/COdbc.inc"
USING Afx
' // Error callback procedure
SUB ODBC_ErrorCallback (BYVAL nResult AS SQLRETURN, BYREF wszSrc AS WSTRING, BYREF wszErrorMsg AS WSTRING)
PRINT "Error: " & STR(nResult) & " - Source: " & wszSrc
IF LEN(wszErrorMsg) THEN PRINT wszErrorMsg
END SUB
' // Connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC = wszConStr
' // Set the address of the error callback for the connection object
pDbc.SetErrorProc(@ODBC_ErrorCallback)
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(@pDbc)
IF pStmt = NULL THEN END
' // Set the address of the error callback for the statement object
pStmt->SetErrorProc(@ODBC_ErrorCallback)
' // Cursor type
pStmt->SetMultiuserKeysetCursor
' // Bind the columns
DIM AS LONG lAuId, cbAuId
pStmt->BindCol(1, @lAuId, @cbAuId)
DIM wszAuthor AS WSTRING * 256, cbAuthor AS LONG
pStmt->BindCol(2, @wszAuthor, 256, @cbAuthor)
DIM iYearBorn AS SHORT, cbYearBorn AS LONG
pStmt->BindCol(3, @iYearBorn, @cbYearBorn)
' // Generate a result set
pStmt->ExecDirect ("SELECT * FROM Authors WHERE Au_Id=999")
' // Fetch the record
pstmt->Fetch
' // Fill the values of the binded application variables and its sizes
cbAuID = SQL_COLUMN_IGNORE
wszAuthor = "Félix Lope de Vega Carpio"
cbAuthor = LEN(wszAuthor) * 2 ' Unicode uses 2 bytes per character
iYearBorn = 1562
cbYearBorn = SIZEOF(iYearBorn)
' // Update the record
pStmt->UpdateRecord
IF pStmt->Error = FALSE THEN PRINT "Record updated"
' // Delete the statement
Delete pStmt
PRINT
PRINT "Press any key..."
SLEEP
Delete record example:
#include once "Afx/COdbc/COdbc.inc"
USING Afx
' // Error callback procedure
SUB ODBC_ErrorCallback (BYVAL nResult AS SQLRETURN, BYREF wszSrc AS WSTRING, BYREF wszErrorMsg AS WSTRING)
PRINT "Error: " & STR(nResult) & " - Source: " & wszSrc
IF LEN(wszErrorMsg) THEN PRINT wszErrorMsg
END SUB
' // Connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC = wszConStr
' // Set the address of the error callback for the connection object
pDbc.SetErrorProc(@ODBC_ErrorCallback)
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(@pDbc)
IF pStmt = NULL THEN END
' // Set the address of the error callback for the statement object
pStmt->SetErrorProc(@ODBC_ErrorCallback)
' // Cursor type
pStmt->SetMultiuserKeysetCursor
' // Bind the columns
DIM AS LONG lAuId, cbAuId
pStmt->BindCol(1, @lAuId, @cbAuId)
DIM wszAuthor AS WSTRING * 256, cbAuthor AS LONG
pStmt->BindCol(2, @wszAuthor, 256, @cbAuthor)
DIM iYearBorn AS SHORT, cbYearBorn AS LONG
pStmt->BindCol(3, @iYearBorn, @cbYearBorn)
' // Generate a result set
pStmt->ExecDirect ("SELECT * FROM Authors WHERE Au_Id=999")
' // Fetch the record
pstmt->Fetch
' // Fill the values of the binded application variables and its sizes
cbAuID = SQL_COLUMN_IGNORE
wszAuthor = "Félix Lope de Vega Carpio"
cbAuthor = LEN(wszAuthor) * 2 ' Unicode uses 2 bytes per character
iYearBorn = 1562
cbYearBorn = SIZEOF(iYearBorn)
' // Delete the record
pStmt->DeleteRecord
IF pStmt->Error = FALSE THEN PRINT "Record deleted"
' // Delete the statement
Delete pStmt
PRINT
PRINT "Press any key..."
SLEEP
There are plenty of methods that provide all kind of information.
In the following example, we are using NumResultCols and ColName to retrieve the names of the columns of the result set.
#include once "Afx/COdbc/COdbc.inc"
USING Afx
' // Connect with the database
DIM wszConStr AS WSTRING * 260 = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=biblio.mdb"
DIM pDbc AS CODBC = wszConStr
' // Allocate an statement object
DIM pStmt AS COdbcStmt PTR = NEW COdbcStmt(@pDbc)
IF pStmt = NULL THEN END
' // Generate a result set
pStmt->ExecDirect ("SELECT * FROM Authors ORDER BY Author")
' // Retrieve the number of columns
DIM numCols AS SQLSMALLINT = pStmt->NumResultCols
PRINT "Number of columns:" & STR(numCols)
' // Retrieve the names of the fields (columns)
FOR idx AS LONG = 1 TO numCols
PRINT "Field #" & STR(idx) & " name: " & pStmt->ColName(idx)
NEXT
' // Delete the statement
Delete pStmt
PRINT
PRINT "Press any key..."
SLEEP
In the above example, I have used the dotted syntax for the connection object. We can do it if the connection will be alive until the application ends, but if the connection is temporary we must use NEW and the pointer syntax, to be able to delette the connection object with Delete when no longer needed.
Wow, that is an amazing amount of work! Thanks Jose, I am always impressed at the amount of code that you can create in such a short period of time. I, also don't use ODBC very much. I think the last time was with FoxPro database files and that was like 10 years ago. I use SQLite for local database and most recently MySQL for anything online/internet based related.
The number of tools for FB is growing!
I have finished the documentation of the GDI+ classes. About 600 methods!
CTextStream Class.
Allows to read and write text files. Works with ascii and unicode. Works with Windows CRLF files and with Linux LF files. You must use CBSTR strings, not CWSTR.
' ########################################################################################
' Microsoft Windows
' File: CTextStream.inc
' Contents: Wrapper class for reading and writing text files.
' Compiler: FreeBasic 32 & 64-bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#pragma once
#include once "windows.bi"
#include once "Afx/AfxScrRun.bi"
#include once "Afx/CWStr.inc"
NAMESPACE Afx
' ########################################################################################
' CTextStream - Class for reading and writing text files.
' ########################################################################################
TYPE CTextStream
Public:
DIM m_Result AS HRESULT
DIM m_pFileSys AS Afx_IFileSystem PTR
DIM m_pTxtStm AS Afx_ITextStream PTR
Public:
DECLARE CONSTRUCTOR
DECLARE DESTRUCTOR
DECLARE FUNCTION GetLastResult () AS HRESULT
DECLARE FUNCTION SetResult (BYVAL Result AS HRESULT) AS HRESULT
DECLARE FUNCTION Create (BYREF cbsFileName AS CBSTR, BYVAL bOverwrite AS BOOLEAN = TRUE, BYVAL bUnicode AS BOOLEAN = FALSE) AS HRESULT
DECLARE FUNCTION Open (BYREF cbsFileName AS CBSTR, BYVAL IOMode AS LONG = 1, BYVAL bCreate AS BOOLEAN = FALSE, BYVAL bUnicode AS BOOLEAN = FALSE) AS HRESULT
DECLARE FUNCTION OpenUnicode (BYREF cbsFileName AS CBSTR, BYVAL IOMode AS LONG = 1, BYVAL bCreate AS BOOLEAN = FALSE) AS HRESULT
DECLARE FUNCTION Close () AS HRESULT
DECLARE PROPERTY Line () AS LONG
DECLARE PROPERTY Column () AS LONG
DECLARE FUNCTION EOS () AS BOOLEAN
DECLARE FUNCTION EOL () AS BOOLEAN
DECLARE FUNCTION Read (BYVAL numChars AS LONG) AS CBSTR
DECLARE FUNCTION ReadLine () AS CBSTR
DECLARE FUNCTION ReadAll () AS CBSTR
DECLARE FUNCTION Write (BYREF cbsText AS CBSTR) AS HRESULT
DECLARE FUNCTION WriteLine (BYREF cbsText AS CBSTR) AS HRESULT
DECLARE FUNCTION WriteBlankLines (BYVAL numLines AS LONG) AS HRESULT
DECLARE FUNCTION Skip (BYVAL numChars AS LONG) AS HRESULT
DECLARE FUNCTION SkipLine () AS HRESULT
END TYPE
' ########################################################################################
' ========================================================================================
' Constructor
' ========================================================================================
CONSTRUCTOR CTextStream
' // Create an instance of the Filesystem object
DIM CLSID_FileSystemObject_ AS GUID = (&h0D43FE01, &hF093, &h11CF, {&h89, &h40, &h00, &hA0, &hC9, &h05, &h42, &h28})
DIM IID_IFileSystem AS GUID = (&h0AB5A3D0, &hE5B6, &h11D0, {&hAB, &hF5, &h00, &hA0, &hC9, &h0F, &hFF, &hC0})
SetResult(CoCreateInstance(@CLSID_FileSystemObject_, NULL, CLSCTX_INPROC_SERVER, @IID_IFileSystem, @m_pFileSys))
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' Constructor
' ========================================================================================
DESTRUCTOR CTextStream
IF m_pTxtStm THEN
m_pTxtStm->Close
m_pTxtStm->Release
END IF
IF m_pFileSys THEN m_pFileSys->Release
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
' Returns the last status code.
' ========================================================================================
PRIVATE FUNCTION CTextStream.GetLastResult () AS HRESULT
RETURN m_Result
END FUNCTION
' ========================================================================================
' ========================================================================================
' Sets the last status code.
' ========================================================================================
PRIVATE FUNCTION CTextStream.SetResult (BYVAL Result AS HRESULT) AS HRESULT
m_Result = Result
RETURN m_Result
END FUNCTION
' ========================================================================================
' ========================================================================================
' Creates a specified file name and returns a TextStream object that can be used to read
' from or write to the file.
' Parameters:
' - bstrFileName: String expression that identifies the file to create.
' - bOverwrite: Boolean value that indicates whether you can overwrite an existing file.
' The value is true if the file can be overwritten, false if it can't be overwritten.
' If omitted, existing files are not overwritten.
' - bUnicode: Boolean value that indicates whether the file is created as a Unicode or
' ASCII file. The value is true if the file is created as a Unicode file, false if it's
' created as an ASCII file. If omitted, an ASCII file is assumed.
' ========================================================================================
PRIVATE FUNCTION CTextStream.Create (BYREF cbsFileName AS CBSTR, BYVAL bOverwrite AS BOOLEAN = TRUE, BYVAL bUnicode AS BOOLEAN = FALSE) AS HRESULT
IF m_pTxtStm THEN
SetResult(m_pTxtStm->Close)
m_pTxtStm->Release
m_pTxtStm = NULL
END IF
RETURN SetResult(m_pFileSys->CreateTextFile(**cbsFileName, bOverwrite, bUnicode, @m_pTxtStm))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Opens a specified file and returns a TextStream object that can be used to read from,
' write to, or append to the file.
' Parameters:
' - bstrFileName: String expression that identifies the file to open.
' - IOMode: Can be one of three constants: IOMODE_ForReading, IOMODE_ForWriting, or IOMODE_ForAppending.
' - bCreate: Value that indicates whether a new file can be created if the specified
' filename doesn't exist. The value is True if a new file is created, False if it isn't
' created. If omitted, a new file isn't created.
' - bUnicode: TRUE or FALSE. Indicates the format of the opened file. If omitted, the file
' is opened as ASCII.
' ========================================================================================
PRIVATE FUNCTION CTextStream.Open (BYREF cbsFileName AS CBSTR, BYVAL IOMode AS LONG = 1, BYVAL bCreate AS BOOLEAN = FALSE, BYVAL bUnicode AS BOOLEAN = FALSE) AS HRESULT
IF m_pTxtStm THEN
SetResult(m_pTxtStm->Close)
m_pTxtStm->Release
m_pTxtStm = NULL
END IF
RETURN SetResult(m_pFileSys->OpenTextFile(**cbsFileName, IOMode, bCreate, bUnicode, @m_pTxtStm))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Opens a specified file and returns a TextStream object that can be used to read from,
' write to, or append to the file.
' Parameters:
' - bstrFileName: String expression that identifies the file to open.
' - IOMode: Can be one of three constants: IOMODE_ForReading, IOMODE_ForWriting, or IOMODE_ForAppending.
' - bCreate: Value that indicates whether a new file can be created if the specified
' filename doesn't exist. The value is True if a new file is created, False if it isn't
' created. If omitted, a new file isn't created.
' ========================================================================================
PRIVATE FUNCTION CTextStream.OpenUnicode (BYREF cbsFileName AS CBSTR, BYVAL IOMode AS LONG = 1, BYVAL bCreate AS BOOLEAN = FALSE) AS HRESULT
IF m_pTxtStm THEN
SetResult(m_pTxtStm->Close)
m_pTxtStm->Release
m_pTxtStm = NULL
END IF
RETURN SetResult(m_pFileSys->OpenTextFile(**cbsFileName, IOMode, bCreate, Tristate_True, @m_pTxtStm))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Closes an open TextStream file.
' ========================================================================================
PRIVATE FUNCTION CTextStream.Close () AS HRESULT
IF m_pTxtStm THEN
RETURN(SetResult(m_pTxtStm->Close))
m_pTxtStm = NULL
END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
' Read-only property that returns the current line number in a TextStream file.
' After a file is initially opened and before anything is written, Line is equal to 1.
' ========================================================================================
PRIVATE PROPERTY CTextStream.Line () AS LONG
DIM nLine AS LONG
IF m_pTxtStm THEN SetResult(m_pTxtStm->get_Line(@nLine))
PROPERTY = nLine
END PROPERTY
' ========================================================================================
' ========================================================================================
' Read-only property that returns the column number of the current character position in a
' TextStream file. After a newline character has been written, but before any other character
' is written, Column is equal to 1.
' ========================================================================================
PRIVATE PROPERTY CTextStream.Column () AS LONG
DIM nColumn AS LONG
IF m_pTxtStm THEN SetResult(m_pTxtStm->get_Column(@nColumn))
PROPERTY = nColumn
END PROPERTY
' ========================================================================================
' ========================================================================================
' Returns TRUE if the file pointer is at the end of a TextStream file; FALSE if it is not. Read-only.
' ========================================================================================
PRIVATE FUNCTION CTextStream.EOS () AS BOOLEAN
DIM nEOS AS VARIANT_BOOL
IF m_pTxtStm THEN SetResult(m_pTxtStm->get_AtEndOfStream(@nEOS))
RETURN nEOS
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns TRUE if the file pointer is positioned immediately before the end-of-line marker
' in a TextStream file; FALSE if it is not. Read-only.
' ========================================================================================
PRIVATE FUNCTION CTextStream.EOL () AS BOOLEAN
DIM nEOL AS VARIANT_BOOL
IF m_pTxtStm THEN SetResult(m_pTxtStm->get_AtEndOfLine(@nEOL))
RETURN nEOL
END FUNCTION
' ========================================================================================
' ========================================================================================
' Reads a specified number of characters from a TextStream file and returns the resulting string.
' After a file is initially opened and before anything is written, Line is equal to 1.
' ========================================================================================
PRIVATE FUNCTION CTextStream.Read (BYVAL numChars AS LONG) AS CBSTR
DIM cbsText AS CBSTR
IF m_pTxtStm THEN SetResult(m_pTxtStm->Read(numChars, @cbsText))
RETURN cbsText
END FUNCTION
' ========================================================================================
' ========================================================================================
' Reads an entire line (up to, but not including, the newline character) from a TextStream
' file and returns the resulting string.
' ========================================================================================
PRIVATE FUNCTION CTextStream.ReadLine () AS CBSTR
DIM cbsText AS CBSTR
IF m_pTxtStm THEN SetResult(m_pTxtStm->ReadLine(@cbsText))
RETURN cbsText
END FUNCTION
' ========================================================================================
' ========================================================================================
' Reads an entire TextStream file and returns the resulting string.
' ========================================================================================
PRIVATE FUNCTION CTextStream.ReadAll () AS CBSTR
DIM cbsText AS CBSTR
IF m_pTxtStm THEN SetResult(m_pTxtStm->ReadAll(@cbsText))
RETURN cbsText
END FUNCTION
' ========================================================================================
' ========================================================================================
' Writes a specified string to a TextStream file.
' ========================================================================================
PRIVATE FUNCTION CTextStream.Write (BYREF cbsText AS CBSTR) AS HRESULT
IF m_pTxtStm THEN RETURN(SetResult(m_pTxtStm->Write(*cbsText)))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Writes a specified string and newline character to a TextStream file.
' ========================================================================================
PRIVATE FUNCTION CTextStream.WriteLine (BYREF cbsText AS CBSTR) AS HRESULT
IF m_pTxtStm THEN RETURN(SetResult(m_pTxtStm->WriteLine(*cbsText)))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Writes a specified number of newline characters to a TextStream file.
' ========================================================================================
PRIVATE FUNCTION CTextStream.WriteBlankLines (BYVAL numLines AS LONG) AS HRESULT
IF m_pTxtStm THEN RETURN(SetResult(m_pTxtStm->WriteBlankLines(numLines)))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Skips a specified number of characters when reading a TextStream file.
' ========================================================================================
PRIVATE FUNCTION CTextStream.Skip (BYVAL numChars AS LONG) AS HRESULT
IF m_pTxtStm THEN RETURN(SetResult(m_pTxtStm->Skip(numChars)))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Skips the next line when reading a TextStream file.
' ========================================================================================
PRIVATE FUNCTION CTextStream.SkipLine () AS HRESULT
IF m_pTxtStm THEN RETURN(SetResult(m_pTxtStm->SkipLine))
END FUNCTION
' ========================================================================================
END NAMESPACE
Usage examples:
#include "windows.bi"
#include "Afx/AfxScrRun.bi"
#include "Afx/CTextStream.inc"
using Afx
' // Initialize the COM library
CoInitialize NULL
' // Create an instance of the CTextStream class
DIM pTxtStm AS CTextStream PTR = NEW CTextStream
IF pTxtStm = NULL THEN END
' // Create a text stream
DIM wszFile AS WSTRING * MAX_PATH = ExePath & "\Test.txt"
pTxtStm->Create(wszFile, TRUE)
' // Write a string and an end of line to the stream
pTxtStm->WriteLine "This is a test."
' // Write more strings
pTxtStm->Write "This is a string."
pTxtStm->Write "This is a second string."
' // Write two blank lines (the first will serve as an end of line for the previous write instructions)
pTxtStm->WriteBlankLines 2
pTxtStm->WriteLine "This is the end line."
' // Close the file (not needed if we are going to delete the class)
pTxtStm->Close
' // Delete the class
Delete pTxtStm
' // Uninitialize the COM library
CoUninitialize
PRINT
PRINT "Press any key..."
SLEEP
#include "windows.bi"
#include "Afx/AfxScrRun.bi"
#include "Afx/CTextStream.inc"
using Afx
' // Initialize the COM library
CoInitialize NULL
' // Create an instance of the CTextStream class
DIM pTxtStm AS CTextStream PTR = NEW CTextStream
IF pTxtStm = NULL THEN END
' // Create a text stream
DIM wszFile AS WSTRING * MAX_PATH = ExePath & "\Test.txt"
pTxtStm->Create(wszFile, TRUE)
' // Write a string and an end of line to the stream
pTxtStm->WriteLine "This is a test."
' // Write more strings
pTxtStm->WriteLine "This is a string."
pTxtStm->WriteLine "This is a second string."
pTxtStm->WriteLine "This is the end line."
' // Close the file (not needed if we are going to delete the class)
pTxtStm->Close
' // Delete the class
Delete pTxtStm
' // Uninitialize the COM library
CoUninitialize
PRINT
PRINT "Press any key..."
SLEEP
#include "windows.bi"
#include "Afx/AfxScrRun.bi"
#include "Afx/CTextStream.inc"
using Afx
' // Initialize the COM library
CoInitialize NULL
' // Create an instance of the CTextStream class
DIM pTxtStm AS CTextStream PTR = NEW CTextStream
IF pTxtStm = NULL THEN END
' // Create a unicode text stream
DIM wszFile AS WSTRING * MAX_PATH = ExePath & "\Test.txt"
pTxtStm->Create(wszFile, TRUE, TRUE)
' // Write a string and an end of line to the stream
pTxtStm->WriteLine "This is a test."
' // Write more strings
pTxtStm->WriteLine "This is a string."
pTxtStm->WriteLine "This is a second string."
pTxtStm->WriteLine "This is the end line."
' // Close the file (not needed if we are going to delete the class)
pTxtStm->Close
' // Delete the class
Delete pTxtStm
' // Uninitialize the COM library
CoUninitialize
PRINT
PRINT "Press any key..."
SLEEP
#include "windows.bi"
#include "Afx/AfxScrRun.bi"
#include "Afx/CTextStream.inc"
using Afx
' // Initialize the COM library
CoInitialize NULL
' // Create an instance of the CTextStream class
DIM pTxtStm AS CTextStream PTR = NEW CTextStream
IF pTxtStm = NULL THEN END
' // Open file as a text stream
DIM wszFile AS WSTRING * MAX_PATH = ExePath & "\Test.txt"
pTxtStm->OpenUnicode(wszFile, IOMode_ForReading)
' // Read the file sequentially
DO
' // Ext if we are at the end of the stream
IF pTxtStm->EOS THEN EXIT DO
' // Current line
DIM curLine AS LONG = pTxtStm->Line
' // Skip the 3rd line
IF curLine = 3 THEN
pTxtStm->SkipLine
curLine + = 1
END IF
' // Skip 10 characters
pTxtStm->Skip 10
' // Current column
DIM curColumn AS LONG = pTxtStm->Column
' // Read 5 characters
DIM cbsText AS CBSTR = pTxtStm->Read(5)
' // Skip the rest of the line
pTxtStm->SkipLine
PRINT "Line " & STR(curLine) & ", Column " & STR(curColumn) & ": " & cbsText
LOOP
' // Close the file (not needed if we are going to delete the class)
pTxtStm->Close
' // Delete the class
Delete pTxtStm
' // Uninitialize the COM library
CoUninitialize
PRINT
PRINT "Press any key..."
SLEEP
#include "windows.bi"
#include "Afx/AfxScrRun.bi"
#include "Afx/CTextStream.inc"
using Afx
' // Initialize the COM library
CoInitialize NULL
' // Create an instance of the CTextStream class
DIM pTxtStm AS CTextStream PTR = NEW CTextStream
IF pTxtStm = NULL THEN END
' // Open file as a text stream
DIM wszFile AS WSTRING * MAX_PATH = ExePath & "\Test.txt"
pTxtStm->Open(wszFile, IOMode_ForReading)
' // Read all the contents of the file
DIM cbsText AS CBSTR = pTxtStm->ReadAll
PRINT cbsText
' // Close the file (not needed if we are going to delete the class)
pTxtStm->Close
' // Delete the class
Delete pTxtStm
' // Uninitialize the COM library
CoUninitialize
PRINT
PRINT "Press any key..."
SLEEP
AfxScrRun.bi needs this include file or it will fail in some cases.
#include once "win/ole2.bi"
The attachment contains an updated header.
As a proof of concept, I'm working in a wrapper class for IWinHTTP. This interface makes heavy use of optional byval variants, so its use with FB doing straight vtable calls is cumbersome. Therefore, I'm wrapping the methods to avoid the use of variants by hidding the VARIANTs and SAFEARRAYs stuff inside them.
For example:
' ========================================================================================
' Retrieves the response entity body as an array of unsigned bytes. This array contains
' the raw data as received directly from the server.
' Result code (GetLastResult):
' The result code is S_OK on success or an error value otherwise.
' Remarks: This function returns the response data in an array of unsigned bytes. If the
' response does not have a response body, an empty variant is returned. This property can
' only be invoked after the Send method has been called.
' ========================================================================================
PRIVATE FUNCTION CWinHttp.GetResponseBody () AS STRING
DIM vBody AS VARIANT, buffer AS STRING
IF m_pWinHttp THEN SetResult(m_pWinHttp->get_ResponseBody(@vBody))
IF m_Result = S_OK THEN
DIM pvData AS ANY PTR
IF vBody.pArray THEN
DIM lLBound AS LONG, lUBound AS LONG
SetResult(SafeArrayGetLBound(vBody.pArray, 1, @lLBound))
SetResult(SafeArrayGetUBound(vBody.pArray, 1, @lUBound))
DIM cElements AS LONG = lUBound - lLBound + 1
SafeArrayAccessData(vBody.pArray, @pvData)
IF pvData THEN
buffer = SPACE(cElements)
memcpy STRPTR(buffer), pvData, cElements
END IF
SafeArrayUnaccessData(vBody.pArray)
END IF
END IF
VariantClear(@vBody)
RETURN buffer
END FUNCTION
' ========================================================================================
In the past, I did something similar with PowerBASIC before it added COM support.
Neither the WinHTTP API functions nor the WinHTTP interface are supported in the FB declares.