Evento Ontimer

[kmkg]

Pessoal, alguém já conseguiu criar um TTimer em tempo de execução e fazer seu evento onTimer funcionar ?

Essa tá difícil :angry:

[Micheus]

kmkg, o código abaixo cria o timer ao clicar num botão, com temporização de 3 seg. Ao clicar no botão uma vez, o timer é criado (e já está habilitado), clicando outra vez, ele é eliminado (e já estará desabilitado). Seria este o problema?

type
  TForm1 = class(TForm)
    ...
  private
    DinamicTime :TTimer;
    procedure TickOfTimer(Sender: TObject);
  public
    { Public declarations }
  end;
...
procedure TForm1.TickOfTimer(Sender: TObject);
begin
  Label3.Caption := TimeToStr(Time);
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  if not Assigned(DinamicTime) then
  begin
    DinamicTime := TTimer.Create(Self);
    DinamicTime.Interval := 3000;
    DinamicTime.OnTimer := TickOfTimer;
  end else
  begin
    DinamicTime.Free;
    DinamicTime := nil;
  end;
end;

[kmkg]

Olá Micheus, obrigado por responder.

O problema não é bem este e me desculpe por esquecer de mencionar no tópico original.

O problema é que não existe Form e ele tem que ser criado numa função de um objeto e seu evento onTimer nunca é disparado.

[Churc]

opa

procure em msdn.microsoft.com por

SetTimer KillTimer

Essas são as APIs que um componente TTimer utiliza...

se não conseguir eu te dou uma ajuda, é que estou no trabalho fica difícil fazer aqui mas em casa eu tenho um projeto que mexi com isso

abraços

[Thales Pontes Martins]

O componente Timer faz desse jeito, adaptado para o seu objeto->

SeuObjeto = Class(TObject)
private
  FWHandle : HWND;
  Procedure WndProc(var msg : TMessage);
.
.

Procedure SeuObjeto.CreateTimer;
begin
  FWHandle := Classes.AllocateHWnd(WndProc); 
  SetTimer(FWHandle, 1, Interval, nil); 
end;

procedure SeuObjeto.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then (Faça Alguma Coisa) 
end;

Procedure SeuObjeto.DestroyTimer;
begin
  KillTimer(FWHandle, 1); 
  FWHandle := Classes.DeallocateHWnd(FWHandle); 
end;

[kmkg]

Assim acho que deverá funcionar, testei SetTimer sem Handle e funcionou pelo Callback, agora quero ver se funciona numa dll sem ter que criar um objeto para isso, assim ficará uma única rotina.

[Thales Pontes Martins]

você está querendo dizer que não quer criar uma janela para isso?

Porque a função AllocateHWnd cria uma janela não visual para receber as mensagems de Timer e recebe como parametro a procedure que Lida com as mensagems recebidas. Agora, sem criar as janelas eu não sei se é possivel.

Quando eu quero fazer um Timer com um form eu faço assim->

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
    count : cardinal;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  KillTimer(Handle,1);
  //KillTimer(Handle da Janela, Identificador do Timer);
end;

//Aqui é o procedimento do Timer, coloque o que quiser nele
procedure Timer(Hwnd, msg, id, tick : integer); stdcall;
begin
  inc(form1.count);
  form1.caption:=inttostr(form1.count);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  SetTimer(handle,1,1000,@Timer);
  //SetTimer(Handle da janela, Identificador do timer, Intervalo, Procedimento);
end;

Funciona legal, mas se não passar nenhum handle pra SetTimer eu não sei se dá certo, teria que criar a janela não visual lá com AllocateHWnd.

Interessante é que se eu não colocar stdcall ele chama 2 vezes o procedimento a cada TimeOut. Não sei porque.

[kmkg]

Sem Handle dá para criar utilizando o último parâmetro de SetTimer que é o ponteiro para a procedure de Callback. Comigo também essa procedure é executada 2 vezes, mas somente uma vez com a msg WM_Timer.

[Thales Pontes Martins]

ah, então é só colocar if (msg = WM_TIMER) then...............

Mas mesmo assim, como é o Windows que vai chamar o procedimento, é melhor colocar stdcall só pra prevenir. Estranho né?

Mas então o seu problema foi completamente resolvido? Funcionou?

[kmkg]

O Windows chama pela informação do Callback.

Agora tenho que testar se funciona em dll.

[Guest MAx Almeida]

Ola amigos,

Vi que vocês chegaram na solução deste problema.

Mas ainda não conseguir utilizar o ttmier em uma aplicação que não tenha formularios.

Na verdade estou querendo adicionar um ttmier dentro de uma classe minha que herda de TServerClientThread. já implementei de tudo quanto é jeito mas o evento ontimer não roda de jeito nenhum. Implementei os exemplos abaixo mas o set timer parece so funcionar com handle form.

Vi que o amigo kmkg encontrou a solução utilizando o Callback.

Sera que alguém pode postar o codigo exemplo ?

Obrigado.

[Max Almeida]

Callback com TTimer ???? Como uso isso ?? alguém pode ajudar?

[kmkg]

Olá, defina a callback:

procedure Timer_Proc(H:Thandle; Msg,Event,Time:DWord); stdcall;
begin
  if Msg = WM_Timer then
    {evento onTimer}
end;

Depois para ativar o Timer:

  SetTimer(0, 1, 3000, @Timer_Proc); // Executa a cada 3 segundos

[Thales Pontes Martins]

Quero deixar claro que só mencionei as funções de CALLBACK aqui a título de curiosidade, e que o componente TTimer funciona perfeitamente bem dentro de componentes, utilizo ele e sempre funcionou. vocês é que devem estar fazendo alguma coisa errada. Vejam um exemplo->

  T3dQueen = Class(TComponent)
  public
    List : TDragOperation;
    bm : TBitmap;
    _owner : TForm;
    PosInc, hinc, vinc : Double;
    Sub, Dir : boolean;
    x, y : Double;
    cam : TCamera;
    rect : TRect;
    q3 : TPolQueen;
    sort : TSort;
    pol4 : T4pol2d;
    pol3 : T3pol2d;
    light : double;
    hue : word;
    lum : double;
    sat, hc, speed, randh, randv : double;
    divisor, dividendo : cardinal;
    _Timer : TTimer;
    constructor Create(AOwner: TForm; src : TCanvas = nil);
    destructor Destroy; override;
    procedure Timer(Sender : TObject); 
    procedure DrawQueen;
    procedure RandomCam;
    procedure UpCam;
  end;

implementation


constructor T3dQueen.Create(AOwner: TForm; src : TCanvas = nil);
begin
  inherited Create(AOwner);
  Randomize;
  _owner:=AOwner;
  bm:=TBitmap.Create;
  bm.Height:=134;
  bm.Width:=134;
  rect.Top:=0;
  rect.Left:=0;
  rect.Right:=133;
  rect.Bottom:=133;
  bm.Canvas.FillRect(rect);
  List:=TDragOperation.CreateTransparent(bm);
  PosInc:=1;
  dir:=true;
  sub:=false;
  x:=0; y:=0;
  cam.z:=0;
  sort:=InitSort;
  speed:=70;
  RandomCam;
  hue:=0;
  lum:=1.25;
  sat:=0;
  divisor:=180;
  dividendo:=180;
  hc:=2.4;
  if (src = nil) then
  List.TransparentBegin(trunc(x),trunc(y),_owner.Canvas, _owner.canvas) else
  List.TransparentBegin(trunc(x),trunc(y),_owner.Canvas, src);
  //I had to use Timer component because callback timer function seemed
  //not to work with object methods.
  _Timer:=TTimer.Create(self);
  _Timer.Interval:=16;
  _Timer.OnTimer:=Timer;
  _Timer.Enabled:=true;
end;


destructor T3dQueen.Destroy;
begin
  _Timer.Enabled:=false;
  _Timer.Destroy;
  List.EndDrag;
  List.Destroy;
  bm.Destroy;
  inherited destroy;
end;


procedure T3dQueen.Timer(Sender : TObject);
begin
  if (byte(getkeystate(VK_LEFT) ) > 120) then if (hue > 0) then dec(hue) else hue:=1535;
  if (byte(getkeystate(VK_RIGHT) ) > 120) then if (hue < 1535) then inc(hue) else hue:=0;

  if (byte(getkeystate(VK_UP) ) > 120) then if (lum < 2) then lum:=lum+0.01;
  if (byte(getkeystate(VK_DOWN) ) > 120) then if (lum > 0) then lum:=lum-0.01;

  if (byte(getkeystate(VK_NUMPAD4) ) > 120) then if (sat < 1) then sat:=sat+0.01;
  if (byte(getkeystate(VK_NUMPAD6) ) > 120) then if (sat > 0) then sat:=sat-0.01;

  if (byte(getkeystate(VK_LCONTROL) ) > 120) then if (divisor > 20) then dec(divisor);
  if (byte(getkeystate(VK_RCONTROL) ) > 120) then if (divisor < 800) then inc(divisor);

  if (byte(getkeystate(VK_LSHIFT) ) > 120) then if (dividendo > 20) then dec(dividendo);
  if (byte(getkeystate(VK_RSHIFT) ) > 120) then if (dividendo < 800) then inc(dividendo);

  if (byte(getkeystate(VK_NUMPAD2) ) > 120) then if (hc < 10) then hc:=hc+0.005;
  if (byte(getkeystate(VK_NUMPAD8) ) > 120) then if (hc > 0.5) then hc:=hc-0.005;

  if (byte(getkeystate(VK_NUMPAD9) ) > 120) then if (posinc < 15) then posinc:=posinc+0.02;
  if (byte(getkeystate(VK_NUMPAD7) ) > 120) then if (posinc > 0) then posinc:=posinc-0.02;

  if (byte(getkeystate(VK_NUMPAD1) ) > 120) then if (speed < 500) then begin speed:=speed+1; UpCam; end;
  if (byte(getkeystate(VK_NUMPAD3) ) > 120) then if (speed > 1) then begin speed:=speed-1; UpCam; end;

  if (sub) then y:=y-posinc else y:=y+posinc;
  if (dir) then x:=x+posinc else x:=x-posinc;
  if (trunc(x) <= -16) then
  begin
    dir:=true;
    RandomCam;
  end;
  if (trunc(y) <= -16) then
  begin
    sub:=false;
    RandomCam;
  end;
  if (trunc(x) >= _owner.Width-120) then
  begin
    dir:=false;
    RandomCam;
  end;
  if (trunc(y) >= _owner.Height-150) then
  begin
    sub:=true;
    RandomCam;
  end;
  cam.x:=cam.x+hinc;
  cam.y:=cam.y+vinc;
  if (cam.x > 2*pi) then cam.x:=modulus(cam.x,2*pi);
  if (cam.y > 2*pi) then cam.y:=modulus(cam.y,2*pi);
  DrawQueen;
  {if (_owner.showing) then}
  List.DragMove(trunc(x), trunc(y));
  //_owner.Caption:=floattostr(cam.x); //debug
end;

Esse código é fragmento de um componente real que eu escreví, e coloquei aqui com o intuito de demonstrar a utilização do TTimer dentro de um componente.

PS: Se o componente não for derivado de TComponent então pode-se usar o comando _Timer:=TTimer.Create(nil); para criar o Timer que funciona do mesmo jeito.

[Max Almeida]

Pessoal essa coisa está me deixando de cabelos brancos..

Olha só, implemetando da maneira a qual o Thales disse tudo funciona perfeitamente mas o evento Ontimer não executa de jeito nenhum. Porem implementando da forma que nosso amigo kmkg disse o evento so roda depois que minha thread finaliza. O que para a aplicação não importa mais pois tudo deve ser executado em tempo de execução da thread.

Vou esclarecer melhor a ideia do projeto.

Como disse estou implementando uma classe que herda de TServerClientThread conforme exemplo abaixo

CODE

TFileServerThread = Class(TServerClientThread)

private

IdTerminal : String;

TmrMessage : TTimer;

public

nregistro : String;

finicial : String;

ffinal : String;

FWHandle : HWND;

TempoInterval : Cardinal;

Procedure ClientExecute; override;

Procedure GetDataTx(idTerminal : String);

Procedure ImportMessage(IDRemota : String; Msg : String);

function crc16string(msg:string):string;

function NumToHex(Num: Word): String;

procedure TimerSincronize(Sender: TObject);

function Implement(): Integer;

End;

O metodo ClientExecute é onde minha thread roda e é la dentro que irei instanciar meu objeto TTimer, ou SetTimer dependendo da implementação mas seja de qual for o modo ou pela instancia do Objeto TTimer ou pela Api SetTimer o metodo TimerSincronize não executa que na verdade seria o metodo associado ao OnTimer. Ou se pela outra forma a função de callBack não executa de jeito nenhum enquanto a thread estiver rodando, porem se a thread for finalizada dai o callBack executa.

Acho que deve haver algum problema com o uso de timers dentro de threads. Pois pelo que vi o timer so funciona com a thread parada.

Vejam uparte do codigo do metodo ClientExecute

CODE

Procedure TFileServerThread.ClientExecute;

var

SocketStream: TWinSocketStream;

Begin

inherited FreeOnTerminate := True;

Try

SocketStream := TWinSocketStream.Create(ClientSocket,frmServer.TimeOut); //INFINITE //frmServer.TimeOut);

Try

While Not Terminated And ClientSocket.Connected Do

try

FillChar(Data, SizeOf(Data), 0);

qtdBytes := SocketStream.Read(Data, SizeOf(Data));

If qtdBytes = 0 Then

Begin

if (not frmServer.IsFrame(RecText)) and (length(RecText) > 13) then

begin

ClientSocket.Lock;

ClientSocket.Disconnect(ClientSocket.Handle);

ClientSocket.Close;

Terminate;

if TmrMessage <> nil then

begin

TmrMessage.Enabled := false;

TmrMessage.OnTimer := NIL;

TmrMessage.Free;

end;

ClientSocket.Unlock;

end;

If (ClientSocket.Connected) and (RecText <> '') Then

Begin

ClientSocket.Lock;

if frmServer.IsProtocol () then //then (copy(RecText,1,1) = ':') and (copy(RecText,length(RecText),1) = ':') then

begin

LOG ('=>Modo de Recepção Configuração');

LOG ('=>Canal .: ' + IntToStr(ClientSocket.Handle));

LOG ('=>RX '+ RecText);

LOG ('');

if copy(RecText,2,2) = 'NS' then

begin

FlagResp := false;

idTerminal:= copy(RecText,5,8);

//

SetTimer(0, 1, 3000, @Timer_Proc); // Executa a cada 3 segundos

if TmrMessage = nil then

begin

Implement();

TmrMessage := Ttimer.Create(nil);

TmrMessage.Interval := 3000;

TmrMessage.OnTimer := TimerSincronize;

TmrMessage.Enabled := true;

end;

end;

ImportMessage(idTerminal,RecText);

end

End;

Finally

SocketStream.Free;

End;

Except

ClientSocket.Close;

Terminate;

if TmrMessage <> nil then

begin

TmrMessage.Enabled := false;

TmrMessage.OnTimer := NIL;

TmrMessage.Free;

end;

End;

End;

Ps.: Veja onde esta de vermelho é a implementação de acordo com o Thales e de Azul de acordo com Kmgn

sempre quando compilo de uma forma comento o outro.

Obrigado pela ajuda pessoal , se alguém tiver mais ideias de como posso resolver fico agradecido.

[Thales Pontes Martins]

Meu amigo, você está se esquecendo que uma mensagem de TimeOut postada a fila de mensagems não é retirada sozinha de lá, você tem que processar as mensagems da fila no seu método execute. ok?

E quanto a função de callback, ela só roda quando a aplicação está em idle, nesse caso a sua thread está sempre rodando um código dentro daquela repetição while, então se ela está rodando aquele código ela não pode rodar ao mesmo tempo a procedure de callback, certo? ;)

[kmkg]

Verifique quantas vezes você executa SetTimer dentro do método Execute.

Pode ser que ele esteja sendo executado a cada iteração do looping e isso faz com que o Timer seja zerado.

Ou seja, como seu idTimer é sempre 1, o tempo começa a ser contado a partir do último SetTimer executado.

[Thales Pontes Martins]

E lembre-se que é preciso liberar o Timer assim que a thread terminar com a api KillTimer.

[kmkg]

E quanto a função de callback, ela só roda quando a aplicação está em idle, nesse caso a sua thread está sempre rodando um código dentro daquela repetição while, então se ela está rodando aquele código ela não pode rodar ao mesmo tempo a procedure de callback, certo? ;)

Se for colocado Application.ProcessMessages a cada iteração do loop, o callback será executado.

Afinal as Threads servem justamente para rodar processos em concorrência.

[Thales Pontes Martins]

Foi exatamente isso que eu disse pra ele fazer, só resta saber se Application.ProcessMessages vai também processar a fila dessa thread pois se não me engano, cada thread tem sua própria fila. Mas não custa tentar.

[kmkg]

Sim, ProcessMessages processa todas as msgs da aplicação; tanto da Thread principal, quanto das secundárias.

Particularmente, utilizo Timers em Threads, mas prefiro fazer isso numa outra Thread pelo GetTickCount.

Não sei porque, mas não gosto muito de utilizar o ProcessMessages.

[Thales Pontes Martins]

Sim, ProcessMessages processa todas as msgs da aplicação; tanto da Thread principal, quanto das secundárias.

então nesse caso deverá funcionar.

Particularmente, utilizo Timers em Threads, mas prefiro fazer isso numa outra Thread pelo GetTickCount.

É verdade, nesse caso como ele quer repetir a cada 3 segundos era bem mais simples fazer com GetTickCount. Lembrando-se do problema dos 50 dias, que poderia travar o programa, mas sabendo filtrar esse erro, resolveria o problema tranquilamente.

Não sei porque, mas não gosto muito de utilizar o ProcessMessages.

É verdade, o ProcessMessages quando é chamado dentro do procedimento de um evento, e já tiver uma mensagem pra rodar aquele mesmo procedimento na fila, pode causar uma recursão e muita dor de cabeça, falo por experiencia própria porque já me deparei com esse problema e a solução foi executar a operação em outra thread.

[Micheus]

Thales e kmkg, apenas para ampliar o assunto, não poderia ser utilizada a função timeSetEvent já que parece-me ser projetada para executar o que está sendo proposto?

Defíne-se o tempo que uma chamada da uma callback deve ocorrer, informando inclusive se é um evento periódico e a "precisão" com que deve ocorrer.

definição: MMRESULT timeSetEvent(UINT uDelay, UINT uResolution, LPTIMECALLBACK lpTimeProc, DWORD dwUser, UINT fuEvent);

[]s

[Thales Pontes Martins]

Bem lembrado, Micheus, essa função me parece perfeita já que roda em uma thread individual e eliminaria o problema de o evento não ocorrer enquanto se está processando código.

É igual a quando você define um timer por exemplo pra fazer um relógio funcionar em uma label, o relógio está andando direitinho, mas se usuário clicar em um botão e o evento seje um procedimento que demore 5 minutos, então o relógio não vai funcionar durante esses 5 minutos porque o evento não é executado enquanto se está processando código, porque as mensagens de um TTimer são processadas pela thread principal. A solução seria ter esse procedimento executado por uma thread aparte para que a thread principal permaneça em idle e se dedique apenas a processar as menssagens, incluindo as do Timer.

Então o programa do Max tem a thread principal que fica idle, a classe que ele está escrevendo que é a thread que ficará executando o código, e uma 3º thread que ficará executando callbacks do timer.

Mas se a 2º thread ficará executando código e a 1º ficará idle, a classe dele poderia ter a thread principal a criar o Timer, aí os eventos de Timer seriam executados em concorrencia com o código e se economizaria a criação de mais uma thread.

[kmkg]

Thales e kmkg, apenas para ampliar o assunto, não poderia ser utilizada a função timeSetEvent . . .

Só vejo um empecilho quanto à portabilidade. Essa função só funciona em WinXP e existem muitos Windows 2000/2003 no mercado.

[Thales Pontes Martins]

Só vejo um empecilho quanto à portabilidade. Essa função só funciona em WinXP e existem muitos Windows 2000/2003 no mercado.

Na documentação do Windows diz que essa função está presente desde o Windows 95.