I'm trying to use MMSystem to call midiInOpen but I'm unsure on how to pass the dwCallback (midiInProc).
I've taken a look at Winapi.MMSystem.pas and the midiInOpen function is declared as the following which gives no clues as what to pass for dwInstance:
{$EXTERNALSYM midiInOpen}
function midiInOpen(lphMidiIn: PHMIDIIN; uDeviceID: UINT;
dwCallback, dwInstance: DWORD_PTR; dwFlags: DWORD): MMRESULT; stdcall;
Does the callback function in Delphi have to be declared in a certain way or can I pass the address of procedure that has the same definition as the midiInProc defined in the WinAPI manual?
Per the midiInOpen() documentation:
dwCallback
Pointer to a callback function, a thread identifier, or a handle of a window called with information about incoming MIDI messages. For more information on the callback function, see MidiInProc.
If you use a callback function, it must match the signature of MidiInProc:
void CALLBACK MidiInProc(
HMIDIIN hMidiIn,
UINT wMsg,
DWORD_PTR dwInstance,
DWORD_PTR dwParam1,
DWORD_PTR dwParam2
);
For example
procedure MyMidiInCallback(hMidiIn: HMIDIIN; wMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR); stdcall;
begin
// do something...
end;
...
var
uDeviceID: UINT;
hMidiIn: HMIDIIN;
begin
uDeviceID := ...;
midiInOpen(#hMidiIn, uDeviceID, DWORD_PTR(#MyMidiInCallback), 0, CALLBACK_FUNCTION);
...
midiInClose(hMidiIn);
end;
How can I see if windows explorer is already opened with certain path ? I don't want my application opens many duplicated windows. I was unable to do it with this way :
var
H: hwnd;
begin
if FileExists(edt8.Text) then
begin
H := FindWindow(0, PChar(ExtractFilePath(edt8.Text)));
if H <> 0 then
ShowMessage('explorer already opened')//explorer bring to front
else
ShellExecute(Application.Handle, nil, 'explorer.exe',
PChar(ExtractFilePath(edt8.Text)), nil, SW_NORMAL);
end;
end;
IShellWindows::FindWindowSW method
There is a nice method FindWindowSW that should find an existing Shell window, which includes Windows Explorer windows as well, I'd say. So, in a hope I'll find an existing window easily I wrote this code:
uses
ActiveX, ShlObj, SHDocVw, ComObj;
function IDListFromPath(const Path: WideString): PItemIDList;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(ShellFolder));
OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(Path), Count, Result, Attributes));
end;
function GetExplorerHandle(const Path: WideString): HWND;
var
IDList: PItemIDList;
Unused: OleVariant;
Location: OleVariant;
ShellWindows: IShellWindows;
begin
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows));
Unused := Unassigned;
IDList := IDListFromPath(Path);
PVariantArg(#Location).vt := VT_VARIANT or VT_BYREF;
PVariantArg(#Location).pvarVal := PVariant(IDList);
ShellWindows.FindWindowSW(Location, Unused, SWC_EXPLORER, Integer(Result), SWFO_INCLUDEPENDING);
end;
But it never finds the Windows Explorer window with the given folder path (it always returns 0). I've used SWC_EXPLORER class to search only for Windows Explorer windows, build the absolute ID list, used a proper VT_VARIANT | VT_BYREF variant for location (at least I hope so, if not, please let me know). And I also tried to return IDispatch by including the SWFO_NEEDDISPATCH option (method always returned nil reference). So I gave up on this method (haven't found any example).
IShellWindows enumeration
The following code was inspired by this article and this example. Here is a scheme:
1. IShellWindows.Item(n)
2. ⤷ IDispatch.QueryInterface(IWebBrowserApp)
3. ⤷ IWebBrowserApp.QueryInterface(IServiceProvider)
4. ⤷ IServiceProvider.QueryService(STopLevelBrowser, IShellBrowser)
5. ⤷ IShellBrowser.QueryActiveShellView
6. ⤷ IShellView.QueryInterface(IFolderView)
7. ⤷ IFolderView.GetFolder(IPersistFolder2)
8. ⤷ IPersistFolder2.GetCurFolder
9. ⤷ ITEMIDLIST
And some description:
As first you obtain the IShellWindows interface reference and iterate its items.
For each item, the IShellWindows interface returns window's IDispatch interface which you then query for an IWebBrowserApp interface reference.
The obtained IWebBrowserApp interface (for documentation refer to IWebBrowser2, as it's their implementation) provides except others also the information about the host window, like handle which can be later used for bringing the window to foreground. We need to go deeper though. So let's query this interface reference for the IServiceProvider interface (which is an accessor for getting interfaces for the given service).
Now from the top-most browser implementation service query its IShellBrowser interface. A reference of this interface is still not interesting for our aim.
The obtained IShellBrowser query for the displayed Shell view object.
Now we can finally say, if the iterated Shell window is not an Internet Explorer window. So far they were having common interfaces implemented. Now if we query the obtained IShellView for the IFolderView interface and it succeeds, it is not Internet Explorer and we can continue.
Query the obtained IFolderView reference for the IPersistFolder2 interface for the currently displayed folder object.
If we succeeded even there and we got IPersistFolder2 reference, let's get the ITEMIDLIST for the current folder object.
And if we succeeded even with this last step, we have ITEMIDLIST of the currently displayed folder of a Windows Explorer instance (or the same interface implementor) and we can finally check if the obtained ITEMIDLIST equals to the one we parsed for the input path. If so, bring that window to foreground, if not, continue to the next iteration.
And here is a Delphi code. I don't know how much do you need for your Delphi version; this was a bare minimum I've needed for D2009 (manually translated from Windows SDK 10.0.15063.0). It's not a best example; in real code you may prefer wrapping this into a class and have more flexible interface, but that's upon your design preference. And finally, if you have Delphi newer than 2009, you may not need the imported prototypes, if older, you might be missing some:
uses
ActiveX, ShlObj, SHDocVw, ComObj;
{ because of Win32Check }
{$WARN SYMBOL_PLATFORM OFF}
const
IID_IFolderView: TGUID = '{CDE725B0-CCC9-4519-917E-325D72FAB4CE}';
IID_IPersistFolder2: TGUID = '{1AC3D9F0-175C-11D1-95BE-00609797EA4F}';
IID_IServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}';
SID_STopLevelBrowser: TGUID = '{4C96BE40-915C-11CF-99D3-00AA004AE837}';
type
IFolderView = interface(IUnknown)
['{CDE725B0-CCC9-4519-917E-325D72FAB4CE}']
function GetCurrentViewMode(out pViewMode: UINT): HRESULT; stdcall;
function SetCurrentViewMode(ViewMode: UINT): HRESULT; stdcall;
function GetFolder(const riid: TIID; out ppv): HRESULT; stdcall;
function Item(iItemIndex: Integer; out ppidl: PItemIDList): HRESULT; stdcall;
function ItemCount(uFlags: UINT; out pcItems: Integer): HRESULT; stdcall;
function Items(uFlags: UINT; const riid: TIID; out ppv): HRESULT; stdcall;
function GetSelectionMarkedItem(out piItem: Integer): HRESULT; stdcall;
function GetFocusedItem(out piItem: Integer): HRESULT; stdcall;
function GetItemPosition(pidl: PItemIDList; out ppt: TPoint): HRESULT; stdcall;
function GetSpacing(var ppt: TPoint): HRESULT; stdcall;
function GetDefaultSpacing(out ppt: TPoint): HRESULT; stdcall;
function GetAutoArrange: HRESULT; stdcall;
function SelectItem(iItem: Integer; dwFlags: DWORD): HRESULT; stdcall;
function SelectAndPositionItems(cidl: UINT; var apidl: PItemIDList; var apt: TPoint; dwFlags: DWORD): HRESULT; stdcall;
end;
EShObjectNotFolder = class(Exception);
function ILGetSize(pidl: PItemIDList): UINT; stdcall;
external 'shell32.dll' name 'ILGetSize';
function ILIsEqual(pidl1: PItemIDList; pidl2: PItemIDList): BOOL; stdcall;
external 'shell32.dll' name 'ILIsEqual';
function InitVariantFromBuffer(pv: Pointer; cb: UINT; out pvar: OleVariant): HRESULT; stdcall;
external 'propsys.dll' name 'InitVariantFromBuffer';
function CoAllowSetForegroundWindow(pUnk: IUnknown; lpvReserved: Pointer): HRESULT; stdcall;
external 'ole32.dll' name 'CoAllowSetForegroundWindow';
resourcestring
rsObjectNotFolder = 'Object "%s" is not a folder.';
{ this parses the input folder path and creates ITEMIDLIST structure if the given
folder path is a valid absolute path to an existing folder }
function GetFolderIDList(const Folder: string): PItemIDList;
const
SFGAO_STREAM = $00400000;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(ShellFolder));
Attributes := SFGAO_FOLDER or SFGAO_STREAM;
OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(WideString(Folder)), Count, Result, Attributes));
if not ((Attributes and SFGAO_FOLDER = SFGAO_FOLDER) and (Attributes and SFGAO_STREAM <> SFGAO_STREAM)) then
begin
CoTaskMemFree(Result);
raise EShObjectNotFolder.CreateFmt(rsObjectNotFolder, [Folder]);
end;
end;
{ translated from the link mentioned in this comment; D2009 does not allow me to
create an OleVariant of type VT_ARRAY|VT_UI1 which is needed for the Navigate2
method so I've imported and used the InitVariantFromBuffer function here
https://msdn.microsoft.com/en-us/library/windows/desktop/gg314982(v=vs.85).aspx }
procedure OpenNewExplorer(IDList: PItemIDList);
var
Location: OleVariant;
WebBrowser: IWebBrowser2;
begin
OleCheck(CoCreateInstance(CLASS_ShellBrowserWindow, nil, CLSCTX_LOCAL_SERVER, IID_IWebBrowser2, WebBrowser));
OleCheck(CoAllowSetForegroundWindow(WebBrowser, nil));
OleCheck(InitVariantFromBuffer(IDList, ILGetSize(IDList), Location));
try
WebBrowser.Navigate2(Location, Unassigned, Unassigned, Unassigned, Unassigned);
finally
VariantClear(Location);
end;
WebBrowser.Visible := True;
end;
{ translated from the link mentioned in this comment
https://blogs.msdn.microsoft.com/oldnewthing/20040720-00/?p=38393 }
procedure BrowseInExplorer(const Folder: string);
var
I: Integer;
WndIface: IDispatch;
ShellView: IShellView;
FolderView: IFolderView;
SrcFolderID: PItemIDList;
CurFolderID: PItemIDList;
ShellBrowser: IShellBrowser;
ShellWindows: IShellWindows;
WebBrowserApp: IWebBrowserApp;
PersistFolder: IPersistFolder2;
ServiceProvider: IServiceProvider;
begin
SrcFolderID := GetFolderIDList(Folder);
try
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows));
{ iterate all Shell windows }
for I := 0 to ShellWindows.Count - 1 do
begin
WndIface := ShellWindows.Item(VarAsType(I, VT_I4));
{ do not use OleCheck here; windows like Internet Explorer do not implement
all the interfaces; it is the way to distinguish Windows Explorer windows
actually; so let's get all the references and if we succeed, check if the
obtained folder equals to the passed one; if so, bring that window to top
and exit this procedure }
if Assigned(WndIface) and
Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp)) and
Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider, ServiceProvider)) and
Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser, IID_IShellBrowser, ShellBrowser)) and
Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) and
Succeeded(ShellView.QueryInterface(IID_IFolderView, FolderView)) and
Succeeded(FolderView.GetFolder(IID_IPersistFolder2, PersistFolder)) and
Succeeded(PersistFolder.GetCurFolder(CurFolderID)) and
ILIsEqual(SrcFolderID, CurFolderID) then
begin
{ restore the window if minimized, try to bring it to front and exit this
procedure }
if IsIconic(WebBrowserApp.HWnd) then
Win32Check(ShowWindow(WebBrowserApp.HWnd, SW_RESTORE));
{$IFNDEF IBelieveThatIWebBrowserAppVisiblePropertyBringsWindowToFront}
Win32Check(SetForegroundWindow(WebBrowserApp.HWnd));
{$ELSE}
OleCheck(CoAllowSetForegroundWindow(WebBrowserApp, nil));
WebBrowserApp.Visible := True;
{$ENDIF}
Exit;
end;
end;
{ the procedure was not exited, hence an existing window was not found, so go
and open the new one }
OpenNewExplorer(SrcFolderID);
finally
CoTaskMemFree(SrcFolderID);
end;
end;
{$WARN SYMBOL_PLATFORM ON}
Possible usage:
BrowseInExplorer('C:\MyFolder');
Overview
I am trying to enumerate a list of all visible window names and then populate a list passed as a parameter.
In Delphi I was able to get this to work with the following:
function EnumWindowNamesProc(wHandle: HWND; List: TStrings): BOOL; stdcall;
var
Title: array[0..255] of Char;
begin
Result := False;
GetWindowText(wHandle, Title, 255);
if IsWindowVisible(wHandle) then
begin
if Title <> '' then
begin
List.Add(string(Title));
end;
end;
Result := True;
end;
Then I could call the above like so:
EnumWindows(#EnumWindowNamesProc, LPARAM(FWindowNames));
Note: FWindowNames is a stringlist created inside a custom class.
Problem
I am also trying to make the function compatible with Lazarus/FPC but it wont accept the List: TStrings parameter.
The compiler error in Lazarus complains about a type mismatch (I have highlighted the important parts):
Error: Incompatible type for arg no. 1: Got " (address of
function(LongWord;TStrings):LongBool;StdCall) ", expected " (procedure
variable type of function(LongWord;LongInt):LongBool;StdCall) "
I can stop the compiler complaining by changing the function declaration like so:
{$IFDEF FPC}
function EnumWindowNamesProc(wHandle: HWND; Param: LPARAM): BOOL; stdcall;
{$ELSE}
function EnumWindowNamesProc(wHandle: HWND; List: TStrings): BOOL; stdcall;
{$ENDIF}
var
Title: array[0..255] of Char;
begin
Result := False;
GetWindowText(wHandle, Title, 255);
if IsWindowVisible(wHandle) then
begin
if Title <> '' then
begin
{$IFDEF FPC}
// List no longer available
{$ELSE}
List.Add(string(Title));
{$ENDIF}
end;
end;
Result := True;
end;
But then I lose my List parameter.
I know I could modify the code and use a Listbox1 for example directly inside the function but I was hoping to create a reusable function that does not need to know about VCL/LCL controls, instead I was hoping for a more elegant solution and simply pass a TStrings based parameter and add to this instead.
Question:
So my question is, in Delphi I am able to pass a TStrings based parameter to my EnumWindowNamesProc but in Lazarus it wont accept it. Is it possible, and if so, how can I modify the code so Lazarus accepts the List: TStrings parameter?
You can. You don't have to lose your List.
Just use correct parameters and typecast
function EnumWindowNamesProc(wHandle: HWND; List: LPARAM): BOOL; stdcall;
var
Title: array[0..255] of Char;
begin
Result := False;
GetWindowText(wHandle, Title, 255);
if IsWindowVisible(wHandle) then
begin
if Title <> '' then
begin
TStringList(List).Add(string(Title));
end;
end;
Result := True;
end;
EnumWindows(#EnumWindowNamesProc, LPARAM(list));
To complete my answer. There is one more option - define the function by yourself with pointer (like in Delphi). Then you can use it the same way.
function EnumWindows(lpEnumFunc:Pointer; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindows';
I'm testing this code Windows 7 32 and 64 bit, but still, it does not work the glass effect in any case, not return any errors, just does not work me.
program test;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows,System.SysUtils,DH_Form_Effects;
type
DWM_BLURBEHIND = record
dwFlags : DWORD;
fEnable : BOOL;
hRgnBlur : HRGN;
fTransitionOnMaximized : BOOL;
end;
function DwmEnableBlurBehindWindow(hWnd : HWND; const pBlurBehind : DWM_BLURBEHIND) : HRESULT; stdcall; external 'dwmapi.dll' name 'DwmEnableBlurBehindWindow';//function to enable the glass effect
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; //get the handle of the console window
function DWM_EnableBlurBehind(hwnd : HWND; AEnable: Boolean; hRgnBlur : HRGN = 0; ATransitionOnMaximized: Boolean = False; AFlags: Cardinal = 1): HRESULT;
var
pBlurBehind : DWM_BLURBEHIND;
begin
pBlurBehind.dwFlags:=AFlags;
pBlurBehind.fEnable:=AEnable;
pBlurBehind.hRgnBlur:=hRgnBlur;
pBlurBehind.fTransitionOnMaximized:=ATransitionOnMaximized;
Result:=DwmEnableBlurBehindWindow(hwnd, pBlurBehind);
end;
begin
try
DWM_EnableBlurBehind(GetConsoleWindow(), True);
Writeln('See my glass effect');
Writeln('Go Delphi Go');
Readln;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
Does this have any requirement to run? What is the problem ?
It works for me (on Windows 10):
I would suggest checking for any errors, rather than ignoring them:
hr: HRESULT;
hr := DWM_EnableBlurBehind(GetConsoleWindow(), True);
OleCheck(hr);
Equivalently, you can avoid the need to check return values by using safecall calling convention (where the compiler will insert code to check the HRESULT and throw an exception if the function failed):
procedure DwmEnableBlurBehindWindow(hWnd: HWND; const pBlurBehind: DWM_BLURBEHIND); safecall; external 'dwmapi.dll' name 'DwmEnableBlurBehindWindow';//function to enable the glass effect
procedure DWM_EnableBlurBehind(hwnd : HWND; AEnable: Boolean; hRgnBlur : HRGN = 0; ATransitionOnMaximized: Boolean = False; AFlags: Cardinal = 1);
var
pBlurBehind : DWM_BLURBEHIND;
begin
pBlurBehind.dwFlags:=AFlags;
pBlurBehind.fEnable:=AEnable;
pBlurBehind.hRgnBlur:=hRgnBlur;
pBlurBehind.fTransitionOnMaximized:=ATransitionOnMaximized;
DwmEnableBlurBehindWindow(hwnd, pBlurBehind);
end;
Now, since you weren't checking errors anyway - you will now know the problem. On Windows 7 with desktop composition disabled, DwmEnableBlurBehindWindow returns:
0x80263001
{Desktop composition is disabled}
The operation could not be completed because desktop composition is disabled
I've got some problems with EnumWindows function that uses callback function from a nested class:
TProcessWatch = class(TObject)
private
...
type
TProcessInfo = class(TObject)
private
type
PEnumCallbackParam = ^TEnumCallbackParam;
TEnumCallbackParam = class
A : Integer;
...
end;
private
FOwner : TProcessWatch;
function FEnumWindowsCallback(hWindow : HWND; lParam : LPARAM) : BOOL; export;
procedure SomeProc;
...
end;
private
FProcesses : TProcessInfo;
...
public
...
Within the SomeProc there is a call to EnumWindows
EnumCallbackParam := TEnumCallbackParam.Create;
try
EnumCallbackParam.A := 0;
EnumWindows(#TProcessWatch.TProcessInfo.FEnumWindowsCallback, LongInt(#EnumCallbackParam));
...
finally
EnumCallbackParam.Free;
end;
And here is a FEnumWindowsCallback function listing:
function TProcessWatch.TProcessInfo.FEnumWindowsCallback(hWindow: HWND;
lParam : LPARAM): BOOL; export;
var
CallbackParam : PEnumCallbackParam;
begin
CallbackParam := Pointer(lParam); // A is inaccessible
Result := True;
...
end;
In runtime, when EnumWindows is called, FEnumWindowsCallback is always receiving hWindow = 0 and lParam is pointing to inaccessible value.
All this working fine if callback function is declared private in the form, but when I've tried to make this function private in nested class it went wrong.
Why? And how to make this working? The goal is to make FEnumWindowsCallback and all other involved functions private in TProcessWatch.
The callback is declared wrongly. It should be:
class function EnumWindowsCallback(hWindow: HWND;
lParam: LPARAM): BOOL; static; stdcall;
You were using the wrong calling convention, and an instance method.
Other comments:
EnumCallbackParam is already a pointer. You can pass it as the param.
Cast to LPARAM rather then LongInt so that you code will work if you ever compile to 64 bit.
The export keyword has no meaning in 32 or 64 bit Delphi. It is ignored and you should not use it since it adds clutter and may confuse.