This question already has answers here:
Closed 11 years ago.
Possible Duplicate:
Delphi Timer: Time before next event
How to get current timeleft when timer will be executed ?
for example:
I create a timer with interval 60 000
procedure TForm1.my_Timer(Sender: TObject);
begin
// do something
end;
Then I create another timer (interval 1000) which reason is to get the timeleft of the first timer
procedure TForm1.second_Timer(Sender: TObject);
begin
second_Timer.Interval := 1000;
Label1.Caption := IntToStr(my_Timer.timeleft); // How ???
end;
Thanks.
You can't get this information from the timer. The best you can do is make a note of when the timer last fired and work it out for yourself. For example you can use TStopwatch to do this.
TTimer itself does not have have this capability. One option would be to use the tag property of the first timer to store the remaining time like so:
procedure TForm1.MyTimerTimer(Sender: TObject);
begin
MyTimer.Tag := MyTimer.Interval;
// Do something
end;
procedure TForm1.Second_TimerTimer(Sender: TObject);
begin
MyTimer.Tag := MyTimer.Tag - Second_Timer.Interval;
Label1.Caption := 'Time Left '+IntToStr(MyTimer.Tag);
end;
Just created my hack way, I'm using two global vars
var
my_timer_interval_hack : integer;
my_timer_timeleft_hack : integer;
procedure TForm1.my_Timer(Sender: TObject);
begin
// do something
// hack, reset timer TimeLeft
my_timer_timeleft_hack := my_Timer.Interval;
end;
procedure TForm1.second_Timer(Sender: TObject);
begin
second_Timer.Interval := 1000;
// hack get timeleft from my_timer
my_timer_timeleft_hack := my_timer_timeleft_hack - 1000;
if my_timer_timeleft_hack <= 0 then
my_timer_timeleft_hack := my_timer.Interval;
Label1.Caption := IntToStr(my_timer_timeleft_hack);
end;
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 ?
How would I be able to do a continuous action while a button is held down? For example, I have made a custom 'Numpad' for my application, which has a Delete button. As of right now, I have to click it separately, but I want it to keep deleting while it is held down.
procedure TFrame1.deleteClick(Sender: TObject);
var
MiString: string;
begin
global_gotten_mode := precheck.global_edit_mode;
precheck.Form2.input_field.SetFocus;
MiString := Copy(precheck.Form2.input_field.Text, 0, (length(precheck.Form2.input_field.Text) - 1));
precheck.Form2.input_field.Text := MiString;
Form2.input_field.SelStart := high(integer);
end;
Add a timer and activate it on the OnMouseDown event.
As long as the button is held down, the timer will kick in at a rate of your choice.
When the button is released, the OnMouseUp event disables the timer.
Something in this way:
procedure TFrame1.BtnMouseDown(Sender : TObject);
begin
global_gotten_mode := precheck.global_edit_mode;
precheck.Form2.input_field.SetFocus;
fMyBtnTimer.Interval := 500; // Initial repetition rate
fMyBtnTimer.Enabled := true;
end;
procedure TFrame1.BtnMouseUp(Sender : TObject);
begin
fMyBtnTimer.Enabled := false;
end;
procedure TFrame1.MyBtnTimerEvent(Sender : TObject);
var
MiString: string;
begin
fMyBtnTimer.Interval := 200; // Increase repetition rate
MiString := Copy( precheck.Form2.input_field.Text,
0,
length(precheck.Form2.input_field.Text) - 1);
precheck.Form2.input_field.Text := MiString;
Form2.input_field.SelStart := high(integer);
end;
I am trying to make a countdown timer, the idea is to set the time in text edit property and after i click set timer(button), that time to be sent to Label, which will then start the countdown to 0. I have gotten to this part, but i cant figure out a way to make seconds countdown, If any of you guys can help I would appreciate it.
I tried this from an example I found online but it didnt work because this is Firemonkey application.
dec(TotalTime); {decrement the total time counter}
// Timer code..
procedure TForm1.ButtonSetTimerClick(Sender: TObject);
var
GetTime : TDateTime;
begin
Timer3.Enabled := True;
Label11.Text := Edit1.Text;
ButtonSetTimer.Enabled := False;
Edit1.Enabled := False;
GetTime := StrToTime(Edit1.Text);
end;
procedure TForm1.ButtonStopTimerClick(Sender: TObject);
begin
Timer3.Enabled := False;
ButtonSetTimer.Enabled := True;
Edit1.Enabled := True;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
var
GetTime : TDateTime;
Hour, Min, Sec, MSec: Word;
begin
DecodeTime(GetTime, Hour, Min, Sec, Msec);
Label11.Text := TimeToStr(GetTime);
Label11.Text := IntToStr(Hour) + ':'+ IntToStr(Min) + ':'+ IntToStr(Sec);
Label11.Text := Format('%2.2u:%2.2u:%2.2u',[Hour,Min,Sec]);
end;
Cheers.
You did not say how (in which format) the time is to be entered in the TEdit, so here are three alternative time entry possibilities. The output is anyway formatted as H:M:S.
I modified the code from yesterday to use TryStrToInt / TryStrToTime to catch errors. Also, a Seconds counter together with OnTimer event as in my previous example has a poor accuracy and can drift several seconds within 5 minutes. Edijs solution to compare Now with a calculated end time is insensitive to the inaccuracy of OnTimer events, so I adopted that too.
var
TimeOut: TDateTime;
function SecsToHmsStr(ASecs: integer):string;
begin
Result := Format('%2d:%2.2d:%2.2d',
[ASecs div 3600, ASecs mod 3600 div 60, ASecs mod 3600 mod 60]);
;end;
procedure TForm6.Timer1Timer(Sender: TObject);
begin
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
if Now > Timeout then Timer1.Enabled := False;
end;
Time entry alternative one, Timeout after a given number of seconds
// Timeout after a given number of seconds
procedure TForm6.Button1Click(Sender: TObject);
var
Seconds: integer;
begin
if TryStrToInt(Edit1.Text, Seconds) then
begin
TimeOut := IncSecond(Now, Seconds);
Timer1.Enabled := True;
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
end
else
ShowMessage('Error in number of seconds');
end;
Time entry alternative two, Timeout after a given number of hours, minutes and seconds
// Timeout after a given number of hours, minutes and seconds
procedure TForm6.Button2Click(Sender: TObject);
begin
if TryStrToTime(Edit1.Text, TimeOut) then
begin
TimeOut := Now + TimeOut;
Timer1.Enabled := True;
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
end
else
ShowMessage('Error in time format');
end;
Time entry alternative three, Timeout at a given time within 24 hours
// Timeout at a given time within 24 hours
procedure TForm6.Button3Click(Sender: TObject);
begin
if TryStrToTime(Edit1.Text, TimeOut) then
begin
if TimeOut <= Time then
TimeOut := Tomorrow + TimeOut
else
TimeOut := Today + TimeOut;
Timer1.Enabled := True;
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
end
else
ShowMessage('Error in time format');
end;
This should do it:
Uses
System.DateUtils;
type
..
private
FDateTimeTo: TDateTime;
end;
function IntToTimeStr(const ASeconds: Int64): string;
begin
Result := Format('%2d:%2.2d:%2.2d', [ASeconds div 3600, ASeconds mod 3600 div 60,
ASeconds mod 3600 mod 60]);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
FDateTimeTo := StrToDateTime(FormatDateTime('yyyy' + FormatSettings.DateSeparator + 'mm' +
FormatSettings.DateSeparator + 'dd 00:00:00', Now)) + StrToTime(Edit1.Text);
if CompareDateTime(Now, FDateTimeTo) = 1 then
FDateTimeTo := IncDay(FDateTimeTo);
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
Label1.Caption := IntToTimeStr(SecondsBetween(Now, FDateTimeTo));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i : integer;
begin
if i > StrToInt(Edit1.Text) then
Timer1.Enabled := False
else
i :=+ 1;
SendClick(645,302);
Sleep(2200);
SendClick(694,619);
Sleep(2200);
SendClick(967,638);
Sleep(2200);
SendKeys('{BKSP}{BKSP}{BKSP}{BKSP}1',False);
SendClick(917,688);
Sleep(2200);
SendClick(917,688);
Sleep(2200);
SendClick(917,688);
amount := StrToInt(Label3.Caption) + 1;
Label3.Caption := IntToStr(amount);
end;
for some reason it repeats only 1 time and stops... can anyone spot a problem? im pretty tired and ive went over and over it a few times and i can't seem to see one...
I is a uninitialized local variable (it contains garbage), so the result of the comparision if i > StrToInt(Edit1.Text) is random.
You may want to add a member variable to your form's class, initialize at the proper time and check it's value on the onTimer event, something like:
type
TForm1 = class(TForm)
..
private
FTimerCount: Integer;
FMaxTimerCount: Integer;
..
procedure TForm1.Button1Click(Sender: TObject);
begin
FTimerCount := 0;
FMaxTimerCount := 20; //the timer will fire 20 times.
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc(FTimerCount);
Timer1.Enabled := FTimerCount < FMaxTimerCount;
DoOtherStuff();
end;
The line
i :=+ 1;
assigns the value +1 (also known as 1) to the variable named i. (That is, if i is equal to 55, and you do i :=+ 1, then i will be equal to 1.)
Perhaps you are seeking
i := i + 1;
or
inc(i);
?
You're not initializing i, it is a local variable. Hence the timer can be enabled or not depending on the arbitrary value it's memory location holds.
This is a well case that people just ignore the Warning message.
I wish that compiler should spit out Hint or Error and No Warning. Warning is just a case that short comming from compiler and it should be fixed at later version.
Cheers
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.