CWindow Release Candidate 31

[José Roca]

As the bigger numeric variable supported by FreeBasic is a long integer, if we want to set bigger values we need to use strings, e.g.

Code Select Expand


DIM dec AS CDEC = "-79228162514264337593543950.335"
--or--
DIM dec AS CDEC = "-79,228,162,514,264,337,593,543,950.335"


By default, the locale user identifier is used. Therefore, in my Spanish computer I need to use "," as the decimal separator and "." as the thousands separator.

Code Select Expand


DIM dec AS CDEC = "-79.228.162.514.264.337.593.543.950,335"


But it can be overriden by passing an LCID value (1033 for US).

Code Select Expand


DIM dec AS CDEC = CDEC("-79,228,162,514,264,337,593,543,950.335", 1033)


[José Roca]

It seems to be working fine. If anybody wants to try iy, download the attached file.

If you still need bigger numbers, there are open source big numbers libraries available, but CCUR and CDEC can be used to store currency (8 bytes) and decimal (16 bytes) in databases as true numeric types. not as strings.

[José Roca]

Two new collections: CStack and CQueue.

Because the framework has a safe array class, the implementation of these collections has been trivial. Two differences less with PowerBasic. As it uses variants, you can push/pop, queue/dequeue almost any kind of data.

It has also been useful to discover that the CSafeArray class had a little bug: After destroying the data it was locking the descriptor, making it impossible to add new elements.

The attached file contains the updated CSafeArray.inc file and CStack.inc.

Usage example:

Code Select Expand


'#CONSOLE ON
#INCLUDE ONCE "Afx/CStack.inc"
using Afx

DIM pStack AS CStack
pStack.Push "String 1"
pStack.Push "String 2"
DIM cv AS CVAR = pStack.Pop
print cv.ToStr
cv = pStack.Pop
print cv.ToStr
' --or--
'print pStack.Pop.ToStr
'print pStack.Pop.ToStr

print

DIM pQueue AS CQueue
pQueue.Enqueue "String 1"
pQueue.Enqueue 12345.12
print pQueue.Dequeue.ToStr
print pQueue.Dequeue.ToStr

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

Source code of the stack classes:

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CStack.inc
' Contents: Stack and Queue collections
' Compiler: FreeBasic 32 & 64-bit
' (c) 2017 by 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 "Afx/CSafeArray.inc"
using Afx

NAMESPACE Afx

' ========================================================================================
' CStack class
' A Stack Collection is an ordered set of data items, which are accessed on a LIFO
' (Last-In / First-Out) basis. Each data item is passed and stored as a variant variable,
' using the Push and Pop methods.
' ========================================================================================
TYPE CStack

Private:
   DIM m_psa AS CSafeArray PTR

Public:
   DECLARE CONSTRUCTOR
   DECLARE DESTRUCTOR
   DECLARE FUNCTION Push (BYREF cvData AS CVAR) AS HRESULT
   DECLARE FUNCTION Pop () AS CVAR
   DECLARE FUNCTION Count () AS UINT
   DECLARE FUNCTION Clear () AS HRESULT

END TYPE
' ========================================================================================

' ========================================================================================
' CStack constructor
' ========================================================================================
PRIVATE CONSTRUCTOR CStack
   ' // Create a safe array of 0 elements and a lower bound of 1
   m_psa = NEW CSafeArray(VT_VARIANT, 0, 1)
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' CStack destructor
' ========================================================================================
PRIVATE DESTRUCTOR CStack
   Delete m_psa
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Appends a variant at the end of the array.
' ========================================================================================
PRIVATE FUNCTION CStack.Push (BYREF cvData AS CVAR) AS HRESULT
   RETURN m_psa->AppendElement(cvData)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Gets and removes the last element of the array.
' ========================================================================================
PRIVATE FUNCTION CStack.Pop () AS CVAR
   DIM cv AS CVAR
   DIM nPos AS UINT = this.Count
   IF nPos = 0 THEN RETURN cv
   cv = m_psa->GetVar(nPos)
   m_psa->DeleteVariantElement(nPos)
   RETURN cv
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns the number of elements in the collection.
' ========================================================================================
PRIVATE FUNCTION CStack.Count () AS UINT
   RETURN m_psa->Count
END FUNCTION
' ========================================================================================

' ========================================================================================
' Removes all the elements in the collection.
' ========================================================================================
PRIVATE FUNCTION CStack.Clear () AS HRESULT
   RETURN m_psa->Reset
END FUNCTION
' ========================================================================================

' ========================================================================================
' CQueue class
' A Queue Collection is an ordered set of data items, which are accessed on a FIFO
' (First-In / First-Out) basis. Each data item is passed and stored as a variant variable,
' using the Enqueue and Dequeue methods.
' ========================================================================================
TYPE CQueue

Private:
   DIM m_psa AS CSafeArray PTR

Public:
   DECLARE CONSTRUCTOR
   DECLARE DESTRUCTOR
   DECLARE FUNCTION Enqueue (BYREF cvData AS CVAR) AS HRESULT
   DECLARE FUNCTION Dequeue () AS CVAR
   DECLARE FUNCTION Count () AS UINT
   DECLARE FUNCTION Clear () AS HRESULT

END TYPE
' ========================================================================================

' ========================================================================================
' CQueue constructor
' ========================================================================================
PRIVATE CONSTRUCTOR CQueue
   ' // Create a safe array of 0 elements and a lower bound of 1
   m_psa = NEW CSafeArray(VT_VARIANT, 0, 1)
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' CQueue destructor
' ========================================================================================
PRIVATE DESTRUCTOR CQueue
   Delete m_psa
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Appends a variant at the end of the array.
' ========================================================================================
PRIVATE FUNCTION CQueue.Enqueue (BYREF cvData AS CVAR) AS HRESULT
   RETURN m_psa->AppendElement(cvData)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Gets and removes the first element of the array.
' ========================================================================================
PRIVATE FUNCTION CQueue.Dequeue () AS CVAR
   DIM cv AS CVAR
   IF this.Count = 0 THEN RETURN cv
   cv = m_psa->GetVar(1)
   m_psa->DeleteVariantElement(1)
   RETURN cv
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns the number of elements in the collection.
' ========================================================================================
PRIVATE FUNCTION CQueue.Count () AS UINT
   RETURN m_psa->Count
END FUNCTION
' ========================================================================================

' ========================================================================================
' Removes all the elements in the collection.
' ========================================================================================
PRIVATE FUNCTION CQueue.Clear () AS HRESULT
   RETURN m_psa->Reset
END FUNCTION
' ========================================================================================

END NAMESPACE


Just displaying it so everybody can see how trivial it is (the hard stuff is in the CSafeArray class).

[José Roca]

I finally have managed to be able of print a CVAR directly, without having to use cv.ToStr.

I have added a private CWSTR variabe that will be alive during the life of the CVAR class and overwritten by the following method:

Code Select Expand


' =====================================================================================
PRIVATE OPERATOR CVar.CAST () BYREF AS WSTRING
   CWSTR_DP("CWSTR CAST BYREF AS WSTRING")
   cws = AfxVarToStr(@vd)
   OPERATOR = *cast(WSTRING PTR, cws.m_pBuffer)
END OPERATOR
' ========================================================================================


that returns a reference to it.

So with the updated CVAR.INC file, we can now do

Code Select Expand


'#CONSOLE ON
#INCLUDE ONCE "Afx/CStack.inc"
using Afx

DIM pStack AS CStack
pStack.Push "String 1"
pStack.Push "String 2"
DIM cv AS CVAR = pStack.Pop
print cv
cv = pStack.Pop
print cv
' --or--
'print pStack.Pop
'print pStack.Pop

print

DIM pQueue AS CQueue
pQueue.Enqueue "String 1"
pQueue.Enqueue 12345.12
print pQueue.Dequeue
print pQueue.Dequeue

PRINT
PRINT "Press any key..."
SLEEP


Seems like last night I have been really inspired: A decimal data type, two collections (Stack and Queue), and now this workaround that I have been searching for a year.

[Paul Squires]

That's awesome news Jose! You are being extremely productive. On the other hand, I have not because I bought a new place last week and now this week I'm getting my house ready for sale. Damn, real life getting in the way of programming.

[José Roca]

Hope you will be happy in your new house.

I'm happier with the CVAR workaround that with the new classes because I have the need to print the contents of a variant everyday, and each time that I had to add .ToStr I said to myself that I had to find a solution. And, finally, today I have find the inspiration after trying other three workarounds that didn't work. And the solution is the simpler one!

Now I have to remove all these .ToStr from the documentation

[Johan Klassen]

hello Jose Roca
I know you are aware of the many bignum libraries but just in case you missed this there's a free lib by Alexander Valyalkin at https://github.com/valyala/big_int, license is freeware
also available is libtomath at http://www.libtom.net licensed under WTFPL license.
my apologies if am stating something you already knew.

[José Roca]

Thanks for the links, but I have no plans to write a big numbers class. This is why I have said that if anyone has use for them, there are plenty of free libraries available. I have implemented currency and decimal because they are useful general purpose data types. Math is a field in which I have very little knowledge and expertise.

[Andrew Lindsay]

Jose,
Your framework grows better and better each day.  I'm only using such a tiny bit of what you've written, but I am ever thankful for what you've done.

Andrew

[José Roca]

I'm happier with the CVAR workaround that with the new classes because I have the need to print the contents of a variant everyday, and each time that I had to add .ToStr I said to myself that I had to find a solution. And, finally, today I have find the inspiration after trying other three workarounds that didn't work. And the solution is the simpler one!

This workaround is very important because it is going to allow me to make the use of the new data types more integrated with the language.

For example, until now we could do

Code Select Expand


DIM cv1 AS CVAR = "String 1"
DIM cv2 AS CVAR = "String 2"
print cv2 + " " + cv2


but we could not do

Code Select Expand


DIM cv1 AS CVAR = "String 1"
DIM cv2 AS CVAR = "String 2"
print cv2 & " " & cv2


that gave a type mismatch error.

But now I can overload the & operator

Code Select Expand


' ========================================================================================
' Concatenates two CVARs.
' ========================================================================================
PRIVATE OPERATOR & (BYREF cv1 AS CVAR, BYREF cv2 AS CVAR) AS CVAR
   RETURN cv1 + cv2
END OPERATOR
' ========================================================================================


and use

Code Select Expand


print cv2 & " " & cv2


wihout problems.

and even

Code Select Expand


print cv1 & " " & STR(2) & " " & cv2 & " test " & 1 & " test " & 2


[José Roca]

And using another workaround, I can get the intrinsic functions LEFT, RIGHT and VAL work with CVARs (MID as never been a problem and does not need a workaround):

Code Select Expand


' // Must be outside a namespace because they are global

' ========================================================================================
PRIVATE FUNCTION Left OVERLOAD (BYREF cv AS CVAR, BYVAL nChars AS INTEGER) AS CWSTR
   DIM cws AS CWSTR = cv.wstr
   RETURN LEFT(**cws, nChars)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION Right OVERLOAD (BYREF cv AS CVAR, BYVAL nChars AS INTEGER) AS CWSTR
   DIM cws AS CWSTR = cv.wstr
   RETURN RIGHT(**cws, nChars)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION Val OVERLOAD (BYREF cv AS CVAR) AS DOUBLE
   DIM cws AS CWSTR = cv.wstr
   RETURN VAL(**cws)
END FUNCTION
' ========================================================================================


Code Select Expand


'#CONSOLE ON
#define _CVAR_DEBUG_ 1
#INCLUDE ONCE "Afx/CVar.inc"
using Afx

DIM cv AS CVAR = "12345.67"
print Left(cv, 3)
print Right(cv, 3)
print Mid(cv, 3, 2)
print Val(cv)
print Asc(cv, 3)


PRINT
PRINT "Press any key..."
SLEEP


It works even if the contents are numeric because the casting converts the CVAR to a WSTRING.

Code Select Expand


'#CONSOLE ON
#define _CVAR_DEBUG_ 1
#INCLUDE ONCE "Afx/CVar.inc"
using Afx

DIM cv AS CVAR = 12345.67
print Left(cv, 3)
print Right(cv, 3)
print Mid(cv, 3, 2)
print Val(cv)
print Asc(cv, 3)

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

I'm going to improve the new data types.

CVAR (Variants)

Besides Left, Right and Val, I have added Round and the following operators: &, &=, +, +=, -, -=, *, *=, /, /=, \, \=, =, <>, <, >, <=, >=, - (negate), Not, And, Or, Xor, Mod, Imp, Eqv, ^, Abs, Fix, Int.

Math functions can be used if you use val, eg. DIM cv AS CVAR = 10 : PRINT (Log(Val(cv)), Val is needed because the CVAR is cast as a WSTRING. It is not possible to cast it also as a DOUBLE because it will confuse the & operator (the problem with this operator is that it accepts to concatenate strings and numbers without using STR(number)). Anyway, it is unliquely that you will use variants for math operations other than the ones already supported.

CWSTR/CBSTR (dynamic unicode strings)

I will add &, Left, Right and Val to avoid the need to use **, although ** will remain supported and will always be faster than the other options, specially with big strings.

[José Roca]

This is my attempt to implement COM smart pointers.

Code Select Expand


'#CONSOLE ON
#INCLUDE ONCE "Afx/AfxCom.inc"
#INCLUDE ONCE "Afx/AfxSapi.bi"
using Afx

' ========================================================================================
' _CComPtr macro
' ========================================================================================
#macro _CComPtr(T)
#ifndef CComPtr##T
TYPE CComPtr##T
Private:
   DIM m_pUnk AS T PTR
   m_bUninitCOM AS BOOLEAN
Public:
   DECLARE CONSTRUCTOR
   DECLARE CONSTRUCTOR (BYVAL pUnk AS T PTR, BYVAL fAddRef AS BOOLEAN = FALSE)
   DECLARE DESTRUCTOR
   DECLARE OPERATOR CAST () AS T PTR
   DECLARE OPERATOR LET (BYVAL pUnk AS T PTR)
   DECLARE FUNCTION vtbl () AS T PTR
   DECLARE FUNCTION vptr () AS T PTR
END TYPE
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CComPtr##T
   ' // Initialize the COM library
   DIM hr AS HRESULT = CoInitialize(NULL)
   IF hr = S_OK OR hr = S_FALSE THEN m_bUninitCOM = TRUE
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' // The first time that is called, pUnk receives a NULL (?), the 2nd time, works!
CONSTRUCTOR CComPtr##T (BYVAL pUnk AS T PTR, BYVAL fAddRef AS BOOLEAN = FALSE)
   ' // Initialize the COM library
   DIM hr AS HRESULT = CoInitialize(NULL)
   IF hr = S_OK OR hr = S_FALSE THEN m_bUninitCOM = TRUE
   ' // Assign the passed pointer
   m_pUnk = pUnk
   ' // Increase the reference count if requested
   IF fAddRef THEN AfxSafeAddRef(m_pUnk)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
DESTRUCTOR CComPtr##T
   ' // Release the interface pointer
   AfxSafeRelease(m_pUnk)
   ' // Uninitialize the COM library
   IF m_bUninitCOM THEN CoUninitialize
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR CComPtr##T.CAST () AS T PTR
   ' // Return an addrefed interface pointer
   AfxSafeAddRef(m_pUnk)
   OPERATOR = m_pUnk
END OPERATOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR CComPtr##T.LET (BYVAL pUnk AS T PTR)
   ' // Release the interface pointer
   AfxSafeRelease(m_pUnk)
   ' // Assign the passed reference counted interface pointer
   m_pUnk= pUnk
END OPERATOR
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION CComPtr##T.vtbl () AS T PTR
   ' // Return the stored interface pointer
   RETURN m_pUnk
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION CComPtr##T.vptr () AS T PTR
   ' // Release the interface pointer
   AfxSafeRelease(m_pUnk)
   ' // Return the address of the interface pointer
   RETURN @m_pUnk
END FUNCTION
' ========================================================================================
#endif
#endmacro

' // The COM library must be initialized to call AfxNewCom
CoInitialize NULL

' // Define the _CComPtrAfx_ISpVoice class
_CComPtr(Afx_ISpVoice)

' // Create an instance of the _CComPtrAfx_ISpVoice class
' // and assign an instance of the Afx_ISpVoice interface to it
DIM pSpVoice AS CComPtrAfx_ISpVoice = AfxNewCom("SAPI.SpVoice")

' // Call the Speak method
'DIM cwsText AS CWSTR = "Hello World"
'pSpVoice.vtbl->Speak(cwsText, 0, NULL)
pSpVoice.vtbl->Speak("Hello World", 0, NULL)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

Another way is to use an instance of the CComPtr class (in AfxCom.inc) to assign the pointer and let it the task of release it when it goes out of scope.

Code Select Expand


'#CONSOLE ON
#INCLUDE ONCE "Afx/AfxCom.inc"
#INCLUDE ONCE "Afx/AfxSapi.bi"
using Afx

' // The COM library must be initialized to call AfxNewCom
CoInitialize NULL

' // Create an instance of the Afx_ISpVoice interface
DIM pSpVoice AS Afx_ISpVoice PTR = AfxNewCom("SAPI.SpVoice")
DIM pCComPtrSpVoice AS CComPtr = pSpVoice

' // Call the Speak method
pSpVoice->Speak("Hello World", 0, NULL)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP


If FreeBasic had support for templates like C++, we could do:

Code Select Expand


DIM pSpVoice AS CComptr<Afx_ISpVoice> = AfxNewCom("SAPI.SpVoice")