I'm having EAccessViolation when I close the form of my application and I don't know how to deal with this, I have two units, here is the main unit relevant code:
unit MainUnit;
uses
.., myComponent1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
MyComponent1.doSomeWork(p1, p2, ..., pn);
end;
procedure TForm1.OnMyComponen1tEvent(sender: TObject; p: Integer);
begin
memo1.Lines.Add(message);
end;
end.
This unit uses another unit is a component class, in which i send a signal to memo1 to show the message, of course using the component event, it's something like:
unit myComponent;
type
TMyComponentEvent = procedure(sender: TObject; p: integer) of object;
type
TMyComponent = class(TComponent)
// Properties and events declaration
procedure TPThread.Execute;
begin
try
// Create and run some worker threads
// Wait for them to finish the job
// This is the last thing to do:
if Assigned(FOnMyComponentEvent) then
begin
FOnMyComponentEvent(Self, p);
end;
finally
//free ressources
end;
end;
procedure TMyComponent.DoSomeWork;
begin
TPThread.Create(p1, p2 ...);
end;
end.
When I close the form before the program finishes its job ( The threads are still working), i get that exception but sometimes, there is no exception raised. Well, when the exception is raised it indicates the line: memo1.Lines.Add(message);.
I don't know how to solve it, so how can I prevent the exception from happening?
Sounds like you are not setting the MyEvent event to nil when destroying the Form, eg
procedure TForm1.FormCreate(sender: TObject);
begin
OtherUnit.MyEvent := MyEvent;
end;
procedure TForm1.FormDestroy(sender: TObject);
begin
OtherUnit.MyEvent := nil;
end;
Related
Running into a runtime error when I open a modal form (Form2) that, on create, calls another procedure that does somehting with a VCL component. The following program demonstrates the issue.
This is the code on the modal form:
procedure DoLabel;
begin
form2.Label1.Caption := 'A';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
DoLabel;
end;
This compiles well. However, the program crashes on opening the modal form. The debugger says: access violation at address xxxx. It is probably a basic error, but what am I doing wrong? And how to solve this?
You are using the global Form2 variable, which has not been assigned yet (or at all) while the TForm2 object is still being constructed.
You need to change your code to not rely on that variable during construction (and preferably remove it entirely, unless TForm2 is auto-created at startup, which it does not sound like it is).
For instance, pass the Form's Self pointer, or even its TLabel pointer, as an input parameter to DoLabel(), eg:
procedure DoLabel(ALabel: TLabel);
begin
ALabel.Caption := 'A';
end;
procedure DoFormStuff(AForm: TForm2);
begin
// use AForm as needed...
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
DoLabel(Label1);
DoFormStuff(Self);
end;
Though, in this case, it would make more sense to have DoFormStuff(), and possible DoLabel() too, be a member of the TForm2 class instead of free functions:
procedure TForm2.FormCreate(Sender: TObject);
begin
DoLabel;
DoFormStuff;
end;
procedure TForm2.DoLabel;
begin
Label1.Caption := 'A';
end;
procedure TForm2.DoFormStuff;
begin
// use Self as needed...
end;
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;
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.
I'm working on something which will require monitoring of many forms. From outside the form, and without putting any code inside the form, I need to somehow capture events from these forms, most likely in the form of windows messages. But how would you capture windows messages from outside the class it's related to?
My project has an object which wraps each form it is monitoring, and I presume this handling will go in this object. Essentially, when I create a form I want to monitor, I create a corresponding object which in turn gets added to a list of all created forms. Most importantly, when that form is closed, I have to know so I can remove this form's wrapper object from the list.
These events include:
Minimize
Maximize
Restore
Close
Focus in/out
What I DON'T want:
Any code inside any forms or form units for this handling
Inheriting the forms from any custom base form
Using the form's events such as OnClose because they will be used for other purposes
What I DO want:
Handling of windows messages for these events
Any tips on how to get windows messages from outside the class
Which windows messages I need to listen for
Question re-written with same information but different approach
You need to listen for particular windows messages being delivered to the form. The easiest way to do this is to assign the WindowProc property of the form. Remember to keep a hold of the previous value of WindowProc and call it from your replacement.
In your wrapper object declare a field like this:
FOriginalWindowProc: TWndMethod;
Then in the wrapper's constructor do this:
FOriginalWindowProc := Form.WindowProc;
Form.WindowProc := NewWindowProc;
Finally, implement the replacement window procedure:
procedure TFormWrapper.NewWindowProc(var Message: TMessage);
begin
//test for and respond to the messages of interest
FOriginalWindowProc(Message);
end;
Here's a more complete example of the solution that David Provided:
private
{ Private declarations }
SaveProc : TWndMethod;
procedure CommonWindowProc(var Message: TMessage);
...
procedure TForm1.Button1Click(Sender: TObject);
var
f : tForm2;
begin
f := tForm2.Create(nil);
SaveProc := f.WindowProc;
f.WindowProc := CommonWindowProc;
f.Show;
end;
procedure TForm1.CommonWindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_SIZE : Memo1.Lines.Add('Resizing');
WM_CLOSE : Memo1.Lines.Add('Closing');
CM_MOUSEENTER : Memo1.Lines.Add('Mouse enter form');
CM_MOUSELEAVE : Memo1.Lines.Add('Mouse leaving form');
// all other messages will be available as needed
end;
SaveProc(Message); // Call the original handler for the other form
end;
A better solution than trying to work outside of the form would be to make every form descend from a common base form that implements the functionality. The form event handlers are exactly the right place to add this code but you'd write it all in the ancestor form. Any descendant form could still use the form events and as long as they always call inherited somewhere in the event handler the ancestor code would still execute.
Another option is create TApplicationEvents and assign a handler to OnMessage event. Once if it fired, use the FindControl function and Msg.hWnd to check if it is the tform type and do what ever you want without hookin
Using Windows Messages can really attain a fine granularity (Yes, its part of your requirements!) but in some user cases where relying just on the VCL Event Framework suffices, a similar solution can be suggested:
unit Host;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
THostForm = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
FFormResize: TNotifyEvent;
FFormActivate: TNotifyEvent;
FFormDeactivate: TNotifyEvent;
FFormDestroy: TNotifyEvent;
procedure _FormResize(Sender: TObject);
procedure _FormActivate(Sender: TObject);
procedure _FormDeactivate(Sender: TObject);
procedure InternalEventHandlerInit(const AForm:TForm);
public
procedure Log(const Msg:string);
procedure Logln(const Msg:string);
end;
var
HostForm: THostForm;
implementation
{$R *.dfm}
procedure THostForm.Button1Click(Sender: TObject);
var
frm: TForm;
begin
frm := TForm.Create(nil);
frm.Name := 'EmbeddedForm';
frm.Caption := 'Embedded Form';
//
InternalEventHandlerInit(frm);
//
Logln('<'+frm.Caption+'> created.');
//
frm.Show;
end;
procedure THostForm.InternalEventHandlerInit(const AForm: TForm);
begin
FFormResize := AForm.OnResize;
AForm.OnResize := _FormResize;
//
FFormActivate := AForm.OnActivate;
AForm.OnActivate := _FormActivate;
//
FFormDeactivate := AForm.OnDeactivate;
AForm.OnDeactivate := _FormDeactivate;
end;
procedure THostForm.Log(const Msg: string);
begin
Memo1.Lines.Add(Msg);
end;
procedure THostForm.Logln(const Msg: string);
begin
Memo1.Lines.Add(Msg);
Memo1.Lines.Add('');
end;
procedure THostForm._FormActivate(Sender: TObject);
begin
Log('Before OnActivate <'+(Sender as TCustomForm).Caption+'>');
//
if Assigned(FFormActivate) then
FFormActivate(Sender) // <<<
else
Log('No OnActivate Event Handler attached in <'+(Sender as TCustomForm).Caption+'>');
//
Logln('After OnActivate <'+(Sender as TCustomForm).Caption+'>');
end;
procedure THostForm._FormDeactivate(Sender: TObject);
begin
Log('Before OnDeactivate <'+(Sender as TCustomForm).Caption+'>');
//
if Assigned(FFormDeactivate) then
FFormDeactivate(Sender)
else
Log('No OnDeActivate Event Handler attached in <'+(Sender as TCustomForm).Caption+'>');
//
Logln('After OnDeactivate <'+(Sender as TCustomForm).Caption+'>');
end;
procedure THostForm._FormResize(Sender: TObject);
begin
Log('Before OnResize <'+(Sender as TCustomForm).Caption+'>');
//
if Assigned(FFormResize) then
FFormResize(Sender)
else
Log('No OnResize Event Handler attached in <'+(Sender as TCustomForm).Caption+'>');
//
Logln('After OnResize <'+(Sender as TCustomForm).Caption+'>');
end;
end.
I am writing an application which should draw a circle in place where user clicks a mouse. To achieve that i am hooking the mouse globally using SetWindowHookEx(WH_MOUSE,...)
The hooking, and the procedure that processes mouse action is in DLL. The procedure posts a registered message when it finds that mouse button was clicked using PostMessage(FindWindow('TMyWindow',nil), MyMessage, 0,0);
My application with TMyWindow form processes the messages in WndProc procedure. I check whether the message that came is the same as my registered one and only then draw the circle. After drawing the circle i create a timer, which should free the image after 500ms.
So everything seems to work just fine until i actually click on any part of my application form (for example click on still existing circle that was drawn not long ago). When i do that, form starts receiving my registered messages infinitely ans of course circle drawing procedure gets called every time.
I dont understand why is it doing so. Why is it working fine when i click somewhere off my application form but hangs when i click inside my form?
Let me know if you need more details.
Thanks
EDIT 1:
Main unit. $202 message is WM_LBUTTONUP.
unit main;
interface
uses
HookCommon,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, AppEvnts;
type
TTimer2 = class(TTimer)
private
FShape: TShape;
public
destructor Destroy; override;
property Shape: TShape read FShape write FShape;
end;
type
TShowMouseClick = class(TForm)
timerCountTimer: TTimer;
tray: TTrayIcon;
popMenu: TPopupMenu;
mnuExit: TMenuItem;
mnuActive: TMenuItem;
N1: TMenuItem;
mnuSettings: TMenuItem;
timersStx: TStaticText;
procedure timerCountTimerTimer(Sender: TObject);
procedure mnuExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
timerList: TList;
procedure shape();
procedure freeInactive(var Msg: TMessage); message WM_USER + 1545;
public
shapeColor: Tcolor;
procedure TimerExecute(Sender: TObject);
protected
procedure WndProc(var Message: TMessage); override;
{ Public declarations }
end;
var
ShowMouseClick: TShowMouseClick;
implementation
{$R *.dfm}
uses settings;
{$REGION 'Hide from TaskBar'}
procedure TShowMouseClick.FormActivate(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TShowMouseClick.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
{$ENDREGION}
procedure TShowMouseClick.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
if (Message.Msg = HookCommon.MouseHookMessage) and
(Message.WParam = $202) then
shape;
end;
procedure TShowMouseClick.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
WindowState := wsMaximized;
mnuActive.Checked := true;
HookCommon.HookMouse;
timerList := TList.Create;
timerList.Clear;
shapeColor := clGreen;
end;
procedure TShowMouseClick.FormDestroy(Sender: TObject);
begin
HookCommon.UnHookMouse;
end;
procedure TShowMouseClick.mnuExitClick(Sender: TObject);
begin
Close;
end;
procedure TShowMouseClick.timerCountTimerTimer(Sender: TObject);
begin
timersStx.Caption := 'Active timers: ' + IntToStr(timerList.Count);
end;
procedure TShowMouseClick.shape;
var
tm: TTimer2;
begin
tm := TTimer2.Create(nil);
tm.Tag := 0 ;
tm.Interval := 1;
tm.OnTimer := TimerExecute;
tm.Shape := nil;
timerList.Add(tm);
timersStx.Caption := 'Active timers: ' + IntToStr(timerList.Count);
tm.Enabled := true;
end;
procedure TShowMouseClick.TimerExecute(Sender: TObject);
var
img: TShape;
snd: TTimer2;
begin
snd := nil;
if Sender is TTimer2 then
snd := TTimer2(Sender);
if snd = nil then Exit;
if snd.Tag = 0 then
begin
snd.Interval := 500;
img := TShape.Create(nil);
img.Parent := ShowMouseClick;
img.Brush.Color := clGreen;
img.Shape := stCircle;
img.Width := 9;
img.Height := 9;
img.Left := Mouse.CursorPos.X-4;
img.Top := Mouse.CursorPos.Y-3;
snd.Tag := 1;
snd.Shape := img;
end else begin
snd.Enabled := false;
PostMessage(ShowMouseClick.Handle,WM_USER + 1545 , 0,0);
Application.ProcessMessages;
end;
end;
procedure TShowMouseClick.freeInactive(var Msg: TMessage);
var
i: integer;
begin
for i := timerList.Count - 1 downto 0 do
if TTimer2(timerList[i]).Enabled = false then
begin
TTimer2(timerList[i]).Free;
timerList.Delete(i);
end;
end;
destructor TTimer2.Destroy;
begin
FreeAndNil(FShape);
inherited;
end;
end.
Common unit.
unit HookCommon;
interface
uses Windows;
var
MouseHookMessage: Cardinal;
procedure HookMouse;
procedure UnHookMouse;
implementation
procedure HookMouse; external 'MouseHook.DLL';
procedure UnHookMouse; external 'MouseHook.DLL';
initialization
MouseHookMessage := RegisterWindowMessage('MouseHookMessage');
end.
DLL code.
library MouseHook;
uses
Forms,
Windows,
Messages,
HookCommon in 'HookCommon.pas';
{$J+}
const
Hook: HHook = 0;
{$J-}
{$R *.res}
function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
notifyTestForm : boolean;
begin
notifyTestForm := false;
if msgID = $202 then
notifyTestForm := true;
if notifyTestForm then
begin
PostMessage(FindWindow('TShowMouseClick', nil), MouseHookMessage, MsgID, 0);
end;
Result := CallNextHookEx(Hook,nCode,MsgID,Data);
end;
procedure HookMouse; stdcall;
begin
if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE,#HookProc,HInstance,0);
end;
procedure UnHookMouse; stdcall;
begin
UnhookWindowsHookEx(Hook);
Hook:=0;
end;
exports
HookMouse, UnHookMouse;
begin
end.
The source of the mouse hook stuff is this
Why is it working fine when i click somewhere off my application form
but hangs when i click inside my form?
You're not posting the message to other windows when you click on them. First you should ask yourself, "what happens if I posted a message in my hook callback to all windows which are posted a WM_LBUTTONUP?".
Replace this line
PostMessage(FindWindow('TShowMouseClick', nil), MouseHookMessage, MsgID, 0);
in your dll code, with this:
PostMessage(PMouseHookStruct(Data).hwnd, MouseHookMessage, MsgID, 0);
It doesn't matter if the other applications would know or not what MouseHookMessage is, they will ignore the message. Launch your application and click the mouse wildly to other windows. Generally nothing will happen. Unless you click in the client area of any Delphi application. You'll instantly freeze it.
The answer to this question lies in both how a VCL message loop runs and how a WH_MOUSE hook works. A quote from MouseProc callback function's documentation.
[..] The system calls this function whenever an application calls the
GetMessage or PeekMessage function and there is a mouse message to be
processed.
Suppose you launch your application and the mouse is hooked, then you hover the mouse on your form and wait till your application calls 'WaitMessage', that it is idle. Now click in the client area to generate mouse messages. What happens is that the OS places messages to your application's main thread's message queue. And what your application does is that to remove and dispatch these messages with PeekMessage. This is where applications differ. The VCL first calls 'PeekMessage' with 'PM_NOREMOVE' passed in 'wRemoveMsg' parameter, while most other applications either removes the message with a call to 'PeekMessage' or do the same by using 'GetMessage'.
Now suppose it is 'WM_LBUTTONUP's turn. Refer to the quote above. As soon as PeekMessage is called, the OS calls the MouseProc callback. The call happens from 'user32.dll', that is, when your hook callback is called the statement following the 'PeekMessage' is not executed yet. Also, remember the VCL loop, the message is still in the queue, it has not been removed. Now, your callback function posts a message to the same message queue and returns. Execution returns to the VCL message loop and VCL again calls 'PeekMessage', this time to remove and dispatch the message, but instead of removing the 'WM_LBUTTONUP', it removes the custom message that you posted. 'WM_LBUTTONUP' remains in the queue. After the custom message is dispatched, since 'WM_LBUTTONUP' is still in the queue, 'PeekMessage' is again called, and again the OS calls the callback so that the callback can post another custom message to be removed instead of the mouse message. This loop effectively freezes the application.
To resolve, either post your message to a different thread that has its own message loop which would in some way synchronize with the main thread, or, I would not especially advice it but, instead of posting the message, send it. As an alternative you can remove the 'WM_LBUTTONUP' message yourself from the queue if one exists:
procedure TShowMouseClick.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
if (Message.Msg = HookCommon.MouseHookMessage) and
(Message.WParam = $202) then begin
if PeekMessage(Msg, Handle, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE) then
DispatchMessage(Msg); // or eat if you don't need it.
..
end;
The disadvantage to this approach is that, the PeekMessage itself, as mentioned above, will cause another custom message to be posted, so you'll be receiving those in pairs.
Either your Mouse click or your MyMessage messages are not removed from the Message Queue (unlikely) or they are somehow echoed back, or your code loops in a recursion.
I would try to remove any code from your TMyWindow.WndProc and replace it with some innocuous code (like an OutputDebugString to see it called in the message area of the IDE) to see if it is still looping or not.
Something like:
with Message do
case Msg of
WM_MyMessage: OutputDebugString('MyMessage received. Drawing a circle');
else
inherited WndProc(Message);
If it's only writing once per click, then the recursion is in your handling of the message (or in the timer handler) to draw/erase the circle.
If it's looping, then your click generates multiple messages or 1 that is spinning forever...
Update:
After giving a look at your code, I'd change the way you deal with the timers.
- Don't create the timer with an interval of 1 for the purpose of creating the shape. You'll be flooding your app with Timer events.
- As soon as you enter the Execute, disable the timer
- Avoid calling Application.ProcessMessages.
- You may have some reasons, but I find this very convoluted when it seems to me that a simple OnMouse event on your form could achieve this easily.
This happens because FindWindow actually sends messages on its own that also wind up in your hook. Specifically, it sends a WM_GETTEXT to get the window's title.
To avoid that, do the FindWindow up front (outside the hook's callback).