Support Forums > WinFBX - Windows Framework for FreeBASIC

CWindow Release Candidate 31

(1/45) > >>

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

--- End code ---


--- Code: ---' ========================================================================================
' * 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
' ========================================================================================

--- End code ---


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

--- End code ---

Josť Roca:
Layered window template.


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

--- End code ---

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

--- End code ---

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...

Navigation

[0] Message Index

[#] Next page

Go to full version