CWindow Release Candidate 31

[José Roca]

This is another way to use CComPtr, but casting is annoying:

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 CComPtr = AfxNewCom("SAPI.SpVoice")
' // Call the Speak method
cast(Afx_ISpVoice PTR, *pSpVoice)->Speak("Hello World", 0, NULL)

' // Uninitialize the COM library
CoUninitialize

PRINT
PRINT "Press any key..."
SLEEP


[José Roca]

Added &, Left, Right and Val to CWSTR and CBSTR.
Added _CComPtr macro to AfxCom.inc.

Last updates can always be found at https://github.com/JoseRoca/WinFBX


Reuploaded because I had forget to add using Afx before the new global operators.

[José Roca]

String conversion functions

The string conversion functions available in FreeBasic are not fully suitable for some languages.

For example, the Turkish word "karışıklığı" is uppercased as "KARıŞıKLıĞı" instead of "KARIŞIKLIĞI", and "KARIŞIKLIĞI" is lowercased to "karişikliği" instead of "karışıklığı". Notice the "ı", that is not an "i".

The following functions use the API function LCMapStringEx to properly convert it.

Code Select Expand


' ========================================================================================
' - pwszStr [in]:
'      The string to convert. Cannot have a size of 0.
' - pwszLocaleName [in, optional]:
'      Pointer to a locale name or one of these pre-defined values:
'         LOCALE_NAME_INVARIANT
'         LOCALE_NAME_SYSTEM_DEFAULT
'         LOCALE_NAME_USER_DEFAULT
'      For a table of language culture names see:
'         https://msdn.microsoft.com/es-es/library/ee825488(v=cs.20).aspx
' - dwMapFlags [in, optional]:
'      Flag specifying the type of transformation to use during string mapping or the type
'      of sort key to generate. This parameter can have the following values
'      For a complete list see:
'      https://msdn.microsoft.com/en-us/library/windows/desktop/dd318702(v=vs.85).aspx
' Return value:
'   The uppercased string.
' ========================================================================================
PRIVATE FUNCTION AfxStrUCase (BYVAL pwszStr AS WSTRING PTR, _
   BYVAL pwszLocaleName AS WSTRING PTR = LOCALE_NAME_USER_DEFAULT, _
   BYVAL dwMapFlags AS DWORD = 0) AS CWSTR

   ' // Check the vailidy of the passed parameters
   IF pwszStr = NULL THEN RETURN ""
   IF LEN(*pwszStr) = 0 THEN RETURN ""
   DIM cwsOut AS CWSTR = *pwszStr
   ' // Make sure that LCMAP_LOWERCASE is not being used
   dwMapFlags = dwMapFlags AND (NOT LCMAP_LOWERCASE)
   ' // Make sure that LCMAP_LINGUISTIC_CASING OR LCMAP_UPPERCASE is being used
   dwMapFlags OR= LCMAP_LINGUISTIC_CASING OR LCMAP_UPPERCASE
   ' // Ususally, the length of the converted string will be the same that the one of
   ' // the input string, so let's try it
   DIM cbLen AS LONG = LCMapStringEx(pwszLocaleName, dwMapFlags, pwszStr, LEN(*pwszStr), _
       cwsOut.vptr, LEN(cwsOut), NULL, NULL, 0)
   ' // If the output length is bigger than the input one, request the needed length,
   ' // mke the buffer bigger and try it again
   IF cbLen = 0 AND GetLastError = ERROR_INSUFFICIENT_BUFFER THEN
      cbLen = LCMapStringEx(pwszLocaleName, dwMapFlags, pwszStr, LEN(*pwszStr), NULL, 0, NULL, NULL, 0)
      IF cbLen THEN
         cwsOut += SPACE(cbLen)
         cbLen = LCMapStringEx(pwszLocaleName, dwMapFlags, pwszStr, LEN(*pwszStr), _
                 cwsOut.vptr, LEN(cwsOut), NULL, NULL, 0)
      END IF
   END IF
   RETURN cwsOut

END FUNCTION
' ========================================================================================

' ========================================================================================
' - pwszStr [in]:
'      The string to convert. Cannot have a size of 0.
' - pwszLocaleName [in, optional]:
'      Pointer to a locale name or one of these pre-defined values:
'         LOCALE_NAME_INVARIANT
'         LOCALE_NAME_SYSTEM_DEFAULT
'         LOCALE_NAME_USER_DEFAULT
'      For a table of language culture names see:
'         https://msdn.microsoft.com/es-es/library/ee825488(v=cs.20).aspx
' - dwMapFlags [in, optional]:
'      Flag specifying the type of transformation to use during string mapping or the type
'      of sort key to generate. This parameter can have the following values
'      For a complete list see:
'      https://msdn.microsoft.com/en-us/library/windows/desktop/dd318702(v=vs.85).aspx
' Return value:
'   The lowercased string.
' ========================================================================================
PRIVATE FUNCTION AfxStrLCase (BYVAL pwszStr AS WSTRING PTR, _
   BYVAL pwszLocaleName AS WSTRING PTR = LOCALE_NAME_USER_DEFAULT, _
   BYVAL dwMapFlags AS DWORD = 0) AS CWSTR

   ' // Check the vailidy of the passed parameters
   IF pwszStr = NULL THEN RETURN ""
   IF LEN(*pwszStr) = 0 THEN RETURN ""
   DIM cwsOut AS CWSTR = *pwszStr
   ' // Make sure that LCMAP_UPPERCASE is not being used
   dwMapFlags = dwMapFlags AND (NOT LCMAP_UPPERCASE)
   ' // Make sure that LCMAP_LINGUISTIC_CASING OR LCMAP_LOWERCASE is being used
   dwMapFlags OR= LCMAP_LINGUISTIC_CASING OR LCMAP_LOWERCASE
   ' // Ususally, the length of the converted string will be the same that the one of
   ' // the input string, so let's try it
   DIM cbLen AS LONG = LCMapStringEx(pwszLocaleName, dwMapFlags, pwszStr, LEN(*pwszStr), _
       cwsOut.vptr, LEN(cwsOut), NULL, NULL, 0)
   ' // If the output length is bigger than the input one, request the needed length,
   ' // mke the buffer bigger and try it again
   IF cbLen = 0 AND GetLastError = ERROR_INSUFFICIENT_BUFFER THEN
      cbLen = LCMapStringEx(pwszLocaleName, dwMapFlags, pwszStr, LEN(*pwszStr), NULL, 0, NULL, NULL, 0)
      IF cbLen THEN
         cwsOut += SPACE(cbLen)
         cbLen = LCMapStringEx(pwszLocaleName, dwMapFlags, pwszStr, LEN(*pwszStr), _
                 cwsOut.vptr, LEN(cwsOut), NULL, NULL, 0)
      END IF
   END IF
   RETURN cwsOut

END FUNCTION
' ========================================================================================


[José Roca]

Although we can't write variadic functions with FreeBasic 64 bit (we can with 32 bit only), we can call external variadic functions written in C, e.g.

Code Select Expand


DIM wszOut AS WSTRING * 260
DIM wszFmt AS WSTRING * 260 = "%s %d + %d = %d."
DIM wszText AS WSTRING * 260 = "The answer is"
DIM hr AS HRESULT = StringCbPrintfW(@wszOut, SIZEOF(wszOut), @wszFmt, @wszText, 1, 2, 3)
print wszOut


Output: "The answer is 1 + 2 = 3."

StringCbPrintf function:
https://msdn.microsoft.com/en-us/library/windows/desktop/ms647510(v=vs.85).aspx

StringCbPrintf is a replacement for the following functions:

sprintf, swprintf, _stprintf
wsprintf
wnsprintf
_snprintf, _snwprintf, _sntprintf

StringCbPrintf_l (A/W) is similar to StringCbPrintf but includes a parameter for locale information.

StringCbPrintfEx (A/W) adds to the functionality of StringCbPrintf by returning a pointer to the end of the destination string as well as the number of bytes left unused in that string. Flags may also be passed to the function for additional control.

StringCbPrintf_lEx (A/W) is similar to StringCbPrintfEx but includes a parameter for locale information.

They can be very useful to do string formatting.

[José Roca]

Another function that can be used is StrSpn, that returns the length of the initial portion of a string which consists only of characters that are part of a specified set of characters.

Code Select Expand


'#CONSOLE ON
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/shlwapi.bi"
#INCLUDE ONCE "/crt/stdio.bi"

DIM wszText AS WSTRING * 260 = "129th"
DIM wszSet AS WSTRING * 260 = "1234567890"
DIM n AS LONG = StrSpnW(@wszText, @wszSet)
printf(!"The initial number has %d digits.\n", n)


[José Roca]

@Paul,

While adding new string functions and modifying several ones to make them work faster, I have noticed that there was a bug in AfxStrDelete and AfxStrInsert.

Code Select Expand


' ========================================================================================
' * Deletes a specified number of characters from a string expression.
' Returns a string based on wszMainStr but with nCount characters deleted
' starting at position nStart. The first character in the string is position 1, etc.
' Usage example:
' DIM cws AS CWSTR = AfxStrDelete("1234567890", 4, 3)
' ========================================================================================
PRIVATE FUNCTION AfxStrDelete (BYREF wszMainStr AS WSTRING, BYVAL nStart AS LONG, BYVAL nCount AS LONG) AS CWSTR
   DIM cws AS CWSTR = wszMainStr
   DIM nLen AS LONG = LEN(wszMainStr)
   IF nLen = 0 OR nStart < 0 OR nCount <= 0 OR nStart > nLen THEN RETURN cws
'   cws = LEFT(wszMainStr, nStart) + MID(wszMainStr, nStart + 1 + nCount, nCount)   ' // wrong calculation
   cws.DelChars nStart, nCount
   RETURN cws
END FUNCTION
' ========================================================================================


Code Select Expand


' ========================================================================================
' * Inserts a string at a specified position within another string expression.
' Returns a string consisting of wszMainStr with the string wszInsertString inserted
' at nPosition. If nPosition is greater than the length of wszMainStr or <= zero then
' wszInsertString is appended to wszMainStr. The first character in the string is position 1, etc.
' DIM cws AS CWSTR = AfxStrInsert("1234567890", "--", 6)
' ========================================================================================
PRIVATE FUNCTION AfxStrInsert (BYREF wszMainStr AS WSTRING, BYREF wszInsertString AS WSTRING, BYVAL nPosition AS LONG) AS CWSTR
   DIM cws AS CWSTR = wszMainStr
'   IF nPosition > LEN(wszMainStr) OR nPosition <= 0 THEN
'      cws += wszInsertString
'   ELSE
'      cws = MID(wszMainStr, 1, nPosition) + wszInsertString + MID(wszMainStr, nPosition + 1)
'   END IF
   IF nPosition <= 0 THEN RETURN CWS
   IF nPosition > LEN(wszMainStr) THEN
      cws += wszInsertString
   ELSEIF nPosition = 1 THEN
      cws = wszInsertString + MID(wszMainStr, 1)
   ELSE
      cws = MID(wszMainStr, 1, nPosition - 1) + wszInsertString + MID(wszMainStr, nPosition)
   END IF
   RETURN cws
END FUNCTION
' ========================================================================================


AfxStrDelete was removing the correct characters, but in some cases the remaining of the string after the characters deleted were lost.

In the WinFBE editor you're using this function in modCompile.inc.

Code Select Expand


   ' Search main source code for any user embedded compile directives. These will override
   ' anything that was set at the default or project level.
   dim directives as COMPILE_DIRECTIVES
   pDocMain->CompileDirectives(@directives)
   select case directives.ConsoleFlag
      case IDM_CONSOLE
         i = instr(gCompile.CompileFlags, " -S GUI ")
         if i THEN gCompile.CompileFlags = AfxStrDelete(gCompile.CompileFlags, i, 8)
         gCompile.CompileFlags = gCompile.CompileFlags + " " + wstr(" -s console ")
      case IDM_GUI
         i = instr(gCompile.CompileFlags, " -S CONSOLE ")
         if i THEN gCompile.CompileFlags = AfxStrDelete(gCompile.CompileFlags, i, 12)
         gCompile.CompileFlags = gCompile.CompileFlags + " " + wstr(" -s gui ")
   END select


Please check if all works fine after replacing the old AfxStr.inc with the new one.

Regarding AfxStrInsert, it was inserting the string at a wrong  position (one character more than it should).

[Paul Squires]

Hi Jose, thanks for letting me know. I will add your # of lines in file request as well as recompile with the new Afx functions. I will post a new release this evening.

[Paul Squires]

I downloaded your latest code from GitHub (RC31) but when I use those files the resulting compiled WinFBE will hang almost immediately when attempting to open a project. Opening individual files seems to be okay. I do not have time tonight to track down the exact source of the problem but I am wondering if it might be related to the changes you made to the CWSTR class. I should hopefully be able to give you a much better bug report ASAP.

[José Roca]

There was a bug in StrReplace, causing an endless loop.

Also, in

File: frmFindInFiles.inc
function DoFindInFilesEx() as LONG

You need to change

   wszResults = wstr(AfxGetExePathName & "\_search.txt")

to:
   wszResults = AfxGetExePathName & "_search.txt"

and

   wszBatchFile = wstr(AfxGetExePathName & "\_search.bat")

to:

   wszBatchFile = AfxGetExePathName & "_search.bat"

Not only WSTR isn't needed, but because of the addition of the & operator, AfxGetExePathName & "\_search.txt" return an ANY PTR pointer and WSTR complains. The problem with FreeBasic & operator is that it allows to concatenate numbers with strings without using STR(number), and when it finds a void pointer does not know what to do with it (wstr(AfxGetExePathName + "\_search.bat") works). Guess that this silly beahavior comes from Visual Basic.

[José Roca]

BTW sometimes you're forgetting that AfxGetExePathName returns a trailing "\", like with PowerBasic and unlike FB's Exepath. Fortunately, Windows seems to accept double backslashes.

Code Select Expand


File: clsconfig.inc

Function clsConfig.LoadKeywords() as Long
   If Open( AfxGetExePathName & "\Settings\freebasic_keywords.txt" For Input As #f) = 0 Then
should be changed to:
   If Open( AfxGetExePathName & "Settings\freebasic_keywords.txt" For Input As #f) = 0 Then

Function clsConfig.SaveKeywords() As Long
   If Open( AfxGetExePathName & "\Settings\freebasic_keywords.txt" For Output As #f) = 0 Then
should be changed to:
   If Open( AfxGetExePathName & "Settings\freebasic_keywords.txt" For Output As #f) = 0 Then

File: frmTemplates.inc
Function frmTemplates_Show (ByVal hParent As HWnd, ByVal x As Long, ByVal y As Long) As Long
   wszPath = AfxGetExePathName & "\Templates\"
should be changed to:
   wszPath = AfxGetExePathName & "Templates\"

File: modMenus.inc

Function CreateScintillaContextMenu() As HMENU
      ElseIf AfxFileExists(AfxGetExePathName & sFilename) Then
         gApp.IncludeFilename = AfxGetExePathName & "\" & sFilename
should be changed to:
      ElseIf AfxFileExists(AfxGetExePathName & sFilename) Then
         gApp.IncludeFilename = AfxGetExePathName & sFilename


File: modRoutines.inc

File: modTopMenu.inc

Function CreateScintillaContextMenu() As HMENU

      ElseIf AfxFileExists(AfxGetExePathName & "\" & sFilename) Then
         gpApp->IncludeFilename = AfxGetExePathName & sFilename
should be changed to:
      ElseIf AfxFileExists(AfxGetExePathName sFilename) Then
         gpApp->IncludeFilename = AfxGetExePathName & sFilename

WinFBE

Function WinMain
   wszLocalizationFile = AfxGetExePathName + wstr("\Languages\") + gConfig.LocalizationFile
should be changed to:
   wszLocalizationFile = AfxGetExePathName + wstr("Languages\") + gConfig.LocalizationFile

   gConfig.LoadCodetips( AfxGetExePathName & "\Settings\codetips.ini" )
should be changed to:
   gConfig.LoadCodetips( AfxGetExePathName & "Settings\codetips.ini" )

gConfig.LoadCodetipsWinAPI( AfxGetExePathName & "\Settings\codetips_winapi.ini" )
should be changed to:
gConfig.LoadCodetipsWinAPI( AfxGetExePathName & "Settings\codetips_winapi.ini" )


[José Roca]

I have added AfxGetExePath to AfxWin. Call it if you want to get a path without backslash and AfxGetExeName otherwise. There is an additional function, AfxGetExeFullPath, that returns the full path, including the file name.

Code Select Expand


' ========================================================================================
' Returns the path of the program which is currently executing.
' The path name has not a trailing backslash, except if it is a drive, e.g. "C:\".
' ========================================================================================
PRIVATE FUNCTION AfxGetExePath () AS CWSTR
   DIM buffer AS WSTRING * MAX_PATH, p AS LONG
   GetModuleFileNameW NULL, buffer, SIZEOF(buffer)
   p = INSTRREV(buffer, ANY ":/\")
   IF p THEN buffer = AfxPathRemoveBackslash(LEFT(buffer, p))
   RETURN buffer
END FUNCTION
' ========================================================================================


[José Roca]

CWSTR.inc

Removed an accidental double declaration of a LET operator. It was causing an ambiguous call error when trying to assign to a CBSTR variable the result of a function that returned another CBSTR.

Code Select Expand


DECLARE OPERATOR LET (BYREF cbs AS CBStr)
DECLARE OPERATOR LET (BYREF cbs AS CBSTR_)


[José Roca]

We already have got an extensive set of string manipulation functions, but there are many cases for which regular expressions are better suited.

For example,

Code Select Expand


DIM cbsText AS CBSTR = "World, worldx, world, worldy, hello world"
print AfxStrReplaceI(cbsText, cbsText, "earth")


Outputs "earth, earthx, earth, earthy, hello earth"

but what if we only want to replace only whole words?

Code Select Expand


DIM pRegExp AS CRegExp
DIM cbsText AS CBSTR = "World, worldx, world, worldy, hello world"
print pRegExp.ReplaceStr(cbsText, $"\bworld\b", "earth", TRUE)


Outputs "earth, worldx, earth, worldy, hello earth"

Code Select Expand


PRINT pRegExp.ReplaceStr("Hello World", "World", "Earth")

Outputs "Hello Earth", same as AfxStrReplace("Hello World", "World", "Earth")

Code Select Expand


PRINT pRegExp.ReplaceStr(pRegExp.ReplaceStr("abacadabra", "[bac]", "*")

Outputs "*****d**r*", same as AfxStrReplaceAny("abacadabra", "bac", "*")

Code Select Expand


PRINT pRegExp.ReplaceStr("555-123-4567", "(\d{3})-(\d{3})-(\d{4})", "($1) $2-$3")

Outputs "(555) 123-4567"

Code Select Expand


PRINT pRegExp.ReplaceStr("Squires, Paul", "(\S+), (\S+)", "$2 $1")

Outputs "Paul Squires"

Code Select Expand


PRINT pRegExp.ReplaceStr("0000.34500044", $"\b0{1,}\.", ".")

Outputs ".34500044"

Almost everything can be done, if you find the right pattern.

Although the Microsoft regular expressions object is not as complete as other libraries, the advantage is that is pre-installed in all versions of Windows and works with 32 and 64 bit. Open source libraries are a nightmare if you aren't an skilled C programmer: No windows binaries available or only available for old versions, import libraries, some are 32-bit only, etc.

[José Roca]

We can also do the same to delete substrings, e.g.

Code Select Expand


DIM pRegExp AS CRegExp
DIM cbsText AS CBSTR = "World, worldx, world, worldy, hello world"
print pRegExp.RemoveStr(cbsText, $"\bworld\b", TRUE)


Outputs: ", worldx, , worldy, hello"

And also do complex searchs.

[José Roca]

This one extracts text

Code Select Expand


DIM pRegExp AS CRegExp
DIM cbsText AS CBSTR = "anything textToExtract anything"
pRegExp.Pattern = "anything (.*) anything"
print pRegExp.Execute(cbsText)
IF pRegExp.SubMatchesCount(0) THEN print pRegExp.SubMatchValue(0, 0)

' Outputs textToExtract

If there are several matches, we will use a loop.

Code Select Expand


DIM pRegExp AS CRegExp
DIM cbsText AS CBSTR = "anything textToExtract anything TextToExtract anything"
DIm cbsPattern AS CBSTR = $"\btextToExtract\b"
pRegExp.Execute(cbsText, cbsPattern, TRUE)
FOR i AS LONG = 0 TO pRegExp.MatchesCount
   print pRegExp.MatchValue(i)
NEXT