CWindow Release Candidate 28

[José Roca]

New classes:

CCDAudio: Plays an audio CD
CDSAudio: Plays audio files using Direct Show
CCDOMessage: Sends emails using CDO
CMemBmp: Creates memory bitmaps
CWmiCli: WMI wrapper class to easily do WMI queries

New dialog:

AfxInputBox: Input box dialog.

[José Roca]

Added an overloaded DrawBitmap method to the CMemBmp and CGraphCtx classes to accept a pointer to a GDI+ bitmap as input.

Fixed a bug in the default constuctor of the CMemBmp class that caused FillRect to fail and the background color was unchanged.

[José Roca]

Modified the AfxGetWindowText function, that was returning an ending null.

Code Select Expand


' ========================================================================================
' Gets the text of a window. This function can also be used to retrieve the text of buttons,
' and edit and static controls.
' Remarks: The function uses the WM_GETTEXT message because GetWindowText cannot retrieve
' the text of a window in another application.
' Example: DIM cws AS CWSTR = AfxGetWindowText(hwnd)
' ========================================================================================
PRIVATE FUNCTION AfxGetWindowText (BYVAL hwnd AS HWND) AS CWSTR
   DIM nLen AS LONG = SendMessageW(hwnd, WM_GETTEXTLENGTH, 0, 0)
   DIM cwsText AS CWSTR = SPACE(nLen + 1)
   SendMessageW(hwnd, WM_GETTEXT, nLen + 1, cast(LPARAM, *cwsText))
   RETURN LEFT(**cwsText, LEN(cwsText) - 1)
END FUNCTION
' ========================================================================================


[James Klutho]

Thanks for your cMemBitmap class.  I already found a use for it.  Jim

[José Roca]

On line documentation for the CWindow Framework

http://www.jose.it-berater.org/CWindow/CWindowFramework.html

[Andrew Lindsay]

Jose,
That's brilliant.  Thanks for all the help and support you are giving to the community.

[José Roca]

A new class, CRegExp, VB Script regular expressions.

Some usage examples:

Execute method:

Code Select Expand


#define UNICODE
#INCLUDE ONCE "Afx/CRegExp.inc"
USING Afx

DIM pRegExp AS CRegExp = CRegExp("is.", TRUE, TRUE)
IF pRegExp.Execute("IS1 is2 IS3 is4") = FALSE THEN
   print "No match found"
ELSE
   DIM nCount AS LONG = pRegExp.MatchCount
   FOR i AS LONG = 0 TO nCount - 1
      print "Value: ", pRegExp.MatchValue(i)
      print "Position: ", pRegExp.MatchPos(i)
      print "Length: ", pRegExp.MatchLen(i)
      print
   NEXT
END IF


Code Select Expand


#define UNICODE
#INCLUDE ONCE "Afx/CRegExp.inc"
USING Afx

DIM pRegExp AS CRegExp
pRegExp.Pattern = "is."
pRegExp.IgnoreCase = TRUE
pRegExp.Global = TRUE
IF pRegExp.Execute("IS1 is2 IS3 is4") = FALSE THEN
   print "No match found"
ELSE
   DIM nCount AS LONG = pRegExp.MatchCount
   FOR i AS LONG = 0 TO nCount - 1
      print "Value: ", pRegExp.MatchValue(i)
      print "Position: ", pRegExp.MatchPos(i)
      print "Length: ", pRegExp.MatchLen(i)
      print
   NEXT
END IF


Test method:

Code Select Expand


#define UNICODE
#INCLUDE ONCE "Afx/CRegExp.inc"
USING Afx

DIM pRegExp AS CRegExp
pRegExp.Pattern = "is."
pRegExp.IgnoreCase = TRUE
pRegExp.Global = TRUE
IF pRegExp.Test("IS1 is2 IS3 is4") THEN
   print "One or more matches were found"
ELSE
   print "No match found"
END IF


Replace method:

Code Select Expand


#define UNICODE
#INCLUDE ONCE "Afx/CRegExp.inc"
USING Afx

DIM pRegExp AS CRegExp
pRegExp.Pattern = "fox"
pRegExp.IgnoreCase = TRUE
DIM cwsText AS CWSTR = "The quick brown fox jumped over the lazy dog."
' Make replacement
DIM cwsRes AS CWSTR = pRegExp.Replace(cwsText, "cat")
print cwsRes


Sub matches:

Code Select Expand


DIM pRegExp AS CRegExp
pRegExp.Pattern = "(\w+)@(\w+)\.(\w+)"
pRegExp.IgnoreCase = TRUE
DIM cwsText AS CWSTR = "Please send mail to dragon@xyzzy.com. Thanks!"
IF pRegExp.Execute(cwsText) = FALSE THEN
   print "No match found"
ELSE
   ' Get the number of submatches
   DIM nCount AS LONG = pRegExp.SubMatchCount(0)
   print "Sub matches: ", nCount
   FOR i AS LONG = 0 TO nCount - 1
      print pRegExp.SubMatchValue(0, i)
   NEXT
END IF


[José Roca]

New classes to create shortcuts: CShortcut and CURLShortcut.

Usage example (CShortcut):

Code Select Expand


' Creates a shortcut programatically (if it already exists, opens it)
DIM pShortcut AS CShortcut = ExePath & "\Test.lnk"   ' --> change me
' Sets various properties and saves them to disk
pShortcut.Description = "Hello world"   ' --> change me
pShortcut.WorkingDirectory = ExePath & "\"   ' --> change me
pShortcut.Arguments = "/c"   ' --> change me
pShortcut.HotKey = "Ctrl+Alt+e"   ' --> change me
pShortcut.IconLocation = ExePath & "\Program.ico,0"   ' --> change me
pShortcut.RelativePath = ExePath & "\"   ' --> change me
pShortcut.TargetPath = ExePath & $"\HelloWord.exe"   ' --> change me
pShortcut.WindowStyle = WshNormalFocus
pShortcut.Save


Usage example (CURLShortcut):

Code Select Expand


' Creates a shortcut programatically (if it already exists, opens it)
DIM pURLShortcut AS CURLShortcut = ExePath & "\Microsoft Web Site.url"   ' --> change me
pURLShortcut.TargetPath = "http://www.microsoft.com"   ' --> change me
pURLShortcut.Save


[James Fuller]

Jose,
  Good stuff!!!! but....
  In CWindow AddControl "LABEL" you set dwExStyle to zero regardless of the value passed in.
I often use a value of one to give a raised border.

James

[José Roca]

Ok. I will remove all the dwExStyle = 0.

[James Fuller]

Jose,
  In my translation I added:

If dwExStyle = -1 Then
    dwExStyle = 0
End If   

To all the items that just assigned a zero.

James

[José Roca]

I'm lazier and use

Code Select Expand


   ' // Don't allow negative values for the styles
   IF dwStyle = -1 THEN dwStyle = 0
   IF dwExStyle = -1 THEN dwExStyle = 0
   ' // Make sure that the control has the WS_CHILD style
   dwStyle = dwStyle OR WS_CHILD
   ' // Create the control
   hCtl = .CreateWindowExW(dwExStyle, wsClassName, wszTitle, dwStyle, x * m_rx, y * m_ry, nWidth * m_rx, nHeight * m_ry, _
          hParent, CAST(HMENU, CAST(LONG_PTR, cID)), m_hInstance, CAST(LPVOID, lpParam))


just before calling CreateWindowExW.

[José Roca]

Using the CWebBrowser class to display pictures.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_WB_DisplayPicture.fbtpl
' Contents: WebBrowser - Display picture
' 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"
#INCLUDE ONCE "Afx/CWebBrowser/CWebBrowser.inc"
USING Afx

CONST IDC_WEBBROWSER = 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)

' // 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
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "WebBrowser - Display picture", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(600, 350)
   ' // Centers the window
   pWindow.Center

   ' // Add a WebBrowser control
   DIM pwb AS CWebBrowser = CWebBrowser(@pWindow, IDC_WEBBROWSER, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   ' // Set the IDocHostUIHandler interface
   pwb.SetUIHandler

'   ' // Script to display the picture (fit to width)
'   DIM cws AS CWSTR = "<body scroll='auto' style='margin: 0px 0px 0px 0px'>"
'   cws += "<img src='http://www.kenrockwell.com/trips/2016-05-yosemite/RX300658-green-falls.jpg' border='0' width='100%'></img>"
'   cws += "</body>"

'   ' // Script to display the picture (fit to height)
'   DIM cws AS CWSTR = "<body scroll='auto' style='margin: 0px 0px 0px 0px'>"
'   cws += "<img src='http://www.kenrockwell.com/trips/2016-05-yosemite/RX300658-green-falls.jpg' border='0' height='100%'></img>"
'   cws += "</body>"

   ' // Script to display the picture (zoom width by 20%)
   DIM cws AS CWSTR = "<body scroll='auto' style='margin: 0px 0px 0px 0px'>"
   cws += "<img src='http://www.kenrockwell.com/trips/2016-05-yosemite/RX300658-green-falls.jpg' border='0' width='120%'></img>"
   cws += "</body>"

   ' // Script to display the picture (fit to height, center)
'   DIM cws AS CWSTR = "<body scroll='auto' style='margin: 0px 0px 0px 0px'>"
'   cws += "<center>"
'   cws += "<img src='https://upload.wikimedia.org/wikipedia/commons/2/28/Nicole_Kidman_Cannes_2017_2.jpg' border='0' height='100%'></img>"
'   cws += "<center>"
'   cws += "</body>"

'   // To display from files stored in the computer
'   bstrHTML += "<img src='file://C:\Users\Pepe\FreeBasic64\MyExamples\ImageCtx\VEGA_PAZ_01.jpg' border='0' width='100%'></img>"
'   bstrHTML += "<img src='file://C:\Users\Pepe\FreeBasic64\MyExamples\ImageCtx\VEGA_PAZ_01.jpg' border='0'></img>"

   ' // Write the HTML code in the web page
   pwb.WriteHtml(cws)

   ' // 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 control
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_WEBBROWSER), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, 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
' ========================================================================================