' ########################################################################################
' Microsoft Windows
' File: CW_IFileOpenDialog.fbtpl - Template
' Contents: Demonstrates the use of the IFileOpenDialog interface.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 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
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/shobjidl.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
CONST IDC_OFD = 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, COMMAND(), SW_NORMAL)
' ========================================================================================
' Displays the FileOpenDialog.
' The returned pointer must be freed with CoTaskMemFree
' ========================================================================================
FUNCTION AfxIFileOpenDialogW (BYVAL hwndOwner AS HWND) AS WSTRING PTR
DIM hr AS LONG
DIM CLSID_FileOpenDialog AS CLSID = (&hDC1C5A9C, &hE88A, &h4DDE, {&hA5, &hA1, &h60, &hF8, &h2A, &h20, &hAE, &hF7})
DIM IID_IFileOpenDialog AS GUID = (&hD57C7288, &hD4AD, &h4768, {&hBE, &h02, &h9D, &h96, &h95, &h32, &hD9, &h60})
' // Create an instance of the FileOpenDialog object
DIM pofd AS IFileOpenDialog PTR
hr = CoCreateInstance(@CLSID_FileOpenDialog, NULL, CLSCTX_INPROC_SERVER, @IID_IFileOpenDialog, @pofd)
IF pofd = NULL THEN RETURN NULL
' // Set the file types
DIM rgFileTypes(1 TO 3) AS COMDLG_FILTERSPEC
rgFileTypes(1).pszName = @WSTR("PB code files")
rgFileTypes(2).pszName = @WSTR("Executable files")
rgFileTypes(3).pszName = @WSTR("All files")
rgFileTypes(1).pszSpec = @WSTR("*.bas;*.inc")
rgFileTypes(2).pszSpec = @WSTR("*.exe;*.dll")
rgFileTypes(3).pszSpec = @WSTR("*.*")
pofd->lpVtbl->SetFileTypes(pofd, 3, @rgFileTypes(1))
' // Set the title of the dialog
hr = pofd->lpVtbl->SetTitle(pofd, "A Single-Selection Dialog")
' // Display the dialog
hr = pofd->lpVtbl->Show(pofd, hwndOwner)
' // Get the result
DIM pItem AS IShellItem PTR
DIM pwszName AS WSTRING PTR
IF SUCCEEDED(hr) THEN
hr = pofd->lpVtbl->GetResult(pofd, @pItem)
IF SUCCEEDED(hr) THEN
hr = pItem->lpVtbl->GetDisplayName(pItem, SIGDN_FILESYSPATH, @pwszName)
FUNCTION = pwszName
END IF
END IF
' // Cleanup
IF pItem THEN pItem->lpVtbl->Release(pItem)
IF pofd THEN pofd->lpVtbl->Release(pofd)
END FUNCTION
' ========================================================================================
' ========================================================================================
' 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_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_OFD
IF HIWORD(wParam) = BN_CLICKED THEN
' // Display the Open File Dialog
DIM pwszName AS WSTRING PTR = AfxIFileOpenDialogW(hwnd)
' // Display the name of the selected file
IF pwszName THEN
MessageBoxW(hwnd, *pwszName, "IFileOpenDialog", MB_OK)
CoTaskMemFree pwszName
END IF
EXIT FUNCTION
END IF
END SELECT
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Initialize the COM library
CoInitialize(NULL)
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "IFileOpenDialog example", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDC_OFD, "&Open File Dialog", 350, 250, 110, 23)
' // Process event messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitialize the COM library
CoUninitialize
END FUNCTION
' ========================================================================================
Works perfect for me.
It is like coming back to the times of PowerBASIC 6.1.
Fortunately I did learn COM programming the hard way and know how to work with it at low level.
Dominic will be happy with this compiler, because he likes to program this way.
good work josé
I tried to convert your OLECON;inc to Freebasic and for now this work for some activex and fails for another.
perhaps it is not good to post it for the moment?
Post it here if you want and I will look at it.
ok it is too big.
http://www.2shared.com/file/_SRYrFCZ/OLECON.html (http://www.2shared.com/file/_SRYrFCZ/OLECON.html)
Too big to post the source code, but have you tried to zip it as post it as an attachment?
Can't connect with
http://www.2shared.com/file/_SRYrFCZ/OLECON.html
at this moment. It time-outs.
I finally have been able to download it.
Sorry , one thing is that you need some modified headers.
here the grinding of FREEBASIC 1.05.0 containing the .bi files modified to also take into account the virtual classes
It is necessary to remind that these are only the files contained in the Win folder which are concerned.
The remainder without chagement.
A possibility is to rename the folder Freebasic/inc/win in your installation by Freebasic/inc/win_ and to copy my folder win in Freebasic/inc/
test your old projects, they will have to work.
if you have a project using the vtbl, it will be necessary to add in any beginning #define _ FB_COM_VTBL _
http://www.2shared.com/file/11E5di-_/win.html (http://www.2shared.com/file/11E5di-_/win.html)
some examples to test: http://www.2shared.com/file/eJYl-WIo/test_project.html (http://www.2shared.com/file/eJYl-WIo/test_project.html)
> and for now this work for some activex and fails for another.
Can you tell me which ones work and which ones fail?
Be aware that some VB OCXs never have worked fine with my OLE container.
For example, the FlexGrid and the MSHFlexGrid worked, but the DataGrid one don't.
yes Jose, but there is still work to make with the FREEBASIC version
here is an example of use of msflxgrid
testolecon_reg.exe has a bug while clicking on the header of the grid
whereas testolecon_notreg.exe functions correctly
http://www.2shared.com/file/sG_EmGhc/msflexgrid_test.html (http://www.2shared.com/file/sG_EmGhc/msflexgrid_test.html)
Jose,
What is your position of COM with FreeBasic?
#1- I am working on my own approach.
#2- I am trying to adapt and use some/all of aloberr's code.
#3- Not interested.
James
I think that I'm going to use low-lewel COM and some helper functions. After all, now that the old VB OCXs are obsolete, we almost only need Automation to work with Office, and I don't use it.
Everything else that I have tried is not fully satisfactory. There is always the problem of freeing the temporary variables.
Jose,
I just noticed this example is for Win8+.
I thought you were running Win7?
Is it possible to target Win7 +
James
What makes you think that it is for Windows 8? I'm using Windows 7.
Quote from: Jose Roca on July 17, 2016, 05:31:22 PM
What makes you think that it is for Windows 8? I'm using Windows 7.
If I change #define _WIN32_WINNT &h0602
To
#define _WIN32_WINNT &h0601
a number of errors.
James
Currently, FreeBasic only supports &h0400, &h0502 and &h0602.
Quote from: Jose Roca on July 17, 2016, 05:48:53 PM
Currently, FreeBasic only supports &h0400, &h0502 and &h0602.
I have no idea what that means?
James
Just like the FB headers, that don't have idea of what &h0601 means.
They don't check for _WIN32_WINNT >= &H0601, but, most of the times, they use #if _WIN32_WINNT = &h0602.
Checking the include files, they only use &H0502 (for XP) and &H0602 (for Windows 7 and beyond). It saves them the headache of having to support so many values of the C++ headers.
If you only want to support up to XP, use #define _WIN32_WINNT &h0502, else use #define _WIN32_WINNT &h0602, and forget any other numbers.
Hi Jose,
I am successfully using your IFileOpenDialog to single and multiple files. Do you code for "open folder" ? That would be awesome :)
> Do you code for "open folder" ? That would be awesome :)
I'm working in an AfxShell.inc file that will include two browse for folder functions.
Browse for folder dialog
' ========================================================================================
' Displays a dialog box that enables the user to select a folder.
' - pwszTitle = A string value that represents the title displayed inside the Browse dialog box.
' - pwszStartFolder = The initial folder that the dialog will show.
' - nFlags = Optional. A LONG value that contains the options for the method. This can be a
' combination of the values listed under the ulFlags member of the BROWSEINFO structure.
' See: http://msdn.microsoft.com/en-us/library/windows/desktop/bb773205%28v=vs.85%29.aspx
' Default value = BIF_RETURNONLYFSDIRS OR BIF_DONTGOBELOWDOMAIN OR BIF_USENEWUI OR BIF_RETURNFSANCESTORS
' Note: To display the old style dialog, pass -1 in the dwFlags parameter.
' ========================================================================================
' // Browse for folder dialog procedure
PRIVATE FUNCTION AfxBrowseForFolderProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM wszBuffer AS WSTRING * MAX_PATH
IF uMsg = BFFM_INITIALIZED THEN
SendMessageW hwnd, BFFM_SETSELECTIONW, CTRUE, cast(LPARAM, lParam)
ELSEIF uMsg = BFFM_SELCHANGED THEN
SHGetPathFromIDListW(cast(ITEMIDLIST PTR, wParam), @wszBuffer)
IF wParam = 0 OR _ ' // No id number
LEN(wszBuffer) = 0 OR _ ' // No name
(GetFileAttributesW(wszBuffer) AND FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY OR _ ' // Not a real directory
MID(wszBuffer, 2, 1) <> ":" THEN ' // Not a local or mapped drive
SendMessageW hwnd, BFFM_ENABLEOK, FALSE, FALSE
ELSEIF ((GetFileAttributesW(wszBuffer) AND FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM) AND _
RIGHT(wszBuffer, 2) <> ":\" THEN ' // Exclude system folders, allow root directories
SendMessageW hwnd, BFFM_ENABLEOK, FALSE, FALSE
END IF
END IF
RETURN 0
END FUNCTION
PRIVATE FUNCTION AfxBrowseForFolder (BYVAL hwnd AS HWND, BYVAL pwszTitle AS WSTRING PTR = NULL, _
BYVAL pwszStartFolder AS WSTRING PTR = NULL, BYVAL nFlags AS LONG = 0) AS CWSTR
DIM wszBuffer AS WSTRING * MAX_PATH, bi AS BROWSEINFOW, pidl AS ITEMIDLIST PTR
IF nFlags = 0 THEN nFlags = BIF_RETURNONLYFSDIRS OR BIF_DONTGOBELOWDOMAIN OR BIF_USENEWUI OR BIF_RETURNFSANCESTORS
IF nFlags = -1 THEN nFlags = BIF_RETURNONLYFSDIRS OR BIF_DONTGOBELOWDOMAIN OR BIF_RETURNFSANCESTORS
bi.hWndOwner = hwnd
bi.lpszTitle = pwszTitle
bi.ulFlags = nFlags
bi.lpfn = cast(BFFCALLBACK, @AfxBrowseForFolderProc)
bi.lParam = cast(LPARAM, pwszStartFolder)
pidl = SHBrowseForFolderW(@bi)
IF pidl THEN
SHGetPathFromIDListW(pidl, @wszBuffer)
CoTaskMemFree pidl
END IF
RETURN wszBuffer
END FUNCTION
' ========================================================================================
Added a cast to
bi.lpfn = cast(BFFCALLBACK, @AfxBrowseForFolderProc)
otherwise, the 64 bit compiler complains.
COM version using the Shell interfaces. Remember to call CoInitialize NULL at the very beginning of your application and CoUninitialize at the end.
' ========================================================================================
' Displays a dialog box that enables the user to select a Shell folder.
' Paramaters:
' - hwnd = The handle to the parent window of the dialog box. This value can be zero.
' - pwszTitle = A string value that represents the title displayed inside the Browse dialog box.
' - Options = Optional. A LONG value that contains the options for the method. This can be zero or a
' combination of the values listed under the ulFlags member of the BROWSEINFO structure.
' See: http://msdn.microsoft.com/en-us/library/windows/desktop/bb773205%28v=vs.85%29.aspx
' - RootFolder = Optional. The root folder to use in the dialog box. The user cannot browse
' higher in the tree than this folder. If this value is not specified, the
' root folder used in the dialog box is the desktop. This value can be a
' string that specifies the path of the folder or one of the
' ShellSpecialFolderConstants values.
' See: http://msdn.microsoft.com/en-us/library/windows/desktop/bb774096%28v=vs.85%29.aspx
' Return Value:
' The path of the selected folder or an empty string if the dialog has been canceled.
' ========================================================================================
PRIVATE FUNCTION AfxShellBrowseForFolder OVERLOAD (BYVAL hwnd AS HWND, BYVAL pwszTitle AS WSTRING PTR, _
BYVAL Options AS LONG = 0, BYVAL pwszRootFolder AS WSTRING PTR = NULL) AS CBSTR
DIM cbs AS CBSTR
' // Create an instance of the IShellDispatch interface
DIM pShell AS IShellDispatch PTR
CoCreateInstance(@CLSID_Shell, NULL, CLSCTX_INPROC_SERVER, @IID_IShellDispatch, @pShell)
IF pShell = NULL THEN RETURN cbs
'// Call BrowseForFolder and get a reference to the Folder2 interface
DIM pFolder2 AS Folder2 PTR
DIM bstrTitle AS BSTR = SysAllocString(pwszTitle)
DIM vRootFolder AS VARIANT
V_VT(@vRootFolder) = VT_BSTR
V_BSTR(@vRootFolder) = SysAllocString(pwszRootFolder)
pShell->lpvtbl->BrowseForFolder(pShell, cast(LONG_PTR, hwnd), bstrTitle, Options, vRootFolder, cast(Folder PTR PTR, @pFolder2))
SysFreeString bstrTitle
VariantClear @vRootFolder
IF pFolder2 = NULL THEN
IUnknown_Release(pShell)
RETURN cbs
END IF
' // Get a reference tp the FolderItem interface
DIM pItem AS FolderItem PTR
pFolder2->lpvtbl->get_Self(pFolder2, @pItem)
IF pItem THEN pItem->lpvtbl->get_Path(pItem, @cbs)
' // Cleanup
IF pShell THEN IUnknown_Release(pShell)
IF pFolder2 THEN IUnknown_Release(pFolder2)
IF pItem THEN IUnknown_Release(pItem)
RETURN cbs
END FUNCTION
' ========================================================================================
' ========================================================================================
' Same as above but accepting a shell special folder constant.
' See https://msdn.microsoft.com/en-us/library/windows/desktop/bb774096(v=vs.85).aspx
' for a list of the constants.
' ========================================================================================
PRIVATE FUNCTION AfxShellBrowseForFolder OVERLOAD (BYVAL hwnd AS HWND, BYVAL pwszTitle AS WSTRING PTR, _
BYVAL Options AS LONG = 0, BYVAL RootFolder AS LONG = 0) AS CBSTR
DIM cbs AS CBSTR
' // Create an instance of the IShellDispatch interface
DIM pShell AS IShellDispatch PTR
CoCreateInstance(@CLSID_Shell, NULL, CLSCTX_INPROC_SERVER, @IID_IShellDispatch, @pShell)
IF pShell = NULL THEN RETURN cbs
'// Call BrowseForFolder and get a reference to the Folder2 interface
DIM pFolder2 AS Folder2 PTR
DIM vRootFolder AS VARIANT
V_VT(@vRootFolder) = VT_I4
V_I4(@vRootFolder) = RootFolder
pShell->lpvtbl->BrowseForFolder(pShell, cast(LONG_PTR, hwnd), pwszTitle, Options, vRootFolder, cast(Folder PTR PTR, @pFolder2))
VariantClear @vRootFolder
IF pFolder2 = NULL THEN
IUnknown_Release(pShell)
RETURN cbs
END IF
' // Get a reference tp the FolderItem interface
DIM pItem AS FolderItem PTR
pFolder2->lpvtbl->get_Self(pFolder2, @pItem)
IF pItem THEN pItem->lpvtbl->get_Path(pItem, @cbs)
' // Cleanup
IF pShell THEN IUnknown_Release(pShell)
IF pFolder2 THEN IUnknown_Release(pFolder2)
IF pItem THEN IUnknown_Release(pItem)
RETURN cbs
END FUNCTION
' ========================================================================================
Hi Jose, please take a look at the attached screenshot. It says that it is an Open Folder dialog but I wonder is it really just a Open File dialog with some parameters changed? What do you think?
It is a customized instance of Explorer. I posted an example of embedding it into a Tab control. I have yet to explore the events interfaces of this control.
' ########################################################################################
' Microsoft Windows
' File: CW_ExplorerBrowser.fbtpl
' Contents: Resizable CWindow with an Explorer Browser control embedded in a tab page.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 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
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "win/shlobj.bi"
USING Afx
' $FB_RESPATH = "FBRES.rc"
' // Main window user data zero-based indices
ENUM AFX_USERDATA
AFX_EXPLORER_BROWSER_PTR = 0
END ENUM
' // Control identifiers
ENUM
IDC_TAB = 1001
IDC_BTNSUBMIT
IDC_LISTBOX
IDC_SELECTION
END ENUM
' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage1_WndProc(BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage2_WndProc(BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
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)
' ========================================================================================
' 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
AfxSetProcessDPIAware
' // Initialize the COM library
OleInitialize(NULL)
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow: Explorer Browser in a Tab Control", @WndProc)
pWindow.SetClientSize(550, 370)
pWindow.Center
' // Add a tab control
DIM hTab AS HWND = pWindow.AddControl("Tab", , IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 42)
' // Create the first tab page
DIM pTabPage1 AS CTabPage PTR = NEW CTabPage
pTabPage1->InsertPage(hTab, 0, "Explorer Browser", -1, @TabPage1_WndProc)
' // Create the second tab page
DIM pTabPage2 AS CTabPage PTR = NEW CTabPage
pTabPage2->InsertPage(hTab, 1, "Selected Items", -1, @TabPage2_WndProc)
' // Add buttons
pWindow.AddControl("Button", , IDC_SELECTION, "&Selection")
pWindow.AddControl("Button", , IDCANCEL, "&Close")
' // Display the first tab page
ShowWindow pTabPage1->hTabPage, SW_SHOW
' // Set the focus to the first tab
SendMessageW hTab, TCM_SETCURFOCUS, 0, 0
' // Dispatch messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitialize the COM library
CoUninitialize
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window callback 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 LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_SELECTION
IF HIWORD(wParam) = BN_CLICKED THEN
' // Get a reference to the 2nd tab page
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetDlgItem(hwnd, IDC_TAB), 1)
' // Get the handle of the listbox control
DIM hListBox AS HWND = GetDlgItem(pTabPage->hTabPage, IDC_LISTBOX)
' // Get the number of items in the listbox
DIM nItems AS LONG = ListBox_GetCount(hListBox)
' // Delete all items
DIM i AS LONG
FOR i = 0 TO nItems - 1
ListBox_DeleteString(hListBox, 0)
NEXT
' // Get a reference to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow = NULL THEN EXIT FUNCTION
' // Get the pointer to IExplorerBrowser previously stored in the user data
DIM peb AS IExplorerBrowser PTR = cast(IExplorerBrowser PTR, pWindow->UserData(AFX_EXPLORER_BROWSER_PTR))
IF peb = NULL THEN EXIT FUNCTION
' // Get a reference to the IShellView interface for the current view
DIM psv AS IShellView PTR
DIM hr AS HRESULT = peb->lpvtbl->GetCurrentView(peb, @IID_IShellView, @psv)
IF psv THEN
' // Get a reference to the IDataObject interface
DIM pDataObject AS IDataObject PTR
psv->lpvtbl->GetItemObject(psv, SVGIO_SELECTION, @IID_IDataObject, @pDataObject)
If pDataObject = NULL THEN MessageBox hwnd, "No files selected", "", MB_OK
IF pDataObject THEN
' // Get filenames from the clipboard
DIM fmt AS FORMATETC = (CF_HDROP, NULL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL)
DIM stg AS STGMEDIUM
stg.tymed = TYMED_HGLOBAL
IF SUCCEEDED(pDataObject->lpvtbl->GetData(pDataObject, @fmt, @stg)) THEN
' // Lock the global memory handle
DIM hDrop AS HDROP = GlobalLock(stg.hGlobal)
' // Get the number of selected files
DIM uNumFiles AS UINT = DragQueryFile(hDrop, &hFFFFFFFF, NULL, 0)
DIM hr AS HRESULT, i AS LONG
DIM wszPath AS WSTRING * MAX_PATH
FOR i = 0 TO uNumFiles - 1
wszPath = ""
' // Get the path of the file
DragQueryFile(hDrop, i, @wszPath, MAX_PATH)
' // Add it to the listbox
ListBox_AddString(hListbox, @wszPath)
NEXT
' // Unlock the global memry handle
GlobalUnlock(stg.hGlobal)
' // Release the STGMEDIUM structure
ReleaseStgMedium(@stg)
' // Set the focus in the Items tab
DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
TabCtrl_SetCurFocus(hTab, 1)
' // Set the focus in the first item of the listbox
ListBox_SetCursel(hListBox, 0)
END IF
' // Release the IDataObject interface
pDataObject->lpVtbl->Release(pDataObject)
END IF
END IF
' // Release the IShellView interface
IF psv THEN psv->lpVtbl->Release(psv)
EXIT FUNCTION
END IF
END SELECT
CASE WM_GETMINMAXINFO
' Set the pointer to the address of the MINMAXINFO structure
DIM ptmmi AS MINMAXINFO PTR = CAST(MINMAXINFO PTR, lParam)
' Set the minimum and maximum sizes that can be produced by dragging the borders of the window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
ptmmi->ptMinTrackSize.x = 460 * pWindow->rxRatio
ptmmi->ptMinTrackSize.y = 320 * pWindow->ryRatio
END IF
EXIT FUNCTION
CASE WM_SIZE
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
' / Move the buttons
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_SELECTION), pWindow->ClientWidth - 172, pWindow->ClientHeight - 28, 75, 23, CTRUE
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 86, pWindow->ClientHeight - 28, 75, 23, CTRUE
' // Resize the tab control
IF pWindow THEN pWindow->MoveWindow(hTab, 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 42, CTRUE)
' // Resize the tab pages
AfxResizeTabPages hTab
EXIT FUNCTION
CASE WM_NOTIFY
DIM nPage AS DWORD ' // Page number
DIM pTabPage AS CTabPage PTR ' // Tab page object reference
DIM tci AS TCITEMW ' // TCITEMW structure
DIM ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_TAB
SELECT CASE ptnmhdr->code
CASE TCN_SELCHANGE
' // Show the selected page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_SHOW
CASE TCN_SELCHANGING
' // Hide the current page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_HIDE
END SELECT
END SELECT
CASE WM_DESTROY
' // Destroy the tab pages
AfxDestroyAllTabPages(GetDlgItem(hwnd, IDC_TAB))
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
STATIC peb AS IExplorerBrowser PTR
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the TabPage class
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetParent(hwnd), 0)
' // Create an instance of IExplorerBrowser
CoCreateInstance(@CLSID_ExplorerBrowser, NULL, CLSCTX_INPROC_SERVER, @IID_IExplorerBrowser, @peb)
IF peb = NULL THEN EXIT FUNCTION
peb->lpVtbl->SetOptions(peb, EBO_SHOWFRAMES)
DIM fs AS FOLDERSETTINGS
fs.ViewMode = FVM_DETAILS
DIM rc AS RECT
GetClientRect hwnd, @rc
peb->lpVtbl->Initialize(peb, hwnd, @rc, @fs)
' // Navigate to the Profile folder
DIM pidlBrowse AS LPITEMIDLIST
' IF SUCCEEDED(SHGetFolderLocation(NULL, CSIDL_PROFILE, NULL, 0, @pidlBrowse)) THEN
' peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
' ILFree(pidlBrowse)
' END IF
DIM wszPath AS WSTRING * MAX_PATH
wszPath = "C:\Users" ' --> change me
IF SUCCEEDED(SHParseDisplayName(wszPath, NULL, @pidlBrowse, 0, NULL)) THEN
peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
ILFree(pidlBrowse)
END IF
' // Store the IExplorerBrowser pointer into the user data of the main window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(GetAncestor(hwnd, GA_ROOTOWNER))
pWindow->UserData(AFX_EXPLORER_BROWSER_PTR) = cast(LONG_PTR, peb)
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDC_BTNSUBMIT
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW(hWnd, "Submit", "Tab 1", MB_OK)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Resize the Explorer control
DIM rc AS RECT
GetClientRect hwnd, @rc
IF peb THEN peb->lpVtbl->SetRect(peb, NULL, rc)
EXIT FUNCTION
CASE WM_DESTROY
' // Destroy the browser and release the interface
IF peb THEN
peb->lpVtbl->Destroy(peb)
peb->lpVtbl->Release(peb)
END IF
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the TabPage class
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetParent(hwnd), 1)
' // Add a combobox to the second page
DIM hListBox AS HWND = pTabPage->AddControl("ListBox", hwnd, IDC_LISTBOX, "", 20, 20, 485, 270)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Guess that they will use this control to make different dialogs. Now that VB6 and ActiveX controls are history, they are building COM controls that can be embedded directly into a window without having to use an OLE container. Only the WebBrowser control is still an ActiveX.
You know that I always have disliked these ActiveX controls made for VB6 and the need to use an OLE container and Automation. That Automation stuff was developed by the VB6 team and worked very well with VB6, but it is a nightmare to use with other languages that don't have full Automation support, with all these BSTRs, Variants, safe arrays, etc.
The new COM controls (the first one was the Ribbon control) are no longer ActiveX, they don't need an OLE container and don't use Automation, but low-level COM.
you want to say that FreeBasic and the other compilers must be fastened with net technology?
I don't have mentioned .NET for anything. Controls like the Ribbon or this Explorer aren't written with .NET, but using low-level .COM. I dislike .NET even more than ActiveX.
As you can see in the example, I'm embedding Explorer wihout having to use an OLE container and without having to use Automation or .NET.
Apparently, you and Marc want to write ActiveX controls, and I wonder why. It would be better to learn how to do it using low-level COM. I still prefer the classic way of registering a window class and use the control calling SendMessage or functions instead of COM interfaces, and using a callback instead of events.
QuoteIt would be better to learn how to do it using low-level COM.
what is it low level COM? an example ?
Doing calls directly to the vtable instead of calling invoke.
In VB6, forms are instances of an OLE container. Therefore, they are perfectly suited to host ActiveX controls.
In SDK programming, they are windows, and you need to add an OLE container that will host the ActiveX.
If you are going to develop a control to be used with a SDK window, there is absolutely no need to do it as an ActiveX. It will integrate and work much better if it follows the rules of standard Windows controls. How you write it is up to you, as long as it works as a child of the parent window, not like ActiveX that need a middleman. If you prefer to send events instead of notification messages, it is your business.
Yeah, ActiveX is dead and a waste of time at this point. It is easy to write custom controls using standard window classes. Sure only today I was looking for a way to better skin the Scintilla scrollbars and then I said, screw it, I'll just write my own. I used a CWindow and treated it like a control. I just counted it and it took less than 100 lines of code. It is super small and super fast. Very little overhead.
One of the serious downfalls of languages is the lack of ready to use GUI components. That's why Visual Basic was so successful. It was incredibly easy to just plug in a pre-built GUI gadget. There was a huge market for it. PowerBasic struggled because very few people wrote visually appealing GUI gadgets. A few grid controls and a few fancy looking buttons, etc. Other than Patrice's WinLift, I can't think of any other controls that rivaled VB's, or Visual C++'s.
I would love nothing more than to be able to take a few months and just code a whole collection of GUI gadgets. It would make programming everyday applications so much easier.
you does not seem clear on this blow Jose . Because what you indicates by low level COM is as well COM
In more the Invoke method does not relate to only controls activeX, but also the interfaces which inherit IDISPATCH.
Did you already consult my CE control on the Freebasic forum ? it is used as a simple Windows control but it is always necessary to implements at least IUNKNOWN interface IUNKNOWN and for me with the use of IDISPATCH , the Invoke method is more flexible and makes it possible to use only the code which one needs.
COM Technology with my direction is challenged by .net technology, but it will be able to always exist at least as long as microsoft will distribute stdole2.tlb and as long as the headers of microsoft will not be re-examined. COM remains for me the fastest technique. and the natural one by using classes.
> In more the Invoke method does not relate to only controls activeX, but also the interfaces which inherit IDISPATCH.
Microsoft writes all its COM servers using low-level COM (inheriting directly from IUnknown, not IDispatch). In the times of VB6, that could not use these low-level interfaces, they usually added an IDispatch wrapper on top of the low-level interfaces. Now that VB6 is dead an buried, they no longer do this unless they want to make it available to scripting languages.
I learned COM programming to be able to use the COM servers of my interest, but I'm not interested at all in writing ActiveX controls. I prefer to write them using the API way.