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.
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.
Modified the AfxGetWindowText function, that was returning an ending null.
' ========================================================================================
' 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
' ========================================================================================
Thanks for your cMemBitmap class. I already found a use for it. Jim
On line documentation for the CWindow Framework
http://www.jose.it-berater.org/CWindow/CWindowFramework.html
Jose,
That's brilliant. Thanks for all the help and support you are giving to the community.
A new class, CRegExp, VB Script regular expressions.
Some usage examples:
Execute method:
#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
#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:
#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:
#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:
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
New classes to create shortcuts: CShortcut and CURLShortcut.
Usage example (CShortcut):
' 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):
' 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
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
Ok. I will remove all the dwExStyle = 0.
Jose,
In my translation I added:
If dwExStyle = -1 Then
dwExStyle = 0
End If
To all the items that just assigned a zero.
James
I'm lazier and use
' // 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.
Using the CWebBrowser class to display pictures.
' ########################################################################################
' 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
' ========================================================================================