I'm programing one network application in delphi 6 using TTCPServer. At OnAccept event of this component I call showmodal for another form. This cause to hang the main form. I think that it is because of threads but I do not know how to showmodal the form at this event. I really have to call that.
I appreciate any answer. thanks.
var
s: array[0..10000] of byte;
i, j: integer;
Str : String;
Request, UN, Pass: WideString;
StartItemNode : IXMLNode;
st: TStringStream;
begin
CoInitialize(nil);
i := ClientSocket.ReceiveBuf(s, 10000, 0);
Str := '';
for j := 0 to i - 1 do
Str := Str + AnsiChar(s[j]);
XMLDoc.XML.Text := Str;
XMLDoc.Active := true;
StartItemNode := XMLDoc.ChildNodes.FindNode('r');
Request := StartItemNode.ChildNodes['request'].Text;
if(Request = 'Order')then
begin
Memo1.Lines.Text := Str;
ClientSocket.Sendln('<?xml version="1.0" encoding="utf-8"?><r><answer result="OK"></answer></r>');
**Form2.ShowModal;**
end;
Finally find the answer. with Indy component we can use TidSync or TidNotify. Create it and the call the Synchronize method of then with parameter of a method. this method with run at main thread(UI) and it is thread safe.
I can not find any solution for TTCPServer but we can use Timer. Set its Interval to for example 100 and do your showmodal at tick of that. but do not forgot about more than one running at same time. for example at OnTimer you have to disable recieving new connections or save them in array to process next OnTimer event.
Related
I want to track long running operations on idHTTPServer from idHTTPClient by ping. How would I do that better way ? I need something unique for that. I tried with bind.id but with no success.
lets say i give something unique when thread is started it job
procedure TRPTests.SomeServerJob;
var
jo: ISuperObject;
begin
TThread.CreateAnonymousThread(
procedure()
begin
Sleep(3000);
end).Start();
jo := SO();
jo.S['BindId'] := Context.Binding.ID.ToString;
FResponses.OkWithJson(jo.AsJSon(false, false));
end;
In some time later i want to check if job is done or what is progress?
lets say i tried to do this that way
procedure TRPSystem.PingContext(aId: string);
var
jo: ISuperObject;
i: integer;
r: boolean;
someProgress: string;
begin
with GetMain.Server.Contexts.LockList() do
try
for i := 0 to Count - 1 do
if TIdContext(Items[i]).Binding.ID = aId.ToInteger then
begin
someProgress := '10 %'; // take progress param from my thread
r := true;
Break;
end;
finally
GetMain.Server.Contexts.UnlockList();
end;
if r then
begin
jo := SO;
jo.I['progress'] := someProgress;
FResponses.OkWithJson(jo.AsJSon(false, false));
end;
end;
Is that correct approach or better use another one ?
I'm developing application that is using Mifare Classic 1K card and HID Omnikey 5421 (successor of 5321). I using thread to detect card remove/insert.
Delphi code (thread method):
function CardWatcherThread(PContext: Pointer): integer;
var
RetVar : cardinal;
RContext : cardinal;
RStates : array[0..0] of SCARD_READERSTATEA;
begin
try
RContext := Cardinal(PContext^);
FillChar(RStates,SizeOf(RStates),#0);
RStates[0].szReader := SelectedReader;
RStates[0].pvUserData := nil;
RStates[0].dwCurrentState := SCARD_STATE_UNAWARE;
while ReaderOpen and (not Application.Terminated) do begin
RetVar := SCardGetStatusChange(RContext, MAX_WAIT_TIME_SCARDSTATUSCHANGE, #RStates, 1);
RStates[0].dwCurrentState := RStates[0].dwEventState;
ActReaderState := RStates[0].dwEventState;
// Avoid sedning error about timemout if MAX_WAIT_TIME_SCARDSTATUSCHANGE is not infinite
if (RetVar <> SCARD_E_TIMEOUT) or (MAX_WAIT_TIME_SCARDSTATUSCHANGE = -1) then begin
SendMessage(NotifyHandle, WM_CARDSTATE, RetVar, 0);
end;
end;
finally
Result := 0;
end;
end;
I'm using SendMessage to notify my Smart Card class where I'm detecting proper state. Also I automatically connect and read data from smart card when I detect card insertion.
My application is working correctly for most of the time, but sometimes for e.g. once in the 10000 of card insertion I'm getting SCARD_F_INTERNAL_ERROR from SCardGetStatusChange. When this happen SCardGetStatusChange is starting to result only SCARD_F_INTERNAL_ERROR all the time. When I detected this situation I tried to SCardCancel and SCardReleaseContext, end thread and establish new context and create new watcher thread with this new context but this is not helping because SCardGetStatusChange was continue to returning SCARD_F_INTERNAL_ERROR. Only when I close application and run again problem disappears.
It's happening randomly for me, I can't reproduce it using some known scenario. In PC can be more readers, but I'm establishing connection only to Omnikey 5421.
Someone met with this problem?
It's hard to say what goes wrong but I have few remarks about your code, hope they help...
you should check the return value of the SCardGetStatusChange as the first thing and if it is SCARD_E_TIMEOUT then just skip all the processing and start next cycle;
instead of just RStates[0].dwCurrentState := RStates[0].dwEventState; you also have to clear out the SCARD_STATE_CHANGED bit from the state (that is, if the state actually changed);
it is my understanding that the resource manager context might become invalid, so before calling SCardGetStatusChange use SCardIsValidContext to make sure you still have good context, if not acquire new one;
So try something like this (this is typed to the browser, so untestead and probably wont compile as is):
function CardWatcherThread(PContext: Pointer): integer;
var
RetVar : cardinal;
RContext : cardinal;
RStates : array[0..0] of SCARD_READERSTATEA;
begin
try
RContext := Cardinal(PContext^);
FillChar(RStates,SizeOf(RStates),#0);
RStates[0].szReader := SelectedReader;
RStates[0].pvUserData := nil;
RStates[0].dwCurrentState := SCARD_STATE_UNAWARE;
while ReaderOpen and (not Application.Terminated) do begin
if(SCardIsValidContext(RContext) <> SCARD_S_SUCCESS)then begin
RetVal := SCardEstablishContext(...);
end;
RetVar := SCardGetStatusChange(RContext, MAX_WAIT_TIME_SCARDSTATUSCHANGE, #RStates, 1);
case RetVal of
SCARD_E_TIMEOUT:;
SCARD_S_SUCCESS: begin
if((RStates[0].dwEventState and SCARD_STATE_CHANGED) <> 0)then begin
RStates[0].dwCurrentState := RStates[0].dwEventState xor SCARD_STATE_CHANGED;
// reader's state changed, do something
end;
end;
end;
end;
finally
Result := 0;
end;
end;
I use Delphi 7 and my project has several non modal visible forms. The problem is if in one of them MessageBoxEx is called all actions of the application are not updated until MessageBoxEx’s form is closed. In my project it can broke business logic of application.
The TApplication.HandleMessage method is never called while MessageBoxEx's window is shown so it doesn’t call the DoActionIdle and Actions are not updated.
I think what I need is to catch a state of my application when it’s idle and update states of all actions.
First I implemented TApplication. OnIdle handler:
procedure TKernel.OnIdle(Sender: TObject; var Done: Boolean);
begin
{It’s only to switch off the standard updating from TApplication.Idle. It's to make the CPU usage lower while MessageBoxEx's window isn't shown }
Done := False;
end;
implementation
var
MsgHook: HHOOK;
{Here is a hook}
function GetMsgHook(nCode: Integer; wParam: Longint; var Msg: TMsg): Longint; stdcall;
var
m: TMsg;
begin
Result := CallNextHookEx(MsgHook, nCode, wParam, Longint(#Msg));
if (nCode >= 0) and (_instance <> nil) then
begin
{If there aren’t the messages in the application's message queue then the application is in idle state.}
if not PeekMessage(m, 0, 0, 0, PM_NOREMOVE) then
begin
_instance.DoActionIdle;
WaitMessage;
end;
end;
end;
initialization
MsgHook := SetWindowsHookEx(WH_GETMESSAGE, #GetMsgHook, 0, GetCurrentThreadID);
finalization
if MsgHook <> 0 then
UnhookWindowsHookEx(MsgHook);
Here is a method for updating states of all actions of the application. It’s just a modified version of TApplication.DoActionIdle:
type
TCustomFormAccess = class(TCustomForm);
procedure TKernel.DoActionIdle;
var
i: Integer;
begin
for I := 0 to Screen.CustomFormCount - 1 do
with Screen.CustomForms[i] do
if HandleAllocated and IsWindowVisible(Handle) and
IsWindowEnabled(Handle) then
TCustomFormAccess(Screen.CustomForms[i]).UpdateActions;
end;
It seems that the updating of the states happens much often than usually (I’m going to find out where is a problem using profiler).
Besides, CPU usage grows seriously when the mouse’s cursor is not over the application’s windows (about 25% on my DualCore Pentium).
What do you think about my problem and the way I try to solve it? Is it a good idea to use hooks or there is a better way to catch the application idle state? Do I rather need to use WH_CALLWNDPROCRET during setting the hook?
Why MessageBoxEx blocks TApplication.HandleMessage? Is there way to prevent this behavior? I’ve tried to call it with MB_APPLMODAL, MB_SYSTEMMODAL, MB_TASKMODAL flags but it didn’t help.
MessageBox/Ex() is a modal dialog, and as such it runs its own message loop internally since the calling thread's normal message loop is blocked. MessageBox/Ex() receives any messages that are in the calling thread's message queue, and will dispatch them to target windows normally (so things like window-based timers still work, such as TTimer), but its modal message loop has no concept of VCL-specific messages, like action upates, and will discard them. TApplication.HandleMessage() is only called by the main VCL message loop, the TApplication.ProcessMessages() method, and the TForm.ShowModal() method (this is why modal VCL Form windows do not suffer from this problem), none of which are called while MessageBox/Ex() is running (the same will be true for any OS modal dialog).
To solve your problem, you have a couple of choices:
set a thread-local message hook via SetWindowsHookEx() right before calling MessageBox/Ex(), then release the hook right after MessageBox/Ex() exits. This allows you to look at every message that MessageBox/Ex() receives and dispatch them to VCL handlers as needed. DO NOT call PeekMessage(), GetMessage() or WaitMessage() inside of a message hook!
type
TApplicationAccess = class(TApplication)
end;
function GetMsgHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
Msg: TMsg;
begin
if (nCode >= 0) and (wParam = PM_REMOVE) then
begin
Msg := PMsg(lParam)^;
with TApplicationAccess(Application) do begin
if (not IsPreProcessMessage(Msg))
and (not IsHintMsg(Msg))
and (not IsMDIMsg(Msg))
and (not IsKeyMsg(Msg))
and (not IsDlgMsg(Msg)) then
begin
end;
end;
end;
Result := CallNextHookEx(MsgHook, nCode, wParam, lParam);
end;
function DoMessageBoxEx(...): Integer;
var
MsgHook: HHOOK;
begin
MsgHook := SetWindowsHookEx(WH_GETMESSAGE, #GetMsgHook, 0, GetCurrentThreadID);
Result := MessageBoxEx(...);
if MsgHook <> 0 then UnhookWindowsHookEx(MsgHook);
end;
move the MessageBox/Ex() call to a separate worker thread so the calling thread is free to process messages normally. If you need to wait for the result of MessageBox/Ex(), such as when prompting the user for input, then you can use MsgWaitForMultipleObjects() to wait for the thread to terminate while allowing the waiting thread to call Application.ProcessMessages() whenever there are pending messages to process.
type
TMessageBoxThread = class(TThread)
protected
procedure Execute; override;
...
public
constructor Create(...);
end;
constructor TMessageBoxThread.Create(...);
begin
inherited Create(False);
...
end;
function TMessageBoxThread.Execute;
begin
ReturnValue := MessageBoxEx(...);
end;
function DoMessageBoxEx(...): Integer;
var
Thread: TMessageBoxThread;
WaitResult: DWORD;
begin
Thread := TMessageBoxThread.Create(...);
try
repeat
WaitResult := MsgWaitForMultipleObjects(1, Thread.Handle, False, INFINITE, QS_ALLINPUT);
if WaitResult = WAIT_FAILED then RaiseLastOSError;
if WaitResult = WAIT_OBJECT_0 + 1 then Application.ProcessMessages;
until WaitResult = WAIT_OBJECT_0;
Result := Thread.ReturnVal;
finally
Thread.Free;
end;
end;
I hope this post is not a duplicate one. Let me explain:
I have considered the similar post How to pause / resume any external process under Windows? but with C++/Python preference and yet without an accepted answer as of the time of posting.
My Question:
I'm interested in a possible implementation in Delphi of the functionality provided by PsSuspend by Mark Russinovich of Windows Sysinternals.
Quotes:
PsSuspend lets you suspend processes on the local or a remote system,
which is desirable in cases where a process is consuming a resource
(e.g. network, CPU or disk) that you want to allow different processes
to use. Rather than kill the process that's consuming the resource,
suspending permits you to let it continue operation at some later
point in time.
Thank you.
Edit:
A partial implementation will do. Remote capability can be dropped.
You can try to use the following code. It uses the undocumented functions NtSuspendProcess and NtResumeProcess. I've tried it on Windows 7 64-bit from the 32-bit application built in Delphi 2009 and it works for me. Note that these functions are undocumented thus can be removed from future versions of Windows.
Update
The SuspendProcess and ResumeProcess wrappers from the following code are now functions and returns True if succeed, False otherwise.
type
NTSTATUS = LongInt;
TProcFunction = function(ProcHandle: THandle): NTSTATUS; stdcall;
const
STATUS_SUCCESS = $00000000;
PROCESS_SUSPEND_RESUME = $0800;
function SuspendProcess(const PID: DWORD): Boolean;
var
LibHandle: THandle;
ProcHandle: THandle;
NtSuspendProcess: TProcFunction;
begin
Result := False;
LibHandle := SafeLoadLibrary('ntdll.dll');
if LibHandle <> 0 then
try
#NtSuspendProcess := GetProcAddress(LibHandle, 'NtSuspendProcess');
if #NtSuspendProcess <> nil then
begin
ProcHandle := OpenProcess(PROCESS_SUSPEND_RESUME, False, PID);
if ProcHandle <> 0 then
try
Result := NtSuspendProcess(ProcHandle) = STATUS_SUCCESS;
finally
CloseHandle(ProcHandle);
end;
end;
finally
FreeLibrary(LibHandle);
end;
end;
function ResumeProcess(const PID: DWORD): Boolean;
var
LibHandle: THandle;
ProcHandle: THandle;
NtResumeProcess: TProcFunction;
begin
Result := False;
LibHandle := SafeLoadLibrary('ntdll.dll');
if LibHandle <> 0 then
try
#NtResumeProcess := GetProcAddress(LibHandle, 'NtResumeProcess');
if #NtResumeProcess <> nil then
begin
ProcHandle := OpenProcess(PROCESS_SUSPEND_RESUME, False, PID);
if ProcHandle <> 0 then
try
Result := NtResumeProcess(ProcHandle) = STATUS_SUCCESS;
finally
CloseHandle(ProcHandle);
end;
end;
finally
FreeLibrary(LibHandle);
end;
end;
There is no SuspendProcess API call in Windows. So what you need to do is:
Enumerate all the threads in the process. See RRUZ's answer for sample code.
Call SuspendThread for each of these threads.
In order to implement the resume part of the program, call ResumeThread for each thread.
There is a race condition for the "suspend all threads" implementation - what happens if the program you are trying to suspend creates one or more threads between the time that you create the snapshot and the time that you complete suspending?
You could loop, getting another snapshot and suspending any unsuspending threads, exiting only when you found none.
The undocumented function avoids this issue.
I just found the following snippets here (Author: steve10120).
I think they are valuables and I can't help posting them also as an alternative answer to my own question.
Resume Process:
function ResumeProcess(ProcessID: DWORD): Boolean;
var
Snapshot,cThr: DWORD;
ThrHandle: THandle;
Thread:TThreadEntry32;
begin
Result := False;
cThr := GetCurrentThreadId;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if Snapshot <> INVALID_HANDLE_VALUE then
begin
Thread.dwSize := SizeOf(TThreadEntry32);
if Thread32First(Snapshot, Thread) then
repeat
if (Thread.th32ThreadID <> cThr) and (Thread.th32OwnerProcessID = ProcessID) then
begin
ThrHandle := OpenThread(THREAD_ALL_ACCESS, false, Thread.th32ThreadID);
if ThrHandle = 0 then Exit;
ResumeThread(ThrHandle);
CloseHandle(ThrHandle);
end;
until not Thread32Next(Snapshot, Thread);
Result := CloseHandle(Snapshot);
end;
end;
Suspend Process:
function SuspendProcess(PID:DWORD):Boolean;
var
hSnap: THandle;
THR32: THREADENTRY32;
hOpen: THandle;
begin
Result := FALSE;
hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if hSnap <> INVALID_HANDLE_VALUE then
begin
THR32.dwSize := SizeOf(THR32);
Thread32First(hSnap, THR32);
repeat
if THR32.th32OwnerProcessID = PID then
begin
hOpen := OpenThread($0002, FALSE, THR32.th32ThreadID);
if hOpen <> INVALID_HANDLE_VALUE then
begin
Result := TRUE;
SuspendThread(hOpen);
CloseHandle(hOpen);
end;
end;
until Thread32Next(hSnap, THR32) = FALSE;
CloseHandle(hSnap);
end;
end;
Disclaimer:
I didn't test them at all. Please enjoy and don't forget to feedback.
Is it possible to get Delphi to close a ShowMessage or MessageDlg Dialog after a certain length of time?
I want to show a message to the user when the application is shut down, but do not want to stop the application from shutting down for more than 10 seconds or so.
Can I get the default dialog to close after a defined time, or will I need to write my own form?
Your application is actually still working while a modal dialog or system message box or similar is active (or while a menu is open), it's just that a secondary message loop is running which processes all messages - all messages sent or posted to it, and it will synthesize (and process) WM_TIMER and WM_PAINT messages when necessary as well.
So there's no need to create a thread or jump through any other hoops, you simply need to schedule the code that closes the message box to be run after those 10 seconds have elapsed. A simple way to do that is to call SetTimer() without a target HWND, but a callback function:
procedure CloseMessageBox(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR;
ATicks: DWORD); stdcall;
var
Wnd: HWND;
begin
KillTimer(AWnd, AIDEvent);
// active window of the calling thread should be the message box
Wnd := GetActiveWindow;
if IsWindow(Wnd) then
PostMessage(Wnd, WM_CLOSE, 0, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TimerId: UINT_PTR;
begin
TimerId := SetTimer(0, 0, 10 * 1000, #CloseMessageBox);
Application.MessageBox('Will auto-close after 10 seconds...', nil);
// prevent timer callback if user already closed the message box
KillTimer(0, TimerId);
end;
Error handling ommitted, but this should get you started.
You can try to do it with a standard Message dialog. Create the dialog with CreateMessageDialog procedure from Dialogs and after add the controls that you need.
In a form with a TButton define onClick with this:
procedure TForm1.Button1Click(Sender: TObject);
var
tim:TTimer;
begin
// create the message
AMsgDialog := CreateMessageDialog('This is a test message.',mtWarning, [mbYes, mbNo]) ;
lbl := TLabel.Create(AMsgDialog) ;
tim := TTimer.Create(AMsgDialog);
counter := 0;
// Define and adding components
with AMsgDialog do
try
Caption := 'Dialog Title' ;
Height := 169;
// Label
lbl.Parent := AMsgDialog;
lbl.Caption := 'Counting...';
lbl.Top := 121;
lbl.Left := 8;
// Timer
tim.Interval := 400;
tim.OnTimer := myOnTimer;
tim.Enabled := true;
// result of Dialog
if (ShowModal = ID_YES) then begin
Button1.Caption := 'Press YES';
end
else begin
Button1.Caption := 'Press NO';
end;
finally
Free;
end;
end;
An the OnTimer property like this:
procedure TForm1.MyOnTimer(Sender: TObject);
begin
inc(counter);
lbl.Caption := 'Counting: ' + IntToStr(counter);
if (counter >= 5) then begin
AMsgDialog.Close;
end;
end;
Define the variables and procedure:
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
AMsgDialog: TForm;
lbl:TLabel;
counter:integer;
procedure MyOnTimer(Sender: TObject);
end;
And test it.
The form close automatically when the timer final the CountDown. Similar this you can add other type of components.
Regards.
Try this:
function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): integer;
stdcall; external user32 name 'MessageBoxTimeoutA';
I've been using this for quite some time; it works a treat.
OK. You have 2 choices:
1 - You can create your own MessageDialog form. Then, you can use it and add a TTimer that will close the form when you want.
2 - You can keep using showmessage and create a thread that will use FindWindow (to find the messadialog window) and then close it.
I recommend you to use you own Form with a timer on it. Its cleaner and easier.
This works fine with windows 98 and newers...
I don't use the " MessageBoxTimeOut" because old windows 98, ME, doesn't have it...
this new function works like a "CHARM"..
//add this procedure
procedure DialogBoxAutoClose(const ACaption, APrompt: string; DuracaoEmSegundos: Integer);
var
Form: TForm;
Prompt: TLabel;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
nX, Lines: Integer;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
begin
Form := TForm.Create(Application);
Lines := 0;
For nX := 1 to Length(APrompt) do
if APrompt[nX]=#13 then Inc(Lines);
with Form do
try
Font.Name:='Arial'; //mcg
Font.Size:=10; //mcg
Font.Style:=[fsBold];
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
//BorderStyle := bsDialog;
BorderStyle := bsToolWindow;
FormStyle := fsStayOnTop;
BorderIcons := [];
Caption := ACaption;
ClientWidth := MulDiv(Screen.Width div 4, DialogUnits.X, 4);
ClientHeight := MulDiv(23 + (Lines*10), DialogUnits.Y, 8);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
AutoSize := True;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Caption := APrompt;
end;
Form.Width:=Prompt.Width+Prompt.Left+50; //mcg fix
Show;
Application.ProcessMessages;
finally
Sleep(DuracaoEmSegundos*1000);
Form.Free;
end;
end;
////////////////////////////How Call It//////////////////
DialogBoxAutoClose('Alert'', "This message will be closed in 10 seconds',10);
/////////////////////////////////////////////////////////
MessageBox calls this function internally and pass 0xFFFFFFFF as timeout parameter, so the probability of it being removed is minimal (thanks to Maurizio for that)
I thought about using a separate thread, but it's probably going to get you into a lot of unnecessary code etc. Windows dialogs were simply not made for this thing.
You should do your own form. On the good side, you can have custom code/UI with a countdown like timed dialog boxes do.
No. ShowMessage and MessageDlg are both modal windows, which means that your application is basically suspended while they're displayed.
You can design your own replacement dialog that has a timer on it. In the FormShow event, enable the timer, and in the FormClose event disable it. In the OnTimer event, disable the timer and then close the form itself.
You can hook up the Screen.OnActiveFormChange event and use Screen.ActiveCustomForm if it is a interested form that you want to hook up the timer to close it
{code}
procedure abz.ActiveFormChange(Sender: TObject);
var
Timer: TTimer;
begin
if (Screen.ActiveCutomForm <> nil) and //valid form
(Screen.ActiveCutomForm.Tag = 0) and //not attached a timer yet
(Screen.ActiveCutomForm.ClassName = 'TMessageForm') //any interested form type check
then
begin
Timer := TTimer.Create(Screen.ActiveCutomForm); // let the form owned so it will be freed
Timer.Enabled := False;
Timer.Tag := Integer(Screen.ActiveCutomForm); // keep track to be used in timer event
.... setup any timer interval + event
Screen.ActiveCutomForm.Tag := Integer(Timer);
Timer.Enabled := True;
end;
end;
{code}
enjoy
Best way is to use a stayontop form and manage a counter to disappear using the alfpha blend property of the form, at the end of the count just close the form, but
the control will be passed to the active control needed before showing the form, this way, user will have a message which disappears automatically and wont prevent the usage of the next feature, very cool trick for me.
You can do this with WTSSendMessage.
You can find this in the JWA libraries, or call it yourself.