I've read about how to make a notification popup menu go away when clicking outside it, but when I use the suggested code, a right click causes the taskbar popup menu to appear as well as my own. How do I make only my menu appear? Here is my code:
SetForegroundWindow(Form1.Handle);
PopupMenu1.Popup(x, y);
PostMessage(Form1.Handle, WM_NULL, 0, 0);
Edit: Okay, it seems like I did need to do something related to what I commented below.
trayhandle := FindWindow('Shell_TrayWnd', '');
trayhandle := FindWindowEx(trayhandle, 0, 'TrayNotifyWnd', nil);
trayhandle := FindWindowEx(trayhandle, 0, 'SysPager', nil);
trayhandle := FindWindowEx(trayhandle, 0, 'ToolbarWindow32', nil);
PostMessage(trayHandle, WM_LBUTTONDOWN, MK_LBUTTON, 0);
PostMessage(trayHandle, WM_LBUTTONUP, MK_LBUTTON, 0);
SetForegroundWindow(Handle);
PopupMenu1.Popup(x, y);
PostMessage(Handle, WM_NULL, 0, 0);
I've done other work and kept bouncing back to this app and the menu (and only my menu) displays properly and disappears properly as well. Seems to be working fine now (besides triggering the left mouse button)?
Related
I am making Delphi application to control other application. I need to select item in ComboBox of other application one by one and get its text. I have used FindWindowEx to find that ComboBox. Now I can find ComboBox but I don’t know how to select item in ComboBox.
var
ParentWindow: HWND;
ChildWindow: HWND;
begin
ParentWindow := FindWindow('TfrmMain', nil);
if ParentWindow <> 0 then
begin
ChildWindow := FindWindowEx(ParentWindow, 0, 'TPageControl', nil);
ChildWindow := FindWindowEx(ChildWindow, 0, 'TTabSheet', nil);
ChildWindow := FindWindowEx(ChildWindow, 0, 'TfrmInnerView', nil);
ChildWindow := FindWindowEx(ChildWindow, 0, 'TPanel', nil);
ChildWindow := FindWindowEx(ChildWindow, 0, 'TComboBox', nil);
end;
end;
I wish someone tell me how to do it.
In case child window of TfrmInnerView have only one class named TPanel, the code below is working properly. But if your child window of TfrmInnerView has more than one class which has same name TPanel, code below can find only the 1st class TPanel. I am now looking for the ways to find 2nd class. I would appreciate for any idea to do it.
SendMessage(ComboHandle, CB_SETCURSEL, NewSelectionIndex, 0);
Use: SendMessage(ChildWindow, CB_SETCURSEL, 1, 0);
I got this code from [What windows messages are used by Delphi to notice changes in a combo box?
I am trying (unsuccessfully) to copy/reproduce the background gradient of a Windows menu bar onto a bitmap.
In the IconToBitmap function below, the FillRect (wishfully) uses the GetSysColorBrush(COLOR_MENU) in an attempt have it paint the menu background the way it is in Windows (unsurprisingly, the brush isn't a gradient but, it was worth a try.)
The BitBlt below it is an attempt to "cheat". Grab a portion of the already painted menu bar and use that. That didn't work either and I suspect the reason may be because the function IconToBitmap is called during the WM_CREATE of the main window (I'm not sure the menu bar exists that early in the window creation.) I do need the background before the window is first made visible, that's the reason the function is called when processing WM_CREATE (but any other way that works before the window is visible is perfect.)
At this point, I'm out of ideas.
If someone knows how to either grab that menu background or reproduce it on a bitmap, that would be great.
Thank you.
PS: hardcoded values in the function will be removed in the final working version (hopefully, there will be one.) Also, for Delphi, the datatype ptrint has to be changed to NativeInt.
function IconToBitmap(Wnd : HWND; Icon : HICON) : HBITMAP;
var
Bitmap : HBITMAP;
BitmapDc : HDC;
BitmapRect : TRECT;
OldBitmap : HBITMAP;
dc : HDC;
MenuHeight : ptrint;
MenuY : ptrint;
WindowDc : HDC;
begin
Bitmap := 0;
BitmapDc := 0;
OldBitmap := 0;
dc := 0;
MenuY := 0;
MenuHeight := 0;
WindowDc := 0;
MenuY := GetSystemMetrics(SM_CYSIZEFRAME) +
GetSystemMetrics(SM_CYCAPTION);
MenuHeight := GetSystemMetrics(SM_CYMENUSIZE);
WindowDc := GetWindowDC(Wnd);
dc := GetDC(0);
BitmapDc := CreateCompatibleDC(dc);
Bitmap := CreateCompatibleBitmap(dc, 16, 16);
OldBitmap := SelectObject(BitmapDc, Bitmap);
with BitmapRect do
begin
Left := 0;
Top := 0;
Right := 16;
Bottom := 16;
end;
FillRect(BitmapDc, BitmapRect, GetSysColorBrush(COLOR_MENU));
BitBlt(BitmapDc, 0, 0, 16, 16, WindowDc, 20, MenuY, SRCCOPY);
DrawIconEx(BitmapDc,
0,
0,
Icon,
16,
16,
0,
0,
DI_NORMAL);
SelectObject(BitmapDc, OldBitmap);
DeleteDC(BitmapDc);
ReleaseDC(0, dc);
IconToBitmap := Bitmap;
end;
Use the visual styles API to draw theme parts. Below example paints a menu bar background in the top of the client area of a form. You can adapt it to draw onto a bitmap canvas.
uses
uxtheme, types;
procedure TForm1.FormPaint(Sender: TObject);
var
Theme: HTHEME;
Size: TSize;
Rect: TRect;
begin
Theme := OpenThemeData(Handle, VSCLASS_MENU);
GetThemePartSize(Theme, Canvas.Handle, MENU_BARBACKGROUND, MB_ACTIVE, nil,
TS_TRUE, Size);
Rect.Create(0, 0, ClientWidth, Size.cy);
DrawThemeBackground(Theme, Canvas.Handle, MENU_BARBACKGROUND, MB_ACTIVE,
Rect, nil);
CloseThemeData(Theme);
end;
In a WM_PAINT handler this could look like the following.
procedure TForm1.WMPaint(var Message: TWMPaint);
var
DC: HDC;
PS: TPaintStruct;
Theme: HTHEME;
Size: TSize;
Rect: TRect;
begin
if Message.DC = 0 then
DC := BeginPaint(Handle, PS)
else
DC := Message.DC;
Theme := OpenThemeData(Handle, VSCLASS_MENU);
GetThemePartSize(Theme, DC, MENU_BARBACKGROUND, MB_ACTIVE, nil,
TS_TRUE, Size);
Rect.Create(0, 0, ClientWidth, Size.cy);
DrawThemeBackground(Theme, DC, MENU_BARBACKGROUND, MB_ACTIVE,
Rect, nil);
CloseThemeData(Theme);
if Message.DC = 0 then begin
Message.DC := DC;
inherited;
EndPaint(Handle, PS);
end else
inherited;
end;
MY application has had a mode for years where the customer can 'disable access to the OS'. Obviously this feature goes against the grain (at least as far as Windows is concerned) but there are installations where my App is the only program that should ever be visibile to a machine operator amd in this case such a feature is useful.
The technigue I used was built from several 'layers':
Hide the taskbar and button.
Disable task-switching.
Disable my main form system icons.
To disable the taskbar I used:
// Get a handle to the taskbar and its button..
Taskbar := FindWindow('Shell_TrayWnd', Nil);
StartButton := FindWindow('Button', Nil);
// Hide the taskbar and button
if Taskbar <> 0 then
ShowWindow( Taskbar, SW_HIDE );
if StartButton <> 0 then
ShowWindow( StartButton, SW_HIDE );
// Set the work area to the whole screen
R := Rect( 0,0,Screen.Width,Screen.Height );
SystemParametersInfo(
SPI_SETWORKAREA,
0,
#R,
0 );
This worked well and still seems fine on W7.
Researching how to disable task-switching some years ago turned up the only technique of 'pretending' that your App is a screen saver (other than terrible things like renaming your app to 'explorer.exe' and booting into it etc):
procedure EnableTaskSwitching( AState : boolean );
// Enables / disables task switching
begin
SystemParametersInfo(
SPI_SCREENSAVERRUNNING,
Cardinal( not AState),
nil,
0 );
end;
Not surprisingly this seems to have no effect in W7 (I think it works in XP etc).
Does anyone know of another, better, way of enabling / disabling Alt-Tab (and other special windows keys) from working?
If found a solution:
function LowLevelKeyboardProc(nCode: integer; wParam: WPARAM; lParam: LPARAM):
LRESULT; stdcall;
type
PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
TKBDLLHOOKSTRUCT = record
vkCode: cardinal;
scanCode: cardinal;
flags: cardinal;
time: cardinal;
dwExtraInfo: Cardinal;
end;
PKeyboardLowLevelHookStruct = ^TKeyboardLowLevelHookStruct;
TKeyboardLowLevelHookStruct = TKBDLLHOOKSTRUCT;
const
LLKHF_ALTDOWN = $20;
var
hs: PKeyboardLowLevelHookStruct;
ctrlDown: boolean;
begin
if nCode = HC_ACTION then
begin
hs := PKeyboardLowLevelHookStruct(lParam);
ctrlDown := GetAsyncKeyState(VK_CONTROL) and $8000 <> 0;
if (hs^.vkCode = VK_ESCAPE) and ctrlDown then
Exit(1);
if (hs^.vkCode = VK_TAB) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then
Exit(1);
if (hs^.vkCode = VK_ESCAPE) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then
Exit(1);
if (hs^.vkCode = VK_LWIN) or (hs^.vkCode = VK_RWIN) then
Exit(1);
end;
result := CallNextHookEx(0, nCode, wParam, lParam);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
SetWindowsHookEx(WH_KEYBOARD_LL, #LowLevelKeyboardProc, 0, 0);
end;
This disables (as you can see!)
Ctrl+Esc (show start menu)
Alt+Tab (task switch)
Alt+Esc (task switch)
Win (show start menu)
Win+Tab (3D task switch)
Win+D, Win+M, Win+Space, Win+Arrows, Win+P, Win+U, Win+E, Win+F, Win+Digit, ...
Almost any combination including the Windows key (but not all, e.g. Win+L)
As David has pointed out, this is called "Kiosk Mode". A couple of good articles (part 1 and part 2) can be found on About.com.
There is Windows Embedded Standard 7 that you can package in a way that has a true kiosk mode.
dWinLock also provides a solution. IIRC, they install a service that can stop Ctrl+Alt+Del.
Good Day all
I searched the web for any directions as to if this is possible but to no avail. I need to write an application that will allow me to select another application and by doing so make the selected application translucent and on-top (like a ghost image overlay).
Is this at all possible with Delphi? I am using Delphi XE and Lazarus. If anybody could just please point me in the general direction of where to start I will be much obliged.
Thanks in advance,
You can do this but is not recommended, because this kind of behavior must be handled by the own application. anyway if you insist because do you have a very good reason to do this, here i leave the code to set the transparency of a window and Make a windows Top Most, just to show how can be done.
Transparency
you must use the SetWindowLong function with the WS_EX_LAYERED flag and the SetLayeredWindowAttributes function with LWA_ALPHA to set the transparency.
Procedure SethWndTrasparent(hWnd: HWND;Transparent:boolean);
var
l : Longint;
lpRect : TRect;
begin
if Transparent then
begin
l := GetWindowLong(hWnd, GWL_EXSTYLE);
l := l or WS_EX_LAYERED;
SetWindowLong(hWnd, GWL_EXSTYLE, l);
SetLayeredWindowAttributes(hWnd, 0, 180, LWA_ALPHA);
end
else
begin
l := GetWindowLong(hWnd, GWL_EXSTYLE);
l := l xor WS_EX_LAYERED;
SetWindowLong(hWnd, GWL_EXSTYLE, l);
GetWindowRect(hWnd, lpRect);
InvalidateRect(hWnd, lpRect, true);
end;
end;
Make a windows Top Most
You must use the SetWindowPos function passing the HWND_TOPMOST value which places the window above all non-topmost windows. The window maintains its topmost position even when it is deactivated.
Procedure SethWndOnTop(hWnd: HWND);
var
lpRect : TRect;
begin
if GetWindowRect(hWnd,lpRect) then
SetWindowPos(hWnd , HWND_TOPMOST, lpRect.left, lpRect.top, lpRect.Right-lpRect.left, lpRect.Bottom-lpRect.Top, SWP_SHOWWINDOW);
end;
Windows can do this but an app has got no hope of doing this robustly.
I have multiple cursors (which are actually forms) that can be controlled by their respective mouse. (1 cursor for 1 user).
I use SetCursorPos to position the default cursor (the original system cursor) in a position that will not take away the focus from my application, and use ShowCursor(false) to hide it.
I have a class that gets the handle of the mouse and the coordinates.
When the user clicks I use the SetCursorPos and the mouse_event to simulate the clicks in that particular position.
My simulated mouse clicks only work on certain components' OnClick event (It was supposed to be only buttons and labels, but I experimented with the stuff on my project just to know what will or won't work):
It works on:
Buttons (TButton, TBitBtn, TAdvSmoothButton)
TAdvGrid
TMenuItem (but the direct child of the TMainMenu only)
TRadioButton
It doesn't work on:
TLabel
Panels (TPanel, TAdvSmoothPanel)
TCoolBar
TMenuItem (not direct child of TMainMenu)
This is my code:
SetCursorPos(currentX , currentY);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
Why doesn't it work on some components? Is there a workaround (because I would like to be able to click labels using mouse_event).
EDIT:
I tried checking if the clicking function was really called, so I put ShowMessage('clicked'); before the SetCursorPos and mouse_event...but strangely everything (minor edit: everything except MenuItems) works fine now (except for the fact that I have a Message popping out everytime I try to click something). Does anybody have an idea why this behaves that way?
mouse_event is actually deprecated, you should use SendInput instead, see if that fixes anything (I would also suggest making the mouse move an input message, over using SetCursorPos), also, if your doing this for a specific application, PostMessage might be a much better and simpler alternative
Seems to work here;
procedure TForm1.Panel1Click(Sender: TObject);
begin
ShowMessage('Click');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Pt: TPoint;
begin
Pt := Panel1.ClientToScreen(Point(0, 0));
SetCursorPos(Pt.x, Pt.y);
// SetCursorPos(Panel1.ClientOrigin.x, Panel1.ClientOrigin.y);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;
or, without SetCursorPos;
procedure TForm1.Button1Click(Sender: TObject);
var
Pt: TPoint;
begin
Pt := Panel1.ClientToScreen(Point(0, 0));
Pt.x := Round(((Pt.x + 1) * 65535) / Screen.Width);
Pt.y := Round(((Pt.y + 1) * 65535) / Screen.Height);
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or MOUSEEVENTF_LEFTDOWN,
Pt.x, Pt.y, 0, 0);
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or MOUSEEVENTF_LEFTUP,
Pt.x, Pt.y, 0, 0);
end;
It works by accident right now, those components have probably captured the mouse. You need to pass the mouse pointer coordinates in the 2nd and 3rd arguments. Thus:
//SetCursorPos(currentX , currentY);
mouse_event(MOUSEEVENTF_LEFTDOWN, currentX, currentY, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, currentX, currentY, 0, 0);