I would like to know a way to verify if the focus of a component was activated by the mouse, if yes to execute a certain procedure in Delphi.
you can use enter and exit event :
procedure TForm1.Edit1Exit(Sender: TObject);
begin
myProcedureRun1;
end;
procedure TForm1.Edit1Enter(Sender: TObject);
begin
myProcedureRun2;
end;
Related
I'm trying to free a component when i click it. So, i've written the simplest code i could imagine to achieve this: a procedure that frees it's sender. But on Delphi 7 (Tried on Delphi XE 10 and it worked with no errors) it sometimes throws an Access Violation or Abstract Error randomly. The easiest way to replicate this is to insert like 30 Buttons and assign an onclick procedure with the code below, then click them.
I've tried the two codes below, both on onclick:
procedure FreeMe(Sender: TObject);
begin
TButton(Sender).Free;
end;
or
procedure FreeMe(Sender: TObject);
begin
(Sender as TButton).Free;
end;
You need to delay the freeing until after the button's OnClick event handier has fully exited. It is important that the freeing happens when the object being freed is idle and not in the middle of processing anything.
One way to do that is to use PostMessage(), eg:
var
MyReleaseWnd: HWND;
procedure TMyMainForm.FormCreate(Sender: TObject);
begin
MyReleaseWnd := AllocateHWnd(MyReleaseWndProc);
end;
procedure TMyMainForm.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(MyReleaseWnd);
end;
procedure TMyMainForm.MyReleaseWndProc(var Message: TMessage);
begin
if Message.Msg = CM_RELEASE then
TObject(Msg.LParam).Free
else
Message.Result := DefWindowProc(MyReleaseWnd, Message.Msg, Message.WParam, Message.LParam);
end;
procedure DelayFreeMe(Sender: TObject);
begin
PostMessage(MyReleaseWnd, CM_RELEASE, 0, LPARAM(Sender));
end;
Alternatively, in 10.2 Tokyo and later, you can use TThread.ForceQueue() instead:
procedure DelayFreeMe(Sender: TObject);
begin
TThread.ForceQueue(nil, Sender.Free);
end;
Either way, you can then do this:
procedure TSomeForm.ButtonClick(Sender: TObject);
begin
DelayFreeMe(Sender);
end;
I use Delphi Berlin on Windows 10. I need to use tOpenDialog on a tStringGrid based tForm.
When I double click a file which overlaps a fixed column or row on an open dialog onFixedCellClick event fires automatically right after the disapperance of the open dialog. In the following image the file is on the same position of fixed row which is the first line.
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
OpenDialog1: TOpenDialog;
procedure FormClick(Sender: TObject);
procedure StringGrid1FixedCellClick(Sender: TObject; ACol, ARow: Integer);
procedure FormCreate(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Options := StringGrid1.Options + [goFixedColClick, goFixedRowClick];
end;
procedure TForm1.FormClick(Sender: TObject);
begin
OpenDialog1.Execute;
end;
procedure TForm1.StringGrid1FixedCellClick(Sender: TObject; ACol, ARow: Integer);
begin
Caption := '';
end;
In most cases I can handle this by moving the dialog window or clicking the file once and clicking open button but I can't guarantee that other people who will use this would do that.
What is the reason and how can I solve this problem?
I believe this is a problem in how TCustomGrid triggers its OnFixedCellClick event on a mouse-up message (in its overriden MouseUp method) without checking if there was a corresponding mouse-down message (FHotTrackCell.Pressed). A quick fix (if you can copy and modify Vcl.Grids): on line 4564 in Berlin (in TCustomGrid.MouseUp method add another condition to check, leading to the call to FixedCellClick):
if ... and FHotTrackCell.Pressed then
FixedCellClick(Cell.X, Cell.Y);
In other words, don't call FixedCellClick if a mouse-up comes without a prior corresponding mouse-down.
Given a TForm with a TListBox on it, the following works:
procedure TForm1.FormCreate(Sender: TObject);
procedure _WorkOnListBox;
begin
ListBox.Items.Append('Test');
end;
begin
_WorkOnListBox;
end;
As does the following:
procedure TForm1.DoWithoutListBoxEvents(AProc: TProc);
begin
ListBox.Items.BeginUpdate;
try
AProc;
finally
ListBox.Items.EndUpdate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoWithoutListBoxEvents(procedure
begin
LayersListBox.Items.Append('Test');
end);
end;
But the following does not:
procedure TForm1.FormCreate(Sender: TObject);
procedure _WorkOnListBox;
begin
ListBox.Items.Append('Test');
end;
begin
DoWithoutListBoxEvents(_WorkOnListBox);
end;
I get an E2555 Cannot capture symbol '_WorkOnListBox'. Why? Is there any way to get the DoWithoutListBoxEvents to work without using an anonymous procedure? Although I think it looks elegant with it, I'm trying to stay FPC compatible.
DoWithoutEvents() takes a TProc as input:
type
TProc = procedure;
Only a standalone non-class procedure and an anonymous procedure can be assigned to a TProc. _WorkOnForm is neither of those, it is a local procedure instead. A local procedure has special compiler handling that ties it to its parent's stack frame. Thus, _WorkOnForm is not compatible with TProc.
How do I create an OnMouseLeave event?
Another alternative to the Andreas solution, is use the CM_MOUSELEAVE VCL Message which is already defined in delphi 7.
check this sample using a interposer class for the TButton
type
TButton = class(StdCtrls.TButton)
private
FOnMouseLeave: TNotifyEvent;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
private
procedure ButtonMouseLeave(Sender: TObject);
public
end;
//handle the message and call the event handler
procedure TButton.CMMouseLeave(var Message: TMessage);
begin
if (Message.LParam = 0) and Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
procedure TForm1.ButtonMouseLeave(Sender: TObject);
begin
//your code goes here
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//assign the event
Button1.OnMouseLeave:=ButtonMouseLeave;
end;
You can tell Windows to post you a message, more specifically a WM_MOUSELEAVE message, when the mouse leaves the control. To do this, call the TrackMouseEvent function. In the TRACKMOUSEEVENT structure, specify the TME_LEAVE flag.
On request, some code:
When the control has been created, and the mouse is inside the client area of the control, tell Windows that you want to be notified about the mouse leaving the control:
procedure TMyControl.SetMouseEvent;
var
tme: TTrackMouseEvent;
begin
tme.cbSize := sizeof(tme);
tme.dwFlags := TME_LEAVE;
tme.hwndTrack := Self.Handle;
TrackMouseEvent(tme);
end;
Call this procedure when the control has been created and the mouse is inside the control. Now you just have to listen to the WM_MOUSELEAVE mesage. In your WndProc procedure (a protected member of the class), add a WM_MOUSELEAVE case.
procedure TMyControl.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_MOUSELEAVE:
beep;
end;
end;
I think that Windows removes the notification request when a message has been created, so you have to rerequest the notification when you have recieved a message. You cannot call SetMouseEvent in the WndProc, because the mouse needs to be inside the client area of the control when you call TrackMouseEvent. I think you could place your SetMouseEvent inside the OnMouseMove of the control:
procedure TMyControl.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_MOUSELEAVE:
beep;
WM_MOUSEMOVE:
SetMouseEvent;
end;
end;
I haven't tested the code above myself, because I use a newer version of Delphi, Delphi 2009, which does things like this behind the scenes (I think, because there is now a OnMouseLeave event in controls), and I think that will interfere.
English Translation (been a while, so may not be entirely accurate; used google translate for the parts I had trouble with):
I'm working on a Visual Component in Delphi (it's not a standard Delphi component) which possesses a property called PopupMenu. I associated the property PopupMenu in the component with the PopupMenu, but when I click the right button [of the mouse], I see nothing.
I also tried to force it to display with this code:
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
// //showmessage(inttostr(x)) PopupMenu1.Popup(x,y);
I have two questions:
How do you know that the right click of the mouse is active? Have any of you encountered this type of problem? Thank you for your answers.
Thanks
EDIT
Here is the procedure that I'm using to execute the PopupMenu1: procedure
TForm6.GeckoBrowser1DOMMouseDown(Sender: TObject; Key: Word);
var x,y:integer;
begin
if key=VK_RBUTTON then begin
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
//showmessage(inttostr(x)) PopupMenu1.Popup(x,y);
end;
end;
This will never work. You cannot mix code in a form with the component code.
I would suggest something like this:
interface
type
TGeckoBrowser = class(....
private
FPopupmenu: TPopupMenu;
protected
...
procedure MouseUp(Sender: TObject; Key: Word); override;
...
published
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
end;
implementation
....
procedure TGeckoBrowser.MouseUp(Sender: TObject; Key: Word);
var
x,y: integer;
begin
inherited;
if (key=VK_RBUTTON) and Assigned(PopupMenu) then begin
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
PopupMenu.Popup(x,y);
end; {if}
end;
or if you do not want the OnMouseUp to fire when a popup menu appears do:
implementation
....
procedure TGeckoBrowser.MouseUp(Sender: TObject; Key: Word);
var
x,y: integer;
begin
if (key=VK_RBUTTON) and Assigned(PopupMenu) then begin
x:= Mouse.CursorPos.X;
y:= Mouse.CursorPos.Y;
PopupMenu.Popup(x,y);
end {if}
else inherited;
end;
See the difference? Popupmenu is now a part (well linked part anyway) of your component and not something that just happens to be on the same form.