Added wrappers for the Rich Edit control.
Small modification in a couple of methods of the CTextStream class.
Modified the AfxAddTooltip, AfxSetTooltipText and AfxDeleteTooltip to check if the passed handle is a window or a child control.
Thank you Jose. :)
Thanks Jose! Appreciate it!
Thank you very much Jose... What would we do without you ;)
Weird. The code has been downloaded 22 times and the help file 60!
When I downloaded the files the help file download failed and I needed to do it again. Perhaps this accounts for the disparity.
hi，Jose Roca
I suggest renaming the afxmsg function to the Afxmsgbox function，and add a Title Parameter for non English speaking areas. would it be better than always showing "message" title?
The CWindow framework is a very powerful framework for freebasic use in Windows, you have done a great job, thank you very much!
This function is intended as a quick way to display a message box, mainly for debugging purposes. This is why it uses a short name and only needs to pass the text to display. In production code, I always use the Windows API function MessageBox, that allows to specify the parent window, the text to display, the caption and the type.
Jose,
Thanks so much for this. I have been mashing around my own RTF stuff for about 18 months. I had a few glitches that seemed to be a memory leak from somewhere, but as is usually the case, your code bolts in with a minimal amount of work and just does what is says on the box.
Love your work.
Thanks for your kind words. I have noticed that I forgot to add PRIVATE to the SUBs. I have added it in the attached file. Not very important, but it will save some bytes.
hi,Jose Roca
Why not encapsulate an easy-to-use thread class and add it to the CWindow frame?
Please forgive me for my reckless request.
thank you very much!
ganlinlao
I don't have expertise with threads. Maybe this thread class posted in the FB forum can be useful:
http://www.freebasic.net/forum/viewtopic.php?t=10053
Next version will include a localized Input Box dialog. Localization of the buttons is achieved by extracting the strings from the resource file of user32.dll (works also with 64 bit).
Usage example:
DIM cws AS CWSTR = AfxInputBox(hwnd, 0, 0, "InputBox test", "What's your name?", "My name is Jose")
' ########################################################################################
' *** INPUT BOX DIALOG ***
' ########################################################################################
' ========================================================================================
' Input box dialog
' Parameters:
' - hParent = Handle of the parent window
' - x, y = The location on the screen to display the dialog. If both are 0, the dialog
' is centered on the screen.
' - cwsCaption = Caption of the window
' - cwsPrompt = Prompt string
' - cwsText = Text to edit
' - nLen = [opt] Maximum length of the string to edit (default = 260 characters)
' - bPassword = [opt] TRUE or FALSE. Default FALSE. Displays all characters as an
' asterisk (*) as they are typed into the edit control.
' Note: The maximum length is 2048 characters.
' ========================================================================================
' Forward declaration of the callback function
DECLARE FUNCTION AfxInputBoxWindowProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
PRIVATE FUNCTION AfxInputBox (BYVAL hParent AS HWND, BYVAL x AS LONG, BYVAL y AS LONG, _
BYREF cwsCaption AS CWSTR, BYREF cwsPrompt AS CWSTR, BYREF cwsText AS CWSTR, _
BYVAL nLen AS LONG = 260, BYVAL bPassword AS BOOLEAN = FALSE) AS CWSTR
' // Create the window
DIM pInputBox AS CWindow
DIM dwStyle AS DWORD = WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW
DIM dwExStyle AS DWORD = WS_EX_DLGMODALFRAME OR WS_EX_CONTROLPARENT
DIM hInputBox AS HWND = pInputBox.Create(hParent, **cwsCaption, @AfxInputBoxWindowProc, x, y, 326, 142, dwStyle, dwExStyle)
' // Center the window
IF x = 0 AND y = 0 THEN pInputBox.Center(hInputBox, hParent)
' // Add a label control
pInputBox.AddControl("Label", hInputBox, -1, **cwsPrompt, 21, 10, 280, 19)
' // Add a TextBox control
dwStyle = WS_VISIBLE OR WS_TABSTOP OR ES_LEFT OR ES_AUTOHSCROLL
IF bPassWord THEN dwStyle = dwStyle OR ES_PASSWORD
DIM hEdit AS HWND = pInputBox.AddControl("Edit", hInputBox, 101, "", 21, 33, 280, 19, dwStyle)
' // Add the buttons
DIM hOkButton AS HWND = pInputBox.AddControl("Button", hInputBox, IDOK, "&Ok", 21, 72, 75, 22)
DIM hCancelButton AS HWND = pInputBox.AddControl("Button", hInputBox, IDCANCEL, "&Cancel", 226, 72, 75, 22)
' // Localized strings. In the resource file of user32.dll, the OK button has
' // IDS_OK (801) as the identifier and the Cancel button IDS_CANCEL (801).
DIM hUser32Instance AS HINSTANCE = GetModuleHandleW("user32.dll")
DIM wszOk AS WSTRING * 260
DIM cbLen AS LONG = LoadStringW(hUser32Instance, 800, @wszOk, SIZEOF(wszOk))
IF cbLen THEN wszOk = "&" & wszOk : SendMessageW(hOkButton, WM_SETTEXT, 0, cast(LPARAM, @wszOk))
DIM wszCancel AS WSTRING * 260
cbLen = LoadStringW(hUser32Instance, 801, @wszCancel, SIZEOF(wszCancel))
IF cbLen THEN wszCancel = "&" & wszCancel : SendMessageW(hCancelButton, WM_SETTEXT, 0, cast(LPARAM, @wszCancel))
' // Set the text and the limit
IF nLen = 0 THEN nLen = 260
IF nLen < 1 OR nLen > 2048 THEN nLen = 2048
SendMessageW hEdit, EM_LIMITTEXT, nLen, 0
IF LEN(cwsText) > nLen THEN cwsText = LEFT(**cwsText, nLen)
SendMessageW(hEdit, WM_SETTEXT, 0, cast(LPARAM, *cwsText))
SendMessageW(hEdit, EM_SETSEL, 0, -1)
' // Set the focus in the edit control
SetFocus hEdit
' // Pointer to the allocated string to return the result
DIM wszOut AS WSTRING * 2049
SendMessageW hInputBox, WM_USER + 1, CAST(WPARAM, @wszOut), 0
' // Process Windows messages
pInputBox.DoEvents
' // Enable the parent window
EnableWindow hParent, CTRUE
' // Return the output string
RETURN wszOut
END FUNCTION
' ========================================================================================
' ========================================================================================
' Input box callback function.
' ========================================================================================
PRIVATE FUNCTION AfxInputBoxWindowProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
STATIC pText AS WSTRING PTR ' // Pointer to the string buffer
SELECT CASE uMsg
CASE WM_CREATE
' Disable parent window to make popup window modal
EnableWindow GetParent(hwnd), FALSE
EXIT FUNCTION
CASE WM_USER + 1
' // Pointer to allocated string to return the result
IF wParam THEN
pText = cast(WSTRING PTR, wParam)
EXIT FUNCTION
END IF
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDOK
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
DIM nLen AS LONG = SendMessageW(GetDlgItem(hwnd, 101), WM_GETTEXTLENGTH, 0, 0)
IF nLen > 2048 THEN nLen = 2048
nLen = SendMessageW(GetDlgItem(hwnd, 101), WM_GETTEXT, nLen + 1, cast(.LPARAM, pText))
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_CLOSE
' // Enables parent window keeping parent's zorder
EnableWindow GetParent(hwnd), CTRUE
' // Don't exit; let DefWindowProcW perform the default action
CASE WM_DESTROY
' // Close the main window
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
hi,Jose Roca
I use AfxNewCom ("Excel.Application"), but it cannot return Excel.Application objects
How to call Excel.Application correctly?
I like others, I hope you can retain the COM-related classes in the framework, we can not use IE, we can not use Ocx, but many people have to use the Ms-offIce software, many people uses the Ms-office x64-bit Edition, which requires FreeBASIC to support and compile 64-bit tools, if Ms-office dies, and then removes COM-related classes, otherwise, COM-related classes, There are still many people who need to use it.
Your profound knowledge will bring more simple, easier, more powerful tools, making it easier to use Freebasic for others.
Please
thanks
ganlinlao
Office applications can only be used with COM Automation, i.e. through the Invoke method of the IDispatch interface. Although their type libraries let you think that they expose dual interfaces, it isn't true. If you do calls through the VTable, the methods that should return pointers to other VTable interfaces return pointers to the automation interfaces, and if you use them, your application will crash. Besides, I don't have Office installed since many years ago. I use Libre Office, that is free.
> we can not use IE, we can not use Ocx
You can. My framework includes an OLE container that allows you to embed the WebBrowser control. Many OCXs will also work with it, although not all. I have provided several examples.
> I like others, I hope you can retain the COM-related classes in the framework
Without native support for BSTR and VARIANTs it is difficult. I tried to implement classes to support them, but I was not fully satisfied with the results. There is also the problem that variadic functions don't work with Free Basic 64 bit.
hi,Jose Roca,Thanks your reply.
I will try to find any other convenient way to call Office.Application.
You have deleted the Cbstr,cbstrSA,csafeArray,cVariant,cdispinvoke class before, I copied back to RC27. I think it is very useful to me, although you are not satisfied with it.
In China, people generally use ms-office or Wps-office software (and ms-office very similar , also support for VBA, is also COM automation, for personal use is free), at least more than 3 million people learn VBA and use VBA. I have tried to use OpenOffice and Libre office, but it is not popular, and hardly anyone else uses it.
Some elementary schools use FreeBASIC to teach pupils to learn getting started programming, which is interesting.
thanks
ganlinlao
hi,Jose Roca
CwstrArray's sort method does not work
This is my test code：
#include once "afx/cwstrArray.inc"
#include once "afx/cwindow.inc"
using afx
dim myArr as cwstrArray=cwstrArray(4)
myArr.item(0)="1"
myArr.item(1)="2"
myArr.item(2)="3"
myArr.item(3)="4"
myarr.sort(false)
afxmsg myarr.item(2)
thanks
ganlinlao
It does. It displays "2". What were you expecting?
You have specified to sort the array in descending order. Therefore myArr.item(0) becomes equal to "4", myArr.item(1)="3", myArr.item(2)="2" and myArr.item(3)="1".
Am I missing something?
Today, the same code I recompiled, it can work
But the last time, if i added myArr.sort(false) code, the compiler can pass, it can not display, it is strange.
I apologize to you for taking your precious time
String concatenation, I'm used to using & because it can cast into a string type, but this time I do not know why
No need to apologize, but your problem was not with the Sort method, but in the use of the & operator with CWSTR strings.
As explained in the help file for the CWindow framework:
Quote
CWSTR almost behave as if it was a native data type, working directly with most intrinsic Free Basic string functions and operators, with some exceptions (e.g. LEFT, RIGHT, VAL, & operator) in which you may need that you use a double indirection, i.e. **cws, or the wstr property (e.g. cws.wstr) to deference the string data.
Contrarily to the & operator, the + operator, always works.
Regarding MID as a statement, something like MID(cws, 2, 1) = "x" compiles but does not change the contents of the dynamic unicode string. MID(cws.wstr, 2, 1) = "x" or MID(**cws, 2, 1) = "x" works.
See also this thread: http://www.freebasic.net/forum/viewtopic.php?f=3&t=25191
A new project for the WinFBE editor: DShow_PlayClip. Demonstrates how to play videos using Direct Show.
' ########################################################################################
' Microsoft Windows
' DirectShow example.
' Allows to select a video clip and plays it.
' Based on an example by Vladimir Shulakov posted in the PowerBASIC forums:
' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24615-directshow-small-example?t=23966
' 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/AfxCOM.inc"
#INCLUDE ONCE "win/uuids.bi"
#INCLUDE ONCE "win/dshow.bi"
#INCLUDE ONCE "win/strmif.bi"
#INCLUDE ONCE "win/control.bi"
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)
' // Menu identifiers
CONST ID_FILE_OPENCLIP = 40001
CONST ID_FILE_EXIT = 40002
' // Custom message
CONST WM_GRAPHNOTIFY = WM_USER + 13
' // Globals
DIM SHARED bIsPlaying AS BOOLEAN
DIM SHARED pIMediaControl AS IMediaControl PTR
DIM SHARED pIVideoWindow AS IVideoWindow PTR
DIM SHARED pIMediaEventEx AS IMediaEventEx PTR
DIM SHARED pIGraphBuilder AS IGraphBuilder PTR
' // 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
' // Initialize the COM library
CoInitialize(NULL)
' // Creates the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "DirectShow demo: Play clip", @WndProc)
' // Use a black brush for the background
pWindow.Brush = CreateSolidBrush(BGR(0, 0, 0))
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(400, 320)
' // Centers the window
pWindow.Center
' // Create the menu
DIM hMenu AS HMENU = CreateMenu
DIM hMenuFile AS HMENU = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hMenuFile), "&File"
AppendMenuW hMenuFile, MF_ENABLED, ID_FILE_OPENCLIP, "&Open clip..."
AppendMenuW hMenuFile, MF_ENABLED, ID_FILE_EXIT, "E&xit"
SetMenu pWindow.hWindow, hMenu
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitalize COM
CoUninitialize
END FUNCTION
' ========================================================================================
' ========================================================================================
' Play the movie inside the window.
' ========================================================================================
SUB PlayMovieInWindow (BYVAL hwnd AS HWND, BYREF wszFileName AS WSTRING)
DIM hr AS HRESULT
' // If there is a clip loaded, stop it
IF pIMediaControl THEN
hr = pIMediaControl->lpvtbl->Stop(pIMediaControl)
AfxSafeRelease(pIMediaControl) : pIMediaControl = NULL
AfxSafeRelease(pIVideoWindow) : pIVideoWindow = NULL
AfxSafeRelease(pIMediaEventEx) : pIMediaEventEx = NULL
AfxSafeRelease(pIGraphBuilder) : pIGraphBuilder = NULL
END IF
' // Create an instance of the IGraphBuilder object
pIGraphBuilder = AfxNewCom(CLSID_FilterGraph)
IF pIGraphBuilder = NULL THEN EXIT SUB
' // Further error checking omitted for brevity
' // We should add IF hr <> S_OK THEN ...
' // Retrieve interafce pointers
hr = pIGraphBuilder->lpvtbl->QueryInterface(pIGraphBuilder, @IID_IMediaControl, @pIMediaControl)
hr = pIGraphBuilder->lpvtbl->QueryInterface(pIGraphBuilder, @IID_IMediaEventEx, @pIMediaEventEx)
hr = pIGraphBuilder->lpvtbl->QueryInterface(pIGraphBuilder, @IID_IVideoWindow, @pIVideoWindow)
' // Render the file
hr = pIMediaControl->lpvtbl->RenderFile(pIMediaControl, @wszFileName)
'// Set the window owner and style
hr = pIVideoWindow->lpvtbl->put_Visible(pIVideoWindow, OAFALSE)
hr = pIVideoWindow->lpvtbl->put_Owner(pIVideoWindow, cast(OAHWND, hwnd))
hr = pIVideoWindow->lpvtbl->put_WindowStyle(pIVideoWindow, WS_CHILD OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN)
' // Have the graph signal event via window callbacks for performance
hr = pIMediaEventEx->lpvtbl->SetNotifyWindow(pIMediaEventEx, cast(OAHWND, hwnd), WM_GRAPHNOTIFY, 0)
' // Set the window position
DIM rc AS RECT
GetClientRect(hwnd, @rc)
hr = pIVideoWindow->lpvtbl->SetWindowPosition(pIVideoWindow, rc.Left, rc.Top, rc.Right, rc.Bottom)
' // Make the window visible
hr = pIVideoWindow->lpvtbl->put_Visible(pIVideoWindow, OATRUE)
' // Run the graph
hr = pIMediaControl->lpvtbl->Run(pIMediaControl)
bIsPlaying = TRUE
END SUB
' ========================================================================================
' ========================================================================================
' 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_SYSCOMMAND
' // Capture this message and send a WM_CLOSE message
IF (wParam AND &HFFF0) = SC_CLOSE THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL, ID_FILE_EXIT
' // 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
CASE ID_FILE_OPENCLIP
' // Open file dialog
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
DIM wszFile AS WSTRING * MAX_PATH = "*.wmv"
DIM wszInitialDir AS STRING * MAX_PATH = CURDIR
DIM wszFilter AS WSTRING * 260 = "Video Files (*.MPG;*.MPEG;*.AVI;*.MOV;*.QTM;*.WMV)|*.MPG;*.MPEG;*.AVI;*.MOV;*.QT;*.WMV|" & "All Files (*.*)|*.*|"
DIM dwFlags AS DWORD = OFN_EXPLORER OR OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY
DIM wszFileName AS WSTRING * MAX_PATH
wszFileName = AfxOpenFileDialog(hwnd, "", wszFile, wszInitialDir, wszFilter, "wmv", @dwFlags, NULL)
IF LEN(wszFileName) THEN PlayMovieInWindow(hwnd, wszFileName)
EXIT FUNCTION
END IF
END SELECT
CASE WM_GRAPHNOTIFY
' // WM_GRAPHNOTIFY is an ordinary Windows message. Whenever the Filter Graph Manager
' // puts a new event on the event queue, it posts a WM_GRAPHNOTIFY message to the
' // designated application window. The message's lParam parameter is equal to the third
' // parameter in SetNotifyWindow. This parameter enables you to send instance data with
' // the message. The window message's wParam parameter is always zero.
DIM lEventCode AS LONG
DIM lParam1 AS LONG_PTR
DIM lParam2 AS LONG_PTR
IF pIMediaEventEx THEN
DO
DIM hr AS HRESULT
hr = pIMediaEventEx->lpvtbl->GetEvent(pIMediaEventEx, @lEventCode, @lParam1, @lParam2, 0)
IF hr <> S_OK THEN EXIT DO
pIMediaEventEx->lpvtbl->FreeEventParams(pIMediaEventEx, lEventCode, lParam1, lParam2)
IF lEventCode = EC_COMPLETE THEN
IF pIVideoWindow THEN
pIVideoWindow->lpvtbl->put_Visible(pIVideoWindow, OAFALSE)
pIVideoWindow->lpvtbl->put_Owner(pIVideoWindow, NULL)
AfxSafeRelease(pIVideoWindow)
pIVideoWindow = NULL
END IF
AfxSafeRelease(pIMediaControl): pIMediaControl = NULL
AfxSafeRelease(pIMediaEventEx) : pIMediaEventEx = NULL
AfxSafeRelease(pIGraphBuilder) : pIGraphBuilder = NULL
bIsPlaying = FALSE
AfxRedrawWindow hwnd
EXIT DO
END IF
LOOP
END IF
CASE WM_SIZE
' // Optional resizing code
IF wParam <> SIZE_MINIMIZED THEN
' // Resize the window and the video
DIM rc AS RECT
GetClientRect(hwnd, @rc)
IF pIVideoWindow THEN
pIVideoWindow->lpvtbl->SetWindowPosition(pIVideoWindow, rc.Left, rc.Top, rc.Right, rc.Bottom)
RedrawWindow hwnd, @rc, 0, RDW_INVALIDATE OR RDW_UPDATENOW
END IF
END IF
CASE WM_ERASEBKGND
' // Erase the window's background
IF bIsPlaying = FALSE THEN
DIM hDC AS HDC = cast(HDC, wParam)
DIM rc AS RECT
GetClientRect(hwnd, @rc)
FillRect hDC, @rc, GetStockObject(BLACK_BRUSH)
FUNCTION = CTRUE
EXIT FUNCTION
END IF
CASE WM_DESTROY
' // Stop de video if it is playing
IF pIMediaControl THEN
pIMediaControl->lpvtbl->Stop(pIMediaControl)
AfxSafeRelease(pIMediaControl)
END IF
' // Clean resources
IF pIVideoWindow THEN
pIVideoWindow->lpvtbl->put_Visible(pIVideoWindow, OAFALSE)
pIVideoWindow->lpvtbl->put_Owner(pIVideoWindow, NULL)
AfxSafeRelease(pIVideoWindow)
END IF
AfxSafeRelease(pIMediaEventEx)
AfxSafeRelease(pIGraphBuilder)
' // 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
' ========================================================================================
:)Well,Thanks
Every time I see winMain, wndproc, defwndproc, I always think, can not have a more easy way to use?
Especially: select case uMsg
Case
Case
Case
...
A long list of handling events, special annoyance, why not add an eventList or controls collection? Easy to write code and debug code
I like this way of coding. It is the most efficient and less bloated.
Alternatives: You can use message crackers, like Paul is doing in his WinFBE editor, or instead of calling pWindow.DoEvents, you can replace it with a call to your own function, where you can do wathever you like. If you want controls collection and/or other VB-like features, you will have to write your own class or use one of the available toolkits, such GTK or IUP.
I'm working on something that should make it easier to create CWindow applications. Just need to get at least a prototype posted so people can see if it is worth developing more deeply.
Code would look like this. No need to deal with message pumps or Window Procedures.
Dim byref frmMain as clsForm = wlNew(clsForm, "frmMain")
with frmMain
.Size = 600, 400
.StartPosition = FormStartPosition.CenterScreen
.Text = "Form1"
.OnLoad = @frmMain_Load()
.OnActivated = @frmMain_Activated()
.OnDeactivate = @frmMain_Deactivate()
.OnShown = @frmMain_Shown()
.OnMouseMove = @frmMain_MouseMove()
.OnFormClosing = @frmMain_FormClosing()
.OnFormClosed = @frmMain_FormClosed()
.OnMove = @frmMain_Move()
.OnResize = @frmMain_Resize()
end with
Dim byref cmdShowPopup as clsButton = wlNew(clsButton, "cmdShowPopup")
with cmdShowPopup
.Text = "Show Popup"
.SetBounds(200, 100, 100, 30)
.OnClick = @cmdShowPopup_Click()
end with
frmMain.Controls.Add(cmdShowPopup)
''
''
function frmMain_Load( byref sender as object, byref e as EventArgs ) as LRESULT
Dim byref frmMain as clsForm = wlCast(clsForm, sender)
print "Form Load hWin = "; frmMain.hWindow
function = 0
END FUNCTION
''
''
function frmMain_Activated( byref sender as object, byref e as EventArgs ) as LRESULT
Dim byref frmMain as clsForm = wlCast(clsForm, sender)
print "Form Activated hWin = "; frmMain.hWindow
function = 0
END FUNCTION
''
''
function frmMain_Deactivate( byref sender as object, byref e as EventArgs ) as LRESULT
Dim byref frmMain as clsForm = wlCast(clsForm, sender)
print "Form Deactivate hWin = "; frmMain.hWindow
function = 0
END FUNCTION
''
''
function frmMain_Shown( byref sender as object, byref e as EventArgs ) as LRESULT
Dim byref frmMain as clsForm = wlCast(clsForm, sender)
print "Form Shown hWin = "; frmMain.hWindow
function = 0
END FUNCTION
''
''
function frmMain_FormClosing( byref sender as object, byref e as CancelEventArgs ) as LRESULT
Dim byref frmMain as clsForm = wlCast(clsForm, sender)
print "Form Closing hWin = "; frmMain.hWindow
' To prevent the Form from closing set the Cancel proprty to TRUE
' e.Cancel = true
function = 0
END FUNCTION
''
''
function frmMain_FormClosed( byref sender as object, byref e as EventArgs ) as LRESULT
Dim byref frmMain as clsForm = wlCast(clsForm, sender)
print "Form Closed hWin = "; frmMain.hWindow
function = 0
END FUNCTION
Quote from: TechSupport on May 17, 2017, 05:48:11 PM
Code would look like this. No need to deal with message pumps or Window Procedures.
I like that. Simple and easy to jump in when you need to.
Rick
When coding by hand, as I always do, this approach doesn't make it any easier, but more convoluted. So, I assume that what you mean is that you need it for your planned visual designer.
Yes, write the base class of the package is very hard, but the appropriate package class, the use of people will become more simple and easy to use.
In China, some people use pure c depth to transform lua language, named Aardio, it is an explanatory language, support oop, the following is a simple example: In this example, we do not see a long list of select case Umsg, do not see wndproc, defwndproc, do not see com -> lpvtbl, they are hidden very well, the use of people to write code becomes very easy.
Although aardio and freebasic are two different languages, not comparable, but I still believe that the appropriate class package, can really bring convenience.
=========================
import win.ui;
import com;
/*DSG{{*/
var winform = win.form(text="window mediaplayer control";right=626;bottom=482)
winform.add(
btnDump={cls="button";text="Show wmplayer members";left=427;top=445;right=589;bottom=472;db=1;dr=1;z=4};
btnPlay={cls="button";text="play";left=224;top=445;right=312;bottom=472;db=1;dr=1;z=2};
btnStop={cls="button";text="stop";left=328;top=445;right=416;bottom=472;db=1;dr=1;z=3};
static={cls="static";left=32;top=16;right=606;bottom=434;db=1;dl=1;dr=1;dt=1;edge=1;notify=1;z=1}
)
/*}}*/
winform.static.oncommand = function(id,event){
//winform.msgbox( winform.static.text );
}
//Create a ocx control
var wmplay = winform.static.createEmbed("{6BF52A52-394A-11d3-B153-00C04F79FAA6}");
wmplay._object.Url = "file:/G:\Freebasic\FBTest\DShow_PlayClip\DShow_PlayClip\Secretarys_ass.wmv"
wmplay._object.stretchToFit = true;
/*
The following code prevents the video from blinking when the drag changes the window size
Note that winform.static should not be set to transparent
*/
winform.static.modifyStyle(, 0x2000000/*_WS_CLIPCHILDREN*/ )
winform.modifyStyle(, 0x2000000/*_WS_CLIPCHILDREN*/ )
winform.btnStop.oncommand = function(id,event){
wmplay._object.controls.stop()
}
winform.btnPlay.oncommand = function(id,event){
wmplay._object.controls.play()
}
winform.btnDump.oncommand = function(id,event){
io.open();
com.DumpTypeInfo(wmplay._object)
}
winform.show(true)
win.loopMessage();
==============================
Quote from: Jose Roca on May 17, 2017, 11:35:33 PM
When coding by hand, as I always do, this approach doesn't make it any easier, but more convoluted. So, I assume that what you mean is that you need it for your planned visual designer.
For both really. It should (I hope) make it easier for the general programmer to quickly put together a working application; and also help with code generation once I get the visual designer front end done. I fear that without this type of approach that a lot of the CWindow functionality will go unused because a lot of Windows programmers are very apprehensive about learning the Win32 api programming techniques (we've seen that with PowerBasic and now also with FreeBasic).
The Aardio example clearly uses Automation. To support such a syntax with Free Basic, a pre-processor would be needed. Too much work.
Besides, the examples aren't comparable because mine is using DirectShow and the Aardio one is embedding Windows Media Player, which does not work very well with High DPI aware applications.
With DirectShow, you can build your own media player. Automation only languages can't use DirectShow or the new Media Foundation interfaces.
Probably because I never have used Classic Visual Basic, I don't have developed a phobia about message pumps and window procedures.
CWSTR.INC next vesion:
Modified the overloaded LEN operator. New code is faster, specially with long strings:
' ========================================================================================
' Returns the length, in characters, of the CWSTR.
' ========================================================================================
'PRIVATE OPERATOR LEN (BYREF cws AS CWSTR) AS UINT
' CWSTR_DP("CWSTR OPERATOR LEN - len: " & .WSTR(.LEN(**cws)))
' OPERATOR = .LEN(**cws)
'END OPERATOR
' ========================================================================================
' ========================================================================================
PRIVATE OPERATOR LEN (BYREF cws AS CWSTR) AS UINT
CWSTR_DP("CWSTR OPERATOR LEN - len: " & .WSTR(cws.m_BufferLen \ 2))
OPERATOR = cws.m_BufferLen \ 2
END OPERATOR
' ========================================================================================
thanks,Look forward to the wonderful new version
I'm working in a WMI wrapper class.
Usage example:
#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CWmiCli.inc"
USING Afx
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT DeviceID, Description, Name FROM Win32_CDROMDrive")
IF pWmi.MoveNext THEN
AfxMsg pWmi.GetStr("DeviceID")
AfxMsg pWmi.GetStr("Description")
AfxMsg pWmi.GetStr("Name")
END IF
Error codes can be retrieved calling the GetLastResult method, and a localized description of the error can be retrieved calling the GetErrorCodeText.
I'm testing it with my local computer only because I don'thave access to a server.
Modified the WmiTimeToFileTime method, that wasn't returnig the correct value.
Usage example:
#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CWmiCli.inc"
#INCLUDE ONCE "Afx/AfxTime.inc"
USING Afx
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT * FROM Win32_BIOS")
IF pWmi.MoveNext THEN
DIM cws AS CWSTR = pWmi.GetStr("ReleaseDate")
print cws
DIM FT as FILETIME = pWmi.WmiTimeToFileTime(*cws)
print AfxFileTimeToDateStr(ft, "dd-MM-yyyy")
print AfxFileTimeToTimeStr(ft, "hh':'mm':'ss")
END IF
Thank you Jose. I'm always downloading the latest version, and, have not yet had any issues with the project I'm working on.
Rick
I wanted to have an easy to use WMI wrapper class because WMI is a powerful technology to get management information. Writing wrapper functions with this class is a piece of cake: usually we only need to change the WMI class name and the property name in the query.
A few quick examples:
' ========================================================================================
' Retrieves the baseboard (also known as a motherboard or system board) serial number.
' ========================================================================================
FUNCTION AfxGetBaseBoardSerialNumber () AS CWSTR
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT SerialNumber FROM Win32_BaseBoard")
IF pWmi.MoveNext THEN RETURN pWmi.GetStr("SerialNumber")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the Bios serial number.
' ========================================================================================
FUNCTION AfxGetBiosSerialNumber () AS CWSTR
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT SerialNumber FROM Win32_BIOS")
IF pWmi.MoveNext THEN RETURN pWmi.GetStr("SerialNumber")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the manufacturer serial number.
' Requires Windows Vista+.
' ========================================================================================
FUNCTION AfxGetManufacturerSerialNumber () AS CWSTR
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT SerialNumber FROM Win32_PhysicalMedia")
IF pWmi.MoveNext THEN RETURN pWmi.GetStr("SerialNumber")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the disk drive serial number.
' Returns the same number that AfxGetManufacturerSerialNumber.
' Requires Windows Vista+.
' ========================================================================================
FUNCTION AfxGetDiskDriveSerialNumber () AS CWSTR
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT SerialNumber FROM Win32_DiskDrive")
IF pWmi.MoveNext THEN RETURN pWmi.GetStr("SerialNumber")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the address width of the processor. On a 32-bit operating system, the value is
' 32 and on a 64-bit operating system it is 64. This function can be used to determine if
' the processor is 32 or 64 bit.
' ========================================================================================
FUNCTION AfxGetAddressWidth () AS USHORT
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT AddressWidth FROM Win32_Processor")
DIM vRes AS VARIANT
IF pWmi.MoveNext THEN
IF pWmi.GetVar("AddressWidth", @vRes) = S_OK THEN
RETURN vRes.uiVal
END IF
END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the system running on the Windows-based computer. The following list identifiers
' the returned value: "X86-based PC", "MIPS-based PC", "Alpha-based PC", "Power PC",
' "SH-x PC", "StrongARM PC", "64-bit Intel PC", "64-bit Alpha PC", "Unknown", "X86-Nec98 PC".
' ========================================================================================
FUNCTION AfxGetSystemType () AS CWSTR
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT SystemType FROM Win32_ComputerSystem")
IF pWmi.MoveNext THEN RETURN pWmi.GetStr("SystemType")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the architecture of the operating system, as opposed to the processor.
' Example: "64 bits".
' Not available in Windows Server 2003, Windows 2000, Windows NT 4.0, Windows XP, and Windows Me/98/95.
' ========================================================================================
FUNCTION AfxGetOSArchitecture () AS CWSTR
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT OSArchitecture FROM Win32_OperatingSystem")
IF pWmi.MoveNext THEN RETURN pWmi.GetStr("OSArchitecture")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the type of the computer in use, such as laptop, desktop, or Tablet.
' Not available in Windows Server 2003, Windows XP, Windows 2000, Windows NT 4.0, and Windows Me/98/95.
' Value Meaning
' ------- --------------------------------------------
' 0 (&H0) Unspecified
' 1 (&H1) Desktop
' 2 (&H2) Mobile
' 3 (&H3) Workstation
' 4 (&H4) Enterprise Server
' 5 (&H5) Small Office and Home Office (SOHO) Server
' 6 (&H6) Appliance PC
' 7 (&H7) Performance Server
' 8 (&H8) Maximum
' ========================================================================================
FUNCTION AfxGetPCSystemType () AS USHORT
DIM pWmi AS CWmiCli = "root\cimv2"
pWmi.ExecQuery("SELECT PCSystemType FROM Win32_ComputerSystem")
DIM vRes AS VARIANT
IF pWmi.MoveNext THEN
IF pWmi.GetVar("PCSystemType", @vRes) = S_OK THEN
RETURN vRes.uiVal
END IF
END IF
END FUNCTION
' ========================================================================================
Look at this C++ example and you will appreciate what the CWmiCli class is doing for us:
#define _WIN32_DCOM
#include <iostream>
using namespace std;
#include <comdef.h>
#include <Wbemidl.h>
#pragma comment(lib, "wbemuuid.lib")
int main(int argc, char **argv)
{
HRESULT hres;
// Step 1: --------------------------------------------------
// Initialize COM. ------------------------------------------
hres = CoInitializeEx(0, COINIT_MULTITHREADED);
if (FAILED(hres))
{
cout << "Failed to initialize COM library. Error code = 0x"
<< hex << hres << endl;
return 1; // Program has failed.
}
// Step 2: --------------------------------------------------
// Set general COM security levels --------------------------
hres = CoInitializeSecurity(
NULL,
-1, // COM authentication
NULL, // Authentication services
NULL, // Reserved
RPC_C_AUTHN_LEVEL_DEFAULT, // Default authentication
RPC_C_IMP_LEVEL_IMPERSONATE, // Default Impersonation
NULL, // Authentication info
EOAC_NONE, // Additional capabilities
NULL // Reserved
);
if (FAILED(hres))
{
cout << "Failed to initialize security. Error code = 0x"
<< hex << hres << endl;
CoUninitialize();
return 1; // Program has failed.
}
// Step 3: ---------------------------------------------------
// Obtain the initial locator to WMI -------------------------
IWbemLocator *pLoc = NULL;
hres = CoCreateInstance(
CLSID_WbemLocator,
0,
CLSCTX_INPROC_SERVER,
IID_IWbemLocator, (LPVOID *) &pLoc);
if (FAILED(hres))
{
cout << "Failed to create IWbemLocator object."
<< " Err code = 0x"
<< hex << hres << endl;
CoUninitialize();
return 1; // Program has failed.
}
// Step 4: -----------------------------------------------------
// Connect to WMI through the IWbemLocator::ConnectServer method
IWbemServices *pSvc = NULL;
// Connect to the root\cimv2 namespace with
// the current user and obtain pointer pSvc
// to make IWbemServices calls.
hres = pLoc->ConnectServer(
_bstr_t(L"ROOT\\CIMV2"), // Object path of WMI namespace
NULL, // User name. NULL = current user
NULL, // User password. NULL = current
0, // Locale. NULL indicates current
NULL, // Security flags.
0, // Authority (for example, Kerberos)
0, // Context object
&pSvc // pointer to IWbemServices proxy
);
if (FAILED(hres))
{
cout << "Could not connect. Error code = 0x"
<< hex << hres << endl;
pLoc->Release();
CoUninitialize();
return 1; // Program has failed.
}
cout << "Connected to ROOT\\CIMV2 WMI namespace" << endl;
// Step 5: --------------------------------------------------
// Set security levels on the proxy -------------------------
hres = CoSetProxyBlanket(
pSvc, // Indicates the proxy to set
RPC_C_AUTHN_WINNT, // RPC_C_AUTHN_xxx
RPC_C_AUTHZ_NONE, // RPC_C_AUTHZ_xxx
NULL, // Server principal name
RPC_C_AUTHN_LEVEL_CALL, // RPC_C_AUTHN_LEVEL_xxx
RPC_C_IMP_LEVEL_IMPERSONATE, // RPC_C_IMP_LEVEL_xxx
NULL, // client identity
EOAC_NONE // proxy capabilities
);
if (FAILED(hres))
{
cout << "Could not set proxy blanket. Error code = 0x"
<< hex << hres << endl;
pSvc->Release();
pLoc->Release();
CoUninitialize();
return 1; // Program has failed.
}
// Step 6: --------------------------------------------------
// Use the IWbemServices pointer to make requests of WMI ----
// For example, get the name of the operating system
IEnumWbemClassObject* pEnumerator = NULL;
hres = pSvc->ExecQuery(
bstr_t("WQL"),
bstr_t("SELECT * FROM Win32_OperatingSystem"),
WBEM_FLAG_FORWARD_ONLY | WBEM_FLAG_RETURN_IMMEDIATELY,
NULL,
&pEnumerator);
if (FAILED(hres))
{
cout << "Query for operating system name failed."
<< " Error code = 0x"
<< hex << hres << endl;
pSvc->Release();
pLoc->Release();
CoUninitialize();
return 1; // Program has failed.
}
// Step 7: -------------------------------------------------
// Get the data from the query in step 6 -------------------
IWbemClassObject *pclsObj = NULL;
ULONG uReturn = 0;
while (pEnumerator)
{
HRESULT hr = pEnumerator->Next(WBEM_INFINITE, 1,
&pclsObj, &uReturn);
if(0 == uReturn)
{
break;
}
VARIANT vtProp;
// Get the value of the Name property
hr = pclsObj->Get(L"Name", 0, &vtProp, 0, 0);
wcout << " OS Name : " << vtProp.bstrVal << endl;
VariantClear(&vtProp);
pclsObj->Release();
}
// Cleanup
// ========
pSvc->Release();
pLoc->Release();
pEnumerator->Release();
CoUninitialize();
return 0; // Program successfully completed.
}
Since connecting with remote servers requires much more work: computer name, user name, password, authority, encrypted credentials, different flags to initialize the security and set the proxy blanket..., and I don't have the means of testing, I'm limiting this class for use with the local computer only, at least for now.
I have finished a class, CCdoMessage, that easily allows to send email messages using CDO.
Example
' // Create an instance of the CCdoMessage class
DIM pMsg AS CCdoMessage
' // Configuration
pMsg.ConfigValue(cdoSendUsingMethod, CdoSendUsingPort)
pMsg.ConfigValue(cdoSMTPServer, "smtp.xxxxx.xxx")
pMsg.ConfigValue(cdoSMTPServerPort, 25)
pMsg.ConfigValue(cdoSMTPAuthenticate, 1)
pMsg.ConfigValue(cdoSendUserName, "xxxx@xxxx.xxx")
pMsg.ConfigValue(cdoSendPassword, "xxxxxxxx")
pMsg.ConfigValue(cdoSMTPUseSSL, 1)
pMsg.ConfigUpdate
' // Recipient name --> change as needed
pMsg.Recipients("xxxxx@xxxxx")
' // Sender mail address --> change as needed
pMsg.From("xxxxx@xxxxx")
' // Subject --> change as needed
pMsg.Subject("This is a sample subject")
' // Text body --> change as needed
pMsg.TextBody("This is a sample message text")
' // Add the attachment (use absolute paths).
' // Note By repeating the call you can attach more than one file.
pMsg.AddAttachment ExePath & "\xxxxx.xxx"
' // Send the message
pMsg.Send
IF pMsg.GetLastResult = S_OK THEN PRINT "Message sent" ELSE PRINT "Failure"
To send messages using gmail, simply change the values of the server name and the server port:
pMsg.ConfigValue(cdoSMTPServer, "smtp.gmail.com")
pMsg.ConfigValue(cdoSMTPServerPort, 465)
Thanks, jose, the content of the framework is getting richer,
I suggest that the "for each in" syntax should be added through the macro
I really like the CDO email. That makes things so easily incorporated into an application.
Rick
Changed the AfxSafeRelease function to set the passed pointer to null.
' ========================================================================================
PRIVATE FUNCTION AfxSafeRelease (BYREF pv AS ANY PTR) AS ULONG
IF pv = NULL THEN RETURN 0
FUNCTION = cast(IUnknown PTR, pv)->lpvtbl->Release(pv)
pv = NULL
END FUNCTION
' ========================================================================================
Modified the AfxGdipImageFromFile function to use CreateFileW because FB OPEN function uses ansi filenames.
' ========================================================================================
' Loads an image from a file, converts it to an icon or bitmap and returns the handle.
' Parameters:
' - wszFileName = [in] Path of the image to load and convert.
' - dimPercent = Percent of dimming (1-99)
' - bGrayScale = TRUE or FALSE. Convert to gray scale.
' - imageType = IMAGE_ICON or IMAGE_BITMAP.
' - clrBackground = [in] The background color. This parameter is ignored if the image type
' is IMAGE_ICON or the bitmap is totally opaque.
' Return Value:
' If the function succeeds, the return value is the handle of the created icon or bitmap.
' If the function fails, the return value is NULL.
' Remarks:
' A quirk in the GDI+ GdipLoadImageFromFile function causes that dim gray images (often used
' for disabled icons) are converted to darker shades of gray. Therefore, instead of using it
' I'm getting here the image data opening the file with OPEN in binary mode.
' ========================================================================================
PRIVATE FUNCTION AfxGdipImageFromFile (BYREF wszFileName AS WSTRING, _
BYVAL dimPercent AS LONG = 0, BYVAL bGrayScale AS LONG = FALSE, _
BYVAL imageType AS LONG = IMAGE_ICON, BYVAL clrBackground AS ARGB = 0) AS HANDLE
DIM fd AS WIN32_FIND_DATAW
' // Check for the existence of the file
IF LEN(wszFileName) = 0 THEN EXIT FUNCTION
DIM hFind AS HANDLE = FindFirstFileW(@wszFileName, @fd)
IF hFind = INVALID_HANDLE_VALUE THEN EXIT FUNCTION
FindClose hFind
' // Make sure that is not a directory or a temporary file
IF (fd.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY OR _
(fd.dwFileAttributes AND FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY THEN
EXIT FUNCTION
END IF
' ' // Open the file and store its contents into a buffer
' DIM nFile AS LONG, bufferSize AS SIZE_T_
' nFile = FREEFILE
' OPEN wszFileName FOR BINARY AS nFile
' IF ERR THEN EXIT FUNCTION
' bufferSize = LOF(nFile)
' DIM pBuffer AS UBYTE PTR
' pBuffer = CAllocate(1, bufferSize)
' GET #nFile, , *pBuffer, bufferSize
' CLOSE nFile
' IF pBuffer THEN
' FUNCTION = AfxGdipImageFromBuffer(pBuffer, bufferSize, dimPercent, bGrayScale, imageType, clrBackground)
' DeAllocate(pBuffer)
' END IF
' // Use CreateFileW because Free Basic OPEN does not work with unicode file names.
' // Open the file and store its contents into a buffer
DIM bSuccess AS LONG, dwFileSize AS DWORD, dwHighSize AS DWORD, dwBytesRead AS DWORD
DIM hFile AS HANDLE = CreateFileW(@wszFileName, GENERIC_READ, FILE_SHARE_READ, NULL, _
OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL)
IF hFile = INVALID_HANDLE_VALUE THEN EXIT FUNCTION
' // Get the size of the file
dwFileSize = GetFileSize(hFile, @dwHighSize)
IF dwHighSize THEN
CloseHandle(hFile)
EXIT FUNCTION
END IF
DIM pBuffer AS UBYTE PTR
pBuffer = CAllocate(1, dwFileSize)
bSuccess = ReadFile(hFile, pBuffer, dwFileSize, @dwBytesRead, NULL)
CloseHandle(hFile)
IF bSuccess THEN
IF pBuffer THEN
FUNCTION = AfxGdipImageFromBuffer(pBuffer, dwFileSize, dimPercent, bGrayScale, imageType, clrBackground)
DeAllocate(pBuffer)
END IF
END IF
END FUNCTION
' ========================================================================================
Added a new method to the Graphic Control: LoadImageFromRes.
' ========================================================================================
' Loads the specified image from a resource file in the Graphic Control.
' Parameters:
' - hInstance = [in] A handle to the module whose portable executable file or an accompanying
' MUI file contains the resource. If this parameter is NULL, the function searches
' the module used to create the current process.
' - wszImageName = [in] Name of the image in the resource file (.RES). If the image resource uses
' an integral identifier, wszImage should begin with a number symbol (#)
' followed by the identifier in an ASCII format, e.g., "#998". Otherwise,
' use the text identifier name for the image. Only images embedded as raw data
' (type RCDATA) are valid. These must be icons in format .png, .jpg, .gif, .tiff.
' - dimPercent = Percent of dimming (1-99)
' - bGrayScale = TRUE or FALSE. Convert to gray scale.
' - clrBackground = [in] The background color. This parameter is ignored if the image type
' is IMAGE_ICON or the bitmap is totally opaque.
' ========================================================================================
PRIVATE SUB CGraphCtx.LoadImageFromRes (BYVAL hInst AS HINSTANCE, BYREF wszImageName AS WSTRING, _
BYVAL dimPercent AS LONG = 0, BYVAL bGrayScale AS LONG = FALSE, BYVAL clrBackground AS ARGB = 0)
' // Initialize Gdiplus
' DIM token AS ULONG_PTR = AfxGdipInit
' IF token = NULL THEN EXIT SUB
DIM hbmp AS HBITMAP = AfxGdipBitmapFromRes(hInst, wszImageName, dimPercent, bGrayScale, clrBackground)
IF hbmp THEN
DIM bm AS BITMAP, hMemDC AS HDC
hMemDC = .CreateCompatibleDC(m_hMemDC)
IF hMemDC THEN
IF .GetObject(hbmp, SIZEOF(BITMAP), @bm) THEN
this.SetVirtualBufferSize(bm.bmWidth, bm.bmHeight)
this.Clear m_bkcolor
DIM Oldbmp AS HBITMAP
Oldbmp = .SelectObject(hMemDC, hbmp)
.BitBlt m_hMemDC, 0, 0, bm.bmWidth, bm.bmHeight, hMemDC, 0, 0, SRCCOPY
.SelectObject(hMemDC, Oldbmp)
END IF
DeleteDC hMemDC
END IF
DeleteObject hbmp
END IF
' // Shutdown Gdiplus
' GdiplusShutdown token
END SUB
' ========================================================================================
...and also the DrawBitmap method, to work with the new CMemBmp class.
The CMemBmp class implements a memory bitmap.
You can create an empty bitmap of the specified width an height, e.g.
DIM pMemBmp AS CMemBmp = CMemBmp(500, 400)
or loading an image
DIM pMemBmp AS CMemBmp = CMemBmp("C:\Users\Pepe\Pictures\Cole_Kyla_01.jpg")
You can manipulate its contents using GDI+ or GDI, e.g.
Rectangle pMemBmp.GetMemDC, 10, 10, 150, 150
LineTo pMemBmp.GetMemDC, 30, 180
And you can display it in a Graphic Control, e.g.
pGraphCtx.DrawBitmap pMemBmp
The bitmap can be saved to a file with
SaveBitmap
SaveBitmapAsBmp
SaveBitmapAsJpeg
SaveBitmapAsPng
SaveBitmapAsGif
SaveBitmapAsTiff
Finally, the PrintBitmap method prints the bitmap in the default printer.
The next version is going to be a cool one.
I have just finished CDSAudio, a class that uses Direct Show to play audio files. It supports a great variety of formats.
You can create an instance of the class and load the file at the same time with:
DIM pCDSAudio AS CDSAudio = ExePath & "\prodigy.wav"
pCDSAudio.Run
or you can use the default constructor and then load the file:
DIM pCDSAudio AS CDSAudio
pCDSAudio.Load(ExePath & "\prodigy.wav")
pCDSAudio.Run
With the Load method you can change the audio file on the fly.
To receive event messages, you can define a custom message:
#define WM_GRAPHNOTIFY WM_APP + 1
and pass it to the class the handle of the window that will process the message:
pCDSAudio.SetNotifyWindow(pWindow.hWindow, WM_GRAPHNOTIFY, 0)
And process the messages in the window callback procedure:
CASE WM_GRAPHNOTIFY
DIM AS LONG lEventCode
DIM AS LONG_PTR lParam1, lParam2
WHILE (SUCCEEDED(pCDSAudio.GetEvent(lEventCode, lParam1, lParam2)))
SELECT CASE lEventCode
CASE EC_COMPLETE: ' Handle event
CASE EC_USERABORT: ' Handle event
CASE EC_ERRORABORT: ' Handle event
END SELEct
WEND
There are other methods to get/set the volume and balance, to get the duration and current position, to set the positions, and to pause or stop.
I will see if i can to write a similar one but for video.
Jeez Jose, I can't keep up and try/test with your avalanche of objects.... :o
Rick
Another one to play audio CDs using MCI:
Usage example:
DIM pAudio AS CCDAudio
pAudio.Open
pAudio.Play
Available methods:
' ########################################################################################
' CCDAudio - MCI CD Audio class
' ########################################################################################
TYPE CCDAudio
Private:
m_dwError AS MCIERROR
Public:
DECLARE CONSTRUCTOR
DECLARE DESTRUCTOR
DECLARE FUNCTION GetLastError () AS MCIERROR
DECLARE FUNCTION SetError (BYVAL dwError AS MCIERROR) AS MCIERROR
DECLARE FUNCTION GetErrorString (BYVAL dwError AS MCIERROR = 0) AS CWSTR
DECLARE FUNCTION Open () AS MCIERROR
DECLARE FUNCTION Close () AS MCIERROR
DECLARE FUNCTION IsReady () AS BOOLEAN
DECLARE FUNCTION IsMediaInserted () AS BOOLEAN
DECLARE FUNCTION IsPaused () AS BOOLEAN
DECLARE FUNCTION IsStopped () AS BOOLEAN
DECLARE FUNCTION IsPlaying () AS BOOLEAN
DECLARE FUNCTION IsSeeking () AS BOOLEAN
DECLARE FUNCTION OpenDoor () AS MCIERROR
DECLARE FUNCTION CloseDoor () AS MCIERROR
DECLARE FUNCTION Play () AS MCIERROR
DECLARE FUNCTION PlayFrom (BYVAL nTrack AS LONG) AS MCIERROR
DECLARE FUNCTION PlayFromTo (BYVAL nStartTrack AS LONG, BYVAL nEndTrack AS LONG) AS MCIERROR
DECLARE FUNCTION Stop () AS MCIERROR
DECLARE FUNCTION Pause () AS MCIERROR
DECLARE FUNCTION GetTracksCount () AS LONG
DECLARE FUNCTION GetCurrentTrack () AS LONG
DECLARE FUNCTION GetTrackLengthString (BYVAL nTrack AS LONG) AS CWSTR
DECLARE FUNCTION GetTrackLength (BYVAL nTrack AS LONG) AS LONG
DECLARE FUNCTION GetAllTracksLengthString () AS CWSTR
DECLARE FUNCTION GetAllTracksLength () AS LONG
DECLARE FUNCTION GetCurrentPosString () AS CWSTR
DECLARE FUNCTION GetCurrentPos () AS LONG
DECLARE FUNCTION ToStart () AS MCIERROR
DECLARE FUNCTION ToEnd () AS MCIERROR
DECLARE FUNCTION Forward () AS BOOLEAN
DECLARE FUNCTION Backward () AS BOOLEAN
DECLARE FUNCTION GetTrackStartTimeString (BYVAL nTrack AS LONG) AS CWSTR
DECLARE FUNCTION GetTrackStartTime (BYVAL nTrack AS LONG) AS LONG
END TYPE
' ########################################################################################