Its a dumb question maybe but I have a popup menu which is linked with many TTreeViewItems. The problem is that the TTreeView.Selected property never gets set on right click. The GetMousePos is prone to returning the next or the previous TTreeViewItem's coordinates. How can I get the Item which actually triggered the popup?
You can use OnPopup event of TPopupMenu like this:
procedure TForm7.PopupMenu1Popup(Sender: TObject);
var
aNode: TTreeNode;
p: TPoint;
begin
p := TreeView1.ScreenToClient(PopupMenu1.PopupPoint);
aNode := TreeView1.GetNodeAt(p.X, p.Y);
if aNode <> Nil then
caption := aNode.Text;
end;
seems TPopupMenu.PopupPoint returns (0,0) point when you click item in PopupMenu (In Delphi XE2, docwiki says that it is used internally to set position of menu, and seems it is set to 0 when menu dissapears).
so in this situation, seems to me, the easiest way is to handle TreeView.OnMouseDown where you can save reference to selected item, and then use it in Popup item event handler;
so, in the exmaple code below i've added FClickedItem : TTreeViewItem into the form class;
procedure TSampleForm.SampleTreeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if button = TMouseButton.mbRight then
FClickedItem := SampleTreeView.ItemByPoint(x,y)
else FClickedItem := nil;
end;
procedure TSampleForm.TestMenuItemClick(Sender: TObject);
begin
if Assigned(FClickedItem) then
ShowMessage(Format('Item `%s (%s)` was selected!', [FClickedItem.Text, FClickedItem.Name]))
else ShowMessage('there is nothing to show');
end;
UPDATE: i've just browsed the source code, private variable TPopupMenu.FPopupPoint (readonly property) is not used in implementation code, thats why it is always = (0,0)
Related
I'm using an ancient precursor to the DevExpress QuantumGrid (MasterView) in Delphi XE2 and would like certain cells to effectively act as hyperlinks (change the mouse cursor from crDefault to crHandPoint when over them and trigger an action on click).
The configuration of the grid component is such that individual cells are not their own component, and I will need to find the cell from the mouse cursor coordinates and set the cursor from there.
I think I need to set a few events on my grid object to achieve this, but I'm a little uncomfortable about how these events will interact with code that sets the cursor to an hourglass when doing long-running operations (currently handled using IDisposible to set the cursor back to original when finished) and want to double-check whether there's a better way of doing this before I get started and then find a tonne of edge-cases that leave the mouse cursor in the wrong state.
I think I need to override:
omMouseMove - get XY co-ordinates and set the cursor to hand/arrow
onMouseDown - get XY co-ordinates and 'activate' hyperlink if present (possibly revert to arrow? The hyperlink will usually open a new window and the code called may change the cursor to an hourglass)
onMouseLeave - reset cursor to arrow (this event isn't actually exposed, so
think I'll need to handle messages manually)
This kind of functionality comes as default on a TButton, but I couldn't see in the VCL how it's achieved at first glance, and may be a feature of the underlying Windows control.
This is a scenario I would prefer. The cursor is set from the WM_SETCURSOR message handler and backend work signalled by a flag. Link click is then handled from the MouseDown method override. Note that the cursor is changed only for this control (when the mouse cursor hovers the control). In pseudocode:
type
THitCode =
(
hcHeader,
hcGridCell,
hcHyperLink { ← this is the extension }
);
THitInfo = record
HitRow: Integer;
HitCol: Integer;
HitCode: THitCode;
end;
TMadeUpGrid = class(TGridAncestor)
private
FWorking: Boolean;
procedure DoStartWork;
procedure DoFinishWork;
procedure UpdateCursor;
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
function GetHitTest(X, Y: Integer): THitInfo; override;
end;
implementation
procedure TMadeUpGrid.DoStartWork;
begin
FWorking := True;
UpdateCursor;
end;
procedure TMadeUpGrid.DoFinishWork;
begin
FWorking := False;
UpdateCursor;
end;
procedure TMadeUpGrid.UpdateCursor;
begin
Perform(CM_CURSORCHANGED, 0, 0); { ← triggers WM_SETCURSOR handler if needed }
end;
procedure TMadeUpGrid.WMSetCursor(var Msg: TWMSetCursor);
var
P: TPoint;
HitInfo: THitInfo;
begin
{ the mouse is inside the control client rect, inherited call here should
"default" to the Cursor property cursor type }
if Msg.HitTest = HTCLIENT then
begin
GetCursorPos(P);
P := ScreenToClient(P);
HitInfo := GetHitTest(P.X, P.Y);
{ if the mouse is hovering a hyperlink or the grid backend is working }
if FWorking or (HitInfo.HitCode = hcHyperLink) then
begin
{ here you can setup the "temporary" cursor for the hyperlink, or
for the working grid backend }
if not FWorking then
SetCursor(Screen.Cursors[crHandPoint])
else
SetCursor(Screen.Cursors[crHourGlass]);
{ tell the messaging system that this message has been handled }
Msg.Result := 1;
end
else
inherited;
end
else
inherited;
end;
procedure TMadeUpGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
HitInfo: THitInfo;
begin
if Button = mbLeft then
begin
HitInfo := GetHitTest(X, Y);
{ the left mouse button was pressed when hovering the hyperlink, so set
the working flag, trigger the WM_SETCURSOR handler "manually" and do the
navigation; when you finish the work, call DoFinishWork (from the main
thread context) }
if HitInfo.HitCode = hcHyperLink then
begin
DoStartWork;
DoSomeNavigation(HitInfo.HitRow, HitInfo.HitCol);
end;
end;
end;
function TMadeUpGrid.GetHitTest(X, Y: Integer): THitInfo;
begin
{ fill the Result structure properly }
end;
I've actually found the solution while browsing around SO.
I'd forgotten that components usually have their own Cursor property, which is how they set the correct mouse cursor type when the pointer is over them (i.e. button behaviour)
By overriding MouseMove to change the cursor to crHandPoint if it's over a hyperlink cell and storing the old cursor property to revert to if it's not over a hyperlink seems to work fine (and separate to the screen.cursor which is set in the long-running code). I need to finish off the code to confirm that it works correctly, so I'll leave the question unanswered for now until I can confirm that everything works as I expected.
edit: adding some code. I've decided to use an interceptor class rather than subclassing the grid and having to register the control - I'll only be using it in one or two places in one app and it saves having to set up everyone else's machines.
TdxMasterView = class(dxMasterView.TdxMasterView)
private
FDefaultCursor: TCursor;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TdxMasterView.Create(AOwner: TComponent);
begin
inherited create(AOwner);
FDefaultCursor := self.Cursor;
end;
procedure TdxMasterView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
lvHitTestCode: TdxMasterViewHitTestCode;
lvNode : TdxMasterViewNode;
lvColumn: TdxMasterViewColumn;
lvRowIndex, lvColIndex: integer;
begin
inherited;
lvHitTestCode := self.GetHitTestInfo( Point(X,Y),
lvNode,
lvColumn,
lvRowIndex,
lvColIndex );
if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then
begin
TMasterViewClickableColumn(lvColumn).onClickContentCell(lvNode);
end;
end;
procedure TdxMasterView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
lvHitTestCode: TdxMasterViewHitTestCode;
lvNode : TdxMasterViewNode;
lvColumn: TdxMasterViewColumn;
lvRowIndex, lvColIndex: integer;
begin
inherited;
lvHitTestCode := self.GetHitTestInfo( Point(X,Y),
lvNode,
lvColumn,
lvRowIndex,
lvColIndex );
if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then
begin
self.cursor := TMasterViewClickableColumn(lvColumn).cursorOnMouseOver;
end
else
begin
self.cursor := self.FDefaultCursor;
end;
end;
I want to have a TEdit that reacts on a click like the Url bars in Chrome and Firefox. On first click they select all text and following clicks remove the selection as shown here:
My approach:
// This method is bound to the OnClick event
procedure TForm.edt_SearchClick(Sender: TObject);
begin
if edt_Search.SelLength > 0 then
edt_Search.SelLength := 0
else
edt_Search.SelectAll;
end;
This code doesn't work as expected as edt_Search.SelLength is always 0. The selection will always be cleared before the OnClick event is about to be triggered. I've already tried to put this code into the OnMouseUp and OnMouseDown events but the problem stays the same.
How can I solve it? Is there a way to do this without adding an additional boolean variable which saves the current state?
To select all text in a TEdit control when the control gains focus simply handle the OnEnter event and :
procedure TForm1.Edit1Enter(Sender: TObject);
begin
PostMessage(Edit1.Handle, EM_SETSEL, 0, -1);
end;
You cannot use Edit1.SelectAll since default behaviour (which happens after OnEnter) clears any selections in the Edit control. Posting the message ensures that it gets handled after the remaining default behaviour completes.
To fully emulate the address bar in those browsers, the field also deselects when exiting the control, so in OnExit :
procedure TForm.Edit1Exit(Sender: TObject);
begin
PostMessage(Edit1.Handle, EM_SETSEL, 0, 0);
end;
The browser field also allows you to select text when first entering, so in this case you need to be a bit more careful. As a hack you can do it with an interposer, but ideally you'd make a custom control :
type
TEdit = class(Vcl.StdCtrls.TEdit)
private
FDoEnterSelect : boolean;
end;
and then
procedure TForm1.Edit1Enter(Sender: TObject);
begin
Edit1.FDoEnterSelect := true;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
PostMessage(Edit1.Handle, EM_SETSEL, 0, 0);
end;
procedure TForm1.Edit1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Edit1.FDoEnterSelect and
(Edit1.SelLength = 0) then
PostMessage(Edit1.Handle, EM_SETSEL, 0, -1);
Edit1.FDoEnterSelect := false;
end;
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Edit1.FDoEnterSelect := false;
end;
The KeyUp handler deals with the case of tabbing to the control. The only remaining odd case is if the edit control has TabOrder of zero and, therefore, is focused when the form is created (and therefore selected). This would affect the first click into the control only.
Is there a fast way to create 5 custom hints for 5 SubItems of Item of Tree View?
I have TreeView, 1 Item and 5 SubItems. I need a special hint for each SubItem (for first one - "F1", second one -"F2" and so on).
I can not apply this to my purpose: http://delphi.about.com/od/vclusing/a/treenode_hint.htm?
It sounds like you just want the OnHint event:
procedure TMyForm.TreeView1Hint(Sender: TObject; const Node: TTreeNode; var Hint: string);
begin
Hint := Node.Text;
end;
Sometimes this method can be a bit crude and offer up a Node that you aren't obviously hovering over. If you want more control you can use GetNodeAt and GetHitTestInfoAt:
procedure TMyForm.TreeView1Hint(Sender: TObject; const Node: TTreeNode; var Hint: string);
var
P: TPoint;
MyNode: TTreeNode;
HitTestInfo: THitTests;
begin
P := TreeView1.ScreenToClient(Mouse.CursorPos);
MyNode := TreeView1.GetNodeAt(P.X, P.Y);
HitTestInfo := TreeView1.GetHitTestInfoAt(P.X, P.Y) ;
if htOnItem in HitTestInfo then begin
Hint := MyNode.Text;
end else begin
Hint := '';
end;
end;
The definition of THitTests is as follows:
type
THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
THitTests = set of THitTest;
As you can see this gives you a lot of fine grained control over when and what you show as a hint.
I would set the hint of the component in response to OnMouseMove (or that other event that gives you mouse coordinates, from which you can get the item the mouse is over - I might have mistaken the name and at the moment I have no Delphi with me).
How can I get the handle of a window to be passed to Delphi by the user selecting the window (could be any other aplication's window) by clicking with the mouse on it. In my Delphi app I could have a button the user clicks that starts this detection process as well as a label displaying the clicked on window's title in the Delphi app. When the user is satisfied he selected the correct window he could click the button in my Delphi app (which will be modal) to stop the selection process and let my app start doing to the other window what it needs to do...
if you know what text is in the title of the window, this code will do the trick for you:
var
WindowList: TList;
function GetHandle (windowtitle: string): HWND;
var
h, TopWindow: HWND;
Dest: array[0..80] of char;
i: integer;
s: string;
function getWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;
begin
Result:= True;
WindowList.Add(Pointer(Handle));
end;
begin
result:= 0;
try
WindowList:= TList.Create;
TopWindow:= Application.Handle;
EnumWindows(#getWindows, Longint(#TopWindow));
i:= 0;
while (i < WindowList.Count) and (result = 0) do
begin
GetWindowText(HWND(WindowList[i]), Dest, sizeof(Dest) - 1);
s:= dest;
if length(s) > 0 then
begin
if (Pos(UpperCase(Windowtitle), UpperCase(s)) >= 1) then
begin
h:= HWND(WindowList[i]);
if IsWindow(h) then
result:= h
end
end;
inc(i)
end
finally
WindowList.Free;
end;
end;
Usage in your example (notepad puts the name of the opened file in the window caption):
h:= getHandle('text.txt');
if (h = 0)
// Oops not found
else
begin
// you got the handle!
end;
I used this code to check if my application was already up and running. But it can be used on any launched application.
The approach that user STATUS_ACCESS_DENIED outlined in the comment is likely the simplest way to go here. I'd recommend using mouse capture over hooking, as it's somewhat simpler to implement.
Here's a slightly more detailed outline of what's involved:
The first thing to change the way that the selection process works. Instead of having the user click a button on your app to start the process, and then click the target window, and finally click again to confirm; it's a lot easier to implement if you have the user click a specific area on your app, then drag to the target window, and then let go of the mouse button while over the target. This is because windows considers a click on another app to belong to that app, and you have to do extra work to intercept it. But there's a simple way - called mouse capture - to get information about a drag/release if it starts off as a click on your own app.
This is also the approach that the Windows SDK Spy++ tool uses; so by doing it this way, you're also being consistent with a well-known tool. (Pic of Spy++ here - note the crosshair Finder Tool in the dialog - that's what you click and drag to the target. Would highly recommend downloading the Windows SDK and playing with this tool if you haven't done so before; it's also a very useful way of seeing how other applications are constructed so great as a Windows API learning tool.)
Steps involved:
Have some control in your app that response to mouse-down events (WM_LBUTTONDOWN in Win32/C, OnMouseDown in delphi). You might want to draw a crosshairs icon or similar here so the user knows where to click.
When you get a mouse down, use SetCapture to 'capture' the mouse. This means that the control will receive all the mouse messages while the mouse is moving - until the user releases the button - even if it moves outside the control.
Set the icon to look like a crosshairs so that the user knows they are in dragging mode
As the user moves the mouse, you'll get WM_MOUSEMOVE message (OnMouseMove in Delphi) that has the pointer coordinates. You'll need to use ClientToScreen to convert these to screen coordinates, then WindowFromPoint to find the window at that point. (Note that this finds the innermost window at that point, you could use ChildWindowFromPoint starting from the desktop window to just get the top-level window if you want that.) It's up to you to decide whether you want to update your UI at every mouse move throughout the drag, or just when the user releases the mouse button.
When the user releases the mouse button, you'll get a WM_LBUTTONUP/OnMouseUp; at that stage, wrap things up by calling ReleaseCapture and putting the cursor back to normal shape.
Note that you'll get mouse move events both during the drag, and also if the user just happens to move the mouse pointer across your control, perhaps on the way to some other control. The simplest way to tell these two cases apart is to use a flag in your control that you set when you get the mouse down, and clear when you get the mouse up, and only process mouse move events if that flag is set.
The above describes the process in terms of plain Win32 APIs that you'd call from C/C++; but it looks like Delphi provides direct support for most or all of them.
edit: Possible Delphi implementation:
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FCacheWnd: HWND;
FCaptured: Boolean;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const // the first item, the place where the crosshair is
ClickRect: TRect = (Left: 10; Top: 10; Right: 44; Bottom: 44);
procedure TForm1.FormPaint(Sender: TObject);
begin
// draw the control and the crosshair if no capturing
if GetCapture <> Handle then begin
DrawFrameControl(Canvas.Handle, ClickRect, 0, DFCS_BUTTONPUSH);
DrawIcon(Canvas.Handle, ClickRect.Left, ClickRect.Top,
Screen.Cursors[crCross]);
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (Shift = [ssLeft])
and PtInRect(ClickRect, Point(X, Y)) then begin
// the second item, draw the control pressed,
// set the flag and the capture. FCacheWnd is used not to get
// window information for every mouse move - if the window under the
// mouse is not changed.
DrawFrameControl(Canvas.Handle, ClickRect, 0, DFCS_PUSHED);
FCacheWnd := 0;
FCaptured := True;
SetCapture(Handle);
Screen.Cursor := crCross; // the third item, set the cursor to crosshair.
end;
end;
function GetWndFromClientPoint(ClientWnd: HWND; Pt: TPoint): HWND;
begin
MapWindowPoints(ClientWnd, GetDesktopWindow, Pt, 1);
Result := WindowFromPoint(Pt);
end;
function GetWndInfo(Wnd: HWND): string;
var
ClassName: array [0..256] of Char;
begin
Result := '';
if IsWindow(Wnd) then begin
GetClassName(Wnd, ClassName, 256);
Result := Format('Window: %x [%s]', [Wnd, ClassName]);
if (GetWindowLong(Wnd, GWL_STYLE) and WS_CHILD) = WS_CHILD then begin
Wnd := GetAncestor(Wnd, GA_ROOT);
GetClassName(Wnd, ClassName, 256);
Result := Format(Result + sLineBreak + 'Top level: %x [%s]', [Wnd, ClassName]);
end;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Wnd: HWND;
begin
if FCaptured then begin
// fourth item, convert coordinates and find the window under the cursor
Wnd := GetWndFromClientPoint(Handle, Point(X, Y));
if Wnd <> FCacheWnd then
Label1.Caption := GetWndInfo(Wnd);
FCacheWnd := Wnd;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FCaptured then begin
// fifth item
FCaptured := False;
ReleaseCapture;
InvalidateRect(Handle, #ClickRect, False); // invalidate pressed look
Screen.Cursor := crDefault;
end;
end;
Edit: It's gone, but you used to be able to download Delphi Window Spy by Eddie Shipman, from delphipages.com, which has turned into a festering heap of useless linkbait.
How can I get the handle of a window to be passed to Delphi by the user selecting the window (could be any other aplication's window) by clicking with the mouse on it. In my Delphi app I could have a button the user clicks that starts this detection process as well as a label displaying the clicked on window's title in the Delphi app. When the user is satisfied he selected the correct window he could click the button in my Delphi app (which will be modal) to stop the selection process and let my app start doing to the other window what it needs to do...
if you know what text is in the title of the window, this code will do the trick for you:
var
WindowList: TList;
function GetHandle (windowtitle: string): HWND;
var
h, TopWindow: HWND;
Dest: array[0..80] of char;
i: integer;
s: string;
function getWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;
begin
Result:= True;
WindowList.Add(Pointer(Handle));
end;
begin
result:= 0;
try
WindowList:= TList.Create;
TopWindow:= Application.Handle;
EnumWindows(#getWindows, Longint(#TopWindow));
i:= 0;
while (i < WindowList.Count) and (result = 0) do
begin
GetWindowText(HWND(WindowList[i]), Dest, sizeof(Dest) - 1);
s:= dest;
if length(s) > 0 then
begin
if (Pos(UpperCase(Windowtitle), UpperCase(s)) >= 1) then
begin
h:= HWND(WindowList[i]);
if IsWindow(h) then
result:= h
end
end;
inc(i)
end
finally
WindowList.Free;
end;
end;
Usage in your example (notepad puts the name of the opened file in the window caption):
h:= getHandle('text.txt');
if (h = 0)
// Oops not found
else
begin
// you got the handle!
end;
I used this code to check if my application was already up and running. But it can be used on any launched application.
The approach that user STATUS_ACCESS_DENIED outlined in the comment is likely the simplest way to go here. I'd recommend using mouse capture over hooking, as it's somewhat simpler to implement.
Here's a slightly more detailed outline of what's involved:
The first thing to change the way that the selection process works. Instead of having the user click a button on your app to start the process, and then click the target window, and finally click again to confirm; it's a lot easier to implement if you have the user click a specific area on your app, then drag to the target window, and then let go of the mouse button while over the target. This is because windows considers a click on another app to belong to that app, and you have to do extra work to intercept it. But there's a simple way - called mouse capture - to get information about a drag/release if it starts off as a click on your own app.
This is also the approach that the Windows SDK Spy++ tool uses; so by doing it this way, you're also being consistent with a well-known tool. (Pic of Spy++ here - note the crosshair Finder Tool in the dialog - that's what you click and drag to the target. Would highly recommend downloading the Windows SDK and playing with this tool if you haven't done so before; it's also a very useful way of seeing how other applications are constructed so great as a Windows API learning tool.)
Steps involved:
Have some control in your app that response to mouse-down events (WM_LBUTTONDOWN in Win32/C, OnMouseDown in delphi). You might want to draw a crosshairs icon or similar here so the user knows where to click.
When you get a mouse down, use SetCapture to 'capture' the mouse. This means that the control will receive all the mouse messages while the mouse is moving - until the user releases the button - even if it moves outside the control.
Set the icon to look like a crosshairs so that the user knows they are in dragging mode
As the user moves the mouse, you'll get WM_MOUSEMOVE message (OnMouseMove in Delphi) that has the pointer coordinates. You'll need to use ClientToScreen to convert these to screen coordinates, then WindowFromPoint to find the window at that point. (Note that this finds the innermost window at that point, you could use ChildWindowFromPoint starting from the desktop window to just get the top-level window if you want that.) It's up to you to decide whether you want to update your UI at every mouse move throughout the drag, or just when the user releases the mouse button.
When the user releases the mouse button, you'll get a WM_LBUTTONUP/OnMouseUp; at that stage, wrap things up by calling ReleaseCapture and putting the cursor back to normal shape.
Note that you'll get mouse move events both during the drag, and also if the user just happens to move the mouse pointer across your control, perhaps on the way to some other control. The simplest way to tell these two cases apart is to use a flag in your control that you set when you get the mouse down, and clear when you get the mouse up, and only process mouse move events if that flag is set.
The above describes the process in terms of plain Win32 APIs that you'd call from C/C++; but it looks like Delphi provides direct support for most or all of them.
edit: Possible Delphi implementation:
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FCacheWnd: HWND;
FCaptured: Boolean;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const // the first item, the place where the crosshair is
ClickRect: TRect = (Left: 10; Top: 10; Right: 44; Bottom: 44);
procedure TForm1.FormPaint(Sender: TObject);
begin
// draw the control and the crosshair if no capturing
if GetCapture <> Handle then begin
DrawFrameControl(Canvas.Handle, ClickRect, 0, DFCS_BUTTONPUSH);
DrawIcon(Canvas.Handle, ClickRect.Left, ClickRect.Top,
Screen.Cursors[crCross]);
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (Shift = [ssLeft])
and PtInRect(ClickRect, Point(X, Y)) then begin
// the second item, draw the control pressed,
// set the flag and the capture. FCacheWnd is used not to get
// window information for every mouse move - if the window under the
// mouse is not changed.
DrawFrameControl(Canvas.Handle, ClickRect, 0, DFCS_PUSHED);
FCacheWnd := 0;
FCaptured := True;
SetCapture(Handle);
Screen.Cursor := crCross; // the third item, set the cursor to crosshair.
end;
end;
function GetWndFromClientPoint(ClientWnd: HWND; Pt: TPoint): HWND;
begin
MapWindowPoints(ClientWnd, GetDesktopWindow, Pt, 1);
Result := WindowFromPoint(Pt);
end;
function GetWndInfo(Wnd: HWND): string;
var
ClassName: array [0..256] of Char;
begin
Result := '';
if IsWindow(Wnd) then begin
GetClassName(Wnd, ClassName, 256);
Result := Format('Window: %x [%s]', [Wnd, ClassName]);
if (GetWindowLong(Wnd, GWL_STYLE) and WS_CHILD) = WS_CHILD then begin
Wnd := GetAncestor(Wnd, GA_ROOT);
GetClassName(Wnd, ClassName, 256);
Result := Format(Result + sLineBreak + 'Top level: %x [%s]', [Wnd, ClassName]);
end;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Wnd: HWND;
begin
if FCaptured then begin
// fourth item, convert coordinates and find the window under the cursor
Wnd := GetWndFromClientPoint(Handle, Point(X, Y));
if Wnd <> FCacheWnd then
Label1.Caption := GetWndInfo(Wnd);
FCacheWnd := Wnd;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FCaptured then begin
// fifth item
FCaptured := False;
ReleaseCapture;
InvalidateRect(Handle, #ClickRect, False); // invalidate pressed look
Screen.Cursor := crDefault;
end;
end;
Edit: It's gone, but you used to be able to download Delphi Window Spy by Eddie Shipman, from delphipages.com, which has turned into a festering heap of useless linkbait.