CWindow Release Candidate 31

[José Roca]

Unrar the Afx folder in the "inc" folder of your compiler(s).

On-line help: http://www.jose.it-berater.org/WinFBX/WinFBX.html
GitHub: https://github.com/JoseRoca/WinFBX

Incorporates the changes discussed in the thread of the previous version.

I also have removed the deprecated classes CWstrArray, CWstrDic and CWmiCli. Use instead CSafeArray, CDicObj and CWmiDisp.

9 Aug 2017: Added RemoveStr, ReplaceStr and InStr to the CRegExp class.
14 Aug 2017: Some minor changes and a new class: CPropVar
26 Aug 2017: Added return value to several functions
3 Oct 2017 : Updated with the all changes discussed in this thread
4 Oct 2017 : Updated CVAR and CDispInvoke classes
16 Oct 2017 : Updated with new classes for Time and Ini files
19 Oct 2017 : Modified CDispInvoke
19 Oct 2017 : Removed a couple of suffixes in CPgBar3D.inc
27 Oct 2017 : Fixed a bug in the WebBrowser events; small changes in CWSTR and CVAR.
31 Oct 2017 : Small modification in AfxStr.inc

[Paul Squires]

Thanks Jose - I have downloaded and updated the WinFBE source tree with your new files. The changes will be available in the next GitHub upload.

[José Roca]

Added new methods to the CRegExp class: RemoveStr, ReplaceStr and InStr.

They allow to do string manipulation using regular expressions.

Code Select Expand


' ========================================================================================
' * Returns a copy of a string with text removed using a regular expression as the search string.
' Parameters:
' - cbsSourceString : The source string.
' - cbsPattern : The pattern to search.
' - bIgnoreCase : FALSE = case sensitive; TRUE = case insensitive.
' - bGlobal : FALSE = Delete only the first match; TRUE = delete all matches.
' - bMultiline : TRUE = Match at the start and the end of multiple lines separated by line breaks.
' Examples:
' DIM pRegExp AS CRegExp
' PRINT pRegExp.RemoveStr("abacadabra", "ab") - prints "acadra"
' PRINT pRegExp.RemoveStr("abacadabra", "[bAc]", TRUE) - prints "dr"
' ========================================================================================
PRIVATE FUNCTION CRegExp.RemoveStr (BYREF cbsSourceString AS CBSTR, BYREF cbsPattern AS CBSTR, _
   BYVAL bIgnoreCase AS BOOLEAN = FALSE, BYVAL bGlobal AS BOOLEAN = TRUE, BYVAL bMultiline AS BOOLEAN = FALSE) AS CBSTR
   DIM bstrDestString AS AFX_BSTR
   IF m_pRegExp = NULL THEN this.SetResult(E_POINTER): RETURN bstrDestString
   m_pRegExp->put_IgnoreCase(bIgnoreCase)
   m_pRegExp->put_Global(bGlobal)
   m_pRegExp->put_Multiline(bMultiline)
   m_pRegExp->put_Pattern(cbsPattern)
   this.SetResult(m_pRegExp->Replace(cbsSourceString, CVAR(""), @bstrDestString))
   RETURN bstrDestString
END FUNCTION
' ========================================================================================


Code Select Expand


' ========================================================================================
' * Returns a copy of a string with text replaced using a regular expression as the search string.
' Parameters:
' - cbsSourceString : The source string.
' - cbsPattern : The pattern to search.
' - cvReplaceString : The replacement string.
' - bIgnoreCase : FALSE = case sensitive; TRUE = case insensitive.
' - bGlobal : FALSE = Delete only the first match; TRUE = delete all matches.
' - bMultiline : TRUE = Match at the start and the end of multiple lines separated by line breaks.
' Examples:
' DIM pRegExp AS CRegExp
' PRINT pRegExp.ReplaceStr("Hello World", "World", "Earth") - prints "Hello Earth"
' PRINT pRegExp.ReplaceStr("abacadabra", "[bac]", "*") - prints "*****d**r*"
' PRINT pRegExp.ReplaceStr("555-123-4567", "(\d{3})-(\d{3})-(\d{4})", "($1) $2-$3") - prints "(555) 123-4567"
' PRINT pRegExp.ReplaceStr("Squires, Paul", "(\S+), (\S+)", "$2 $1") - prints "Paul Squires"
' PRINT pRegExp.ReplaceStr("0000.34500044", $"\b0{1,}\.", ".") - prints ".34500044"
' ========================================================================================
PRIVATE FUNCTION CRegExp.ReplaceStr (BYREF cbsSourceString AS CBSTR, BYREF cbsPattern AS CBSTR, BYREF cvReplaceString AS CVAR, _
   BYVAL bIgnoreCase AS BOOLEAN = FALSE, BYVAL bGlobal AS BOOLEAN = TRUE, BYVAL bMultiline AS BOOLEAN = FALSE) AS CBSTR
   DIM bstrDestString AS AFX_BSTR
   IF m_pRegExp = NULL THEN this.SetResult(E_POINTER): RETURN bstrDestString
   m_pRegExp->put_IgnoreCase(bIgnoreCase)
   m_pRegExp->put_Global(bGlobal)
   m_pRegExp->put_Multiline(bMultiline)
   m_pRegExp->put_Pattern(cbsPattern)
   this.SetResult(m_pRegExp->Replace(cbsSourceString, cvReplaceString, @bstrDestString))
   RETURN bstrDestString
END FUNCTION
' ========================================================================================


Code Select Expand


' ========================================================================================
' Global, multiline in string function with VBScript regular expressions search patterns.
' Parameters:
' - cbsSourceString = The text to be parsed.
' - cbsPattern = The pattern to match.
' - bIgnoreCase = Ignore case.
' Return value:
' - Returns a list of comma separated "index, length" value pairs. The pairs are separated
'   by a semicolon.
' Usage Example:
'   DIM cbsText AS CBSTR = "blah blah a234 blah blah x345 blah blah"
'   DIM cbsPattern AS CBSTR = "[a-z][0-9][0-9][0-9]"
'   DIM cbsOut AS CBSTR
'   cbsOut = pRegExp.InStr(cbsText, cbsPattern)
'   PRINT cbs   - prints 11,4; 26,4
' ========================================================================================
PRIVATE FUNCTION CRegExp.InStr (BYREF cbsSourceString AS CBSTR, BYREF cbsPattern AS CBSTR, _
   BYVAL bIgnoreCase AS BOOLEAN = FALSE, BYVAL bGlobal AS BOOLEAN = TRUE, BYVAL bMultiline AS BOOLEAN = TRUE) AS CBSTR

   IF m_pRegExp = NULL THEN this.SetResult(E_POINTER): RETURN ""
   m_pRegExp->put_IgnoreCase(bIgnoreCase)
   m_pRegExp->put_Global(bGlobal)
   m_pRegExp->put_Multiline(bMultiline)
   m_pRegExp->put_Pattern(cbsPattern)

   DIM cbsOut AS CBSTR, pMatches AS Afx_IMatchCollection2 PTR
   this.SetResult(m_pRegExp->Execute(cbsSourceString, cast(Afx_IDispatch PTR PTR, @pMatches)))
   IF pMatches THEN
      DIM nCount AS LONG
      pMatches->get_Count(@nCount)
      FOR i AS LONG = 0 TO nCount - 1
         DIM pMatch AS Afx_IMatch2 PTR
         this.SetResult(pMatches->get_Item(i, cast(Afx_IDispatch PTR PTR, @pMatch)))
         IF pMatch THEN
            DIM nFirstIndex AS LONG
            pMatch->get_FirstIndex(@nFirstIndex)
            DIM nLen AS LONG
            pMatch->get_Length(@nLen)
            IF i < nCount - 1 THEN
               cbsOut += STR(i + 1) & "," & STR(nLen) & ";"
            ELSE
               cbsOut += STR(i + 1) & "," & STR(nLen)
            END IF
            AfxSafeRelease(pMatch)
         END IF
      NEXT
      AfxSafeRelease(pMatches)
   END IF
   RETURN cbsOut

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


[José Roca]

Layered window template.

Code Select Expand


2
FBGUI
.bas
CWindow: Layered window
' ########################################################################################
' Microsoft Windows
' File: CW_LayeredWindow.fbtpl
' Contents: CWindow layered window example
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 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"
USING Afx

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)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' 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

   ' // Creates the main window
   DIM pWindow AS CWindow
   DIM hwnd AS HWND = pWindow.Create(NULL, "CWindow - Layered window", @WndProc)
   ' // Make the window layered
   AfxAddWindowExStyle(hwnd, WS_EX_LAYERED)
   ' // Make this window 70% alpha
   SetLayeredWindowAttributes(hwnd, 0, (255 * 70) / 100, LWA_ALPHA)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(500, 320)
   ' // Centers the window
   pWindow.Center

   ' // Adds a button
   pWindow.AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)

   |

   ' // Displays the window and dispatches the Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

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 GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), _
               pWindow->ClientWidth - 120, pWindow->ClientHeight - 50, 75, 23, CTRUE
         END IF

    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
' ========================================================================================


[José Roca]

Using the WinFBE editor with the UTF-8 (BOM) encoding, and using CWSTR, CBSTR, CVAR or WSTRING as the data types, international users can now work with unicode transparently.

Code Select Expand


'DIM cws AS CWSTR = "ドミートリイ・ショスタコーヴィチ"   ' Chinese
DIM cws AS CWSTR = "Дми́трий Шостако́вич"   ' Russian
SetWindowTextW hCtl, cws

DIM cbs AS CBSTR = "Дми́трий Шостако́вич"   ' Russian
SetWindowTextW hCtl, cbs

DIM cv AS CVAR = "Дми́трий Шостако́вич"   ' Russian
SetWindowTextW hCtl, cv.wstr

DIM cws2 AS CWSTR = "دمیتری دمیتری‌یویچ شوستاکوویچ"    ' Arab
SetWindowTextW hCtl, cws2


Finally we can use unicode transparently with languages like Chinese, Russian, Arab, etc., even mixed.

All the other past attempts (charsets, code pages) must fall into the oblivion. This one seems to work perfectly and no conversions are needed since the characters are stored in the data types as unicode, not utf8.

Hope our international members will bother to test...

[José Roca]

@Paul,

Maybe changing the file encoding should require confirmation. Too easy to click the status bar by accident and mess the code.

[Paul Squires]

@Paul,

Maybe changing the file encoding should require confirmation. Too easy to click the status bar by accident and mess the code.

Hi Jose, instead of an intrusive confirmation messagebox, I'll have a context menu popup allowing to choose between the 3 file types. This will be similar to the way that the panel next to it works when wanting to switch between NORMAL, MODULE, MAIN, etc...

[Paul Squires]

@Paul,

Maybe changing the file encoding should require confirmation. Too easy to click the status bar by accident and mess the code.

Hi Jose, instead of an intrusive confirmation messagebox, I'll have a context menu popup allowing to choose between the 3 file types. This will be similar to the way that the panel next to it works when wanting to switch between NORMAL, MODULE, MAIN, etc...

This is now done and will be in the next update.

[José Roca]

Updated the framework with some minor changes and a new class: CPropVar.

CPropVar implements a new data type, PROPVARIANT, that is needed to use some COM technologies.

I think that we already have all the Windows data types.

[José Roca]

Help file in .chm format.

[Johan Klassen]

thank you Jose Roca for the help file 

[Paul Squires]

Is there anything in PowerBasic that we still can't do using FreeBasic?  (maybe working with, or interfacing to, DLL's is easier in PB)

Jose's library makes it so easy to program Windows in 32 and 64 bit.

[José Roca]

> Is there anything in PowerBasic that we still can't do using FreeBasic?

There is not much left. And the alternatives offered by the framework are superior.

I'm going to add this small class:

Code Select Expand


' ========================================================================================
' CComPtr class
' ========================================================================================
TYPE CComPtr
   m_pUnk AS IUnknown PTR
   DECLARE CONSTRUCTOR (BYVAL pUnk AS ANY PTR, BYVAL fAddRef AS BOOLEAN = FALSE)
   DECLARE DESTRUCTOR
   DECLARE OPERATOR Let (BYVAL pUnk AS ANY PTR)
END TYPE
' ========================================================================================
' ========================================================================================
PRIVATE CONSTRUCTOR CComPtr (BYVAL pUnk AS ANY PTR, BYVAL fAddRef AS BOOLEAN = FALSE)
   m_pUnk = pUnk
   IF fAddRef THEN AfxSafeAddRef(m_pUnk)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
PRIVATE DESTRUCTOR CComPtr
   AfxSafeRelease(m_pUnk)
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR CComPtr.Let (BYVAL pUnk AS ANY PTR)
   AfxSafeRelease(m_pUnk)
   m_pUnk= pUnk
END OPERATOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR * (BYREF _ccomptr AS CComPtr) AS ANY PTR
   OPERATOR = _ccomptr.m_pUnk
END OPERATOR
' ========================================================================================


When working with COM we can assign COM pointers to instances of this class and we no longer have to worry about releasing them.

[James Fuller]

Is there anything in PowerBasic that we still can't do using FreeBasic?  (maybe working with, or interfacing to, DLL's is easier in PB)

Jose's library makes it so easy to program Windows in 32 and 64 bit.

One of the big selling points of PowerBASIC in my opinion is the ease to create COM servers.

James

[aloberr]

COM servers can be easy with the use of the virtual classes, that will be more with the concepts of interface or/and  multiples inheritance that FB do not have yet.