* * *

Author Topic: TFPTimer does not trigger  (Read 541 times)

pascalbythree

  • Jr. Member
  • **
  • Posts: 52
TFPTimer does not trigger
« on: April 06, 2017, 12:20:58 pm »
Code: Pascal  [Select]
  1. [size=10pt][font=courier]program lserver;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   rpi_hal,pfio,
  7.   Classes, Crt, SysUtils, lNet, Process, fptimer;
  8.  
  9. type
  10.  
  11. { TLTCPTest }
  12.  
  13.   TLTCPTest = class
  14.    private
  15.    Timer1: TFPTimer;
  16.     FCon: TLTCP; // THE server connection
  17.    {  these are all events which happen on our server connection. They are called inside CallAction
  18.       OnEr gets fired when a network error occurs.
  19.       OnAc gets fired when a new connection is accepted on the server socket.
  20.       OnRe gets fired when any of the server sockets receives new data.
  21.       OnDs gets fired when any of the server sockets disconnects gracefully.
  22.    }
  23.     procedure OnEr(const msg: string; aSocket: TLSocket);
  24.     procedure OnAc(aSocket: TLSocket);
  25.     procedure OnRe(aSocket: TLSocket);
  26.     procedure OnDs(aSocket: TLSocket);
  27.         procedure TimerExec(Sender: TObject);
  28.    public
  29.     constructor Create;
  30.     destructor Destroy; override;
  31.     procedure Run; // main loop with CallAction
  32.         function getRelay(lednr:byte):boolean;
  33.         procedure setRelay(lednr:byte;Enabled:Boolean);
  34.         procedure playsound ;
  35.   end;
  36.  
  37.  
  38. procedure TLTCPTest.OnEr(const msg: string; aSocket: TLSocket);
  39. begin
  40. //  Writeln(msg);  // if error occured, write it explicitly
  41. end;
  42.  
  43. procedure TLTCPTest.OnAc(aSocket: TLSocket);
  44. begin
  45.   //Writeln('Connection accepted from ', aSocket.PeerAddress); // on accept, write whom we accepted
  46. end;
  47.  
  48.      
  49.     procedure TLTCPTest.playsound ;
  50.     var
  51.      AProcess : TProcess;
  52.     begin
  53.       AProcess := TProcess.Create(nil);
  54.       AProcess.FreeOnRelease;
  55.       AProcess.Executable :=  '/usr/bin/aplay';
  56.           AProcess.Parameters.Add(' /home/pi/WVW_TTS_FILES/relay1on.wav');
  57.       AProcess.Execute;      
  58.     end;
  59.      
  60.      
  61.  
  62. function TLTCPTest.getRelay(lednr:byte):boolean;
  63. var b:Boolean; GPIOnr:Byte;
  64. begin
  65. if lednr = 1 then GPIOnr := 27;
  66. if lednr = 2 then GPIOnr := 23;
  67. if lednr = 3 then GPIOnr := 15;
  68. if lednr = 4 then GPIOnr := 14;
  69. if lednr = 5 then GPIOnr := 7;
  70.  
  71. gpio_set_output(GPIOnr);
  72. b:=GPIO_get_PIN(gpionr);
  73. result := b;
  74. end;
  75.  
  76. procedure TLTCPTest.setRelay(lednr:byte;Enabled:Boolean);
  77. var GPIOnr:Byte;
  78. begin
  79.   if lednr = 1 then GPIOnr := 27;
  80.   if lednr = 2 then GPIOnr := 23;
  81.   if lednr = 3 then GPIOnr := 15;
  82.   if lednr = 4 then GPIOnr := 14;
  83.   if lednr = 5 then GPIOnr := 7;
  84.   playsound;
  85.   gpio_set_output(GPIOnr);
  86.   gpio_set_pin (GPIOnr,Enabled);
  87. end;
  88.  
  89. procedure TLTCPTest.TimerExec(Sender: TObject);
  90. begin
  91.  
  92. FCon.SendMessage('TIMER! EVENT WVW');
  93. Writeln('TIMER! EVENT WVW');
  94. end;
  95.  
  96. procedure TLTCPTest.OnRe(aSocket: TLSocket);
  97. var
  98.   GS,t,s: string;
  99.   n: Integer;
  100. begin
  101.  
  102.  
  103.       T:=TimeToStr(Time);
  104.   if aSocket.GetMessage(s) > 0 then
  105.      begin // if we received anything (result is in s)
  106.    
  107.     if (S='[SET11]') then begin Writeln('WVW '+T+': Relay 1 Enabled - GPIO27'); setRelay(1,True); end;
  108.     if (S='[SET10]') then begin Writeln('WVW '+T+': Relay 1 Disabled - GPIO27'); setRelay(1,False);end;
  109.        
  110.     if (S='[SET21]') then begin Writeln('WVW '+T+': Relay 2 Enabled - GPIO23');  setRelay(2,True);end;
  111.     if (S='[SET20]') then begin Writeln('WVW '+T+': Relay 2 Disabled - GPIO23'); setRelay(2,False); end;
  112.  
  113.        
  114.     if (S='[SET31]') then begin Writeln('WVW '+T+': Relay 3 Enabled - GPIO15');  setRelay(3,True);end;
  115.     if (S='[SET30]') then begin Writeln('WVW '+T+': Relay 3 Disabled - GPIO15');  setRelay(3,False);end;
  116.  
  117.        
  118.     if (S='[SET41]') then begin Writeln('WVW '+T+': Relay 4 Enabled - GPIO14');  setRelay(4,True);end;
  119.     if (S='[SET40]') then begin Writeln('WVW '+T+': Relay 4 Disabled - GPIO14');  setRelay(4,False);end;
  120.  
  121.     if (S='[SET51]') then begin Writeln('WVW '+T+': Relay 5 Disabled - GPIO4');  setRelay(5,True);end;
  122.     if (S='[SET50]') then begin Writeln('WVW '+T+': Relay 5 Disabled - GPIO4');   setRelay(5,False);end;
  123.        
  124.     //if (S='[R]') then
  125.         begin
  126.         GS:='';
  127.     if (getRelay(1) = True) then begin GS:=GS+' [GET11] '; end else begin GS:=GS+' [GET10] ';end;
  128.     if (getRelay(2) = True) then begin GS:=GS+' [GET21] '; end else begin GS:=GS+' [GET20] ';end;
  129.     if (getRelay(3) = True) then begin GS:=GS+' [GET31] '; end else begin GS:=GS+' [GET30] ';end;
  130.     if (getRelay(4) = True) then begin GS:=GS+' [GET41] '; end else begin GS:=GS+' [GET40] ';end;
  131.     if (getRelay(5) = True) then begin GS:=GS+' [GET51] '; end else begin GS:=GS+' [GET50] ';end;      
  132.        
  133.          
  134.    Writeln('GS:'+GS);          
  135.    FCon.SendMessage(GS, FCon.Iterator);
  136.    end;
  137.  
  138.        
  139.     FCon.IterReset; // now it points to server socket
  140.     while FCon.IterNext do begin // while we have clients to echo to
  141.       n := FCon.SendMessage(s, FCon.Iterator);
  142.       if n < Length(s) then // try to send to each of them
  143.         Writeln('WVW ERROR: Unsuccessful send, wanted: ', Length(s), ' got: ', n); // if send fails write error
  144.     end;
  145.   end;
  146. end;
  147.  
  148. procedure TLTCPTest.OnDs(aSocket: TLSocket);
  149. begin
  150.  // Writeln('Lost connection'); // write info if connection was lost
  151. end;
  152.  
  153. constructor TLTCPTest.Create;
  154. begin
  155.   FCon := TLTCP.Create(nil); // create new TCP connection
  156.   FCon.OnError := @OnEr;     // assign all callbacks
  157.   FCon.OnReceive := @OnRe;
  158.   FCon.OnDisconnect := @OnDs;
  159.   FCon.OnAccept := @OnAc;
  160.   FCon.Timeout := 100; // responsive enough, but won't hog cpu
  161.   FCon.ReuseAddress := True;
  162. end;
  163.  
  164. destructor TLTCPTest.Destroy;
  165. begin
  166.   FCon.Free; // free the TCP connection
  167.   inherited Destroy;
  168. end;
  169.  
  170. procedure TLTCPTest.Run;
  171. var
  172.   Quit: Boolean; // main loop control
  173.   Port: Word;    // the port to connect to
  174. begin
  175.  
  176.   Timer1 := TFPTimer.Create(nil);
  177.    Timer1.onTimer := @TimerExec;
  178.    Timer1.interval := 300;
  179.   Timer1.Enabled := True;
  180.    
  181.  
  182.   if ParamCount > 0 then begin // we need one argument
  183.     try
  184.       Port := Word(StrToInt(ParamStr(1))); // try to parse port from argument
  185.     except
  186.       on e: Exception do begin
  187.         Writeln(e.message);
  188.         Halt;
  189.       end;
  190.     end;
  191.     Quit := false;
  192.  
  193.     if FCon.Listen(Port) then begin // if listen went ok
  194.       Writeln('Server running!');
  195.       Writeln('Press ''escape'' to quit, ''r'' to restart');
  196.       repeat
  197.         FCon.Callaction; // eventize the lNet
  198.         if Keypressed then // if user provided input
  199.           case readkey of
  200.            #27: quit := true; // if he pressed "escape" then quit
  201.            'r': begin       // if he pressed 'r' then restart the server
  202.                   Writeln('Restarting...');
  203.                   FCon.Disconnect;
  204.                   FCon.Listen(Port);
  205.                   Quit := false;
  206.                 end;
  207.           end;
  208.       until Quit; // until user quit
  209.     end; // listen
  210.   end else Writeln('Usage: ', ParamStr(0), ' <port>');
  211. end;
  212.  
  213. var
  214.   TCP: TLTCPTest;
  215. begin
  216.   TCP := TLTCPTest.Create;
  217.   TCP.Run;
  218.   TCP.Free;
  219. end.
  220.  
  221. [/font][/size]

Can anybody see why

procedure TLTCPTest.TimerExec(Sender: TObject);

does nog trigger ?

It compliles fine, but 'TIMER! EVENT WVW' does not appear.



ASerge

  • Sr. Member
  • ****
  • Posts: 280
Re: TFPTimer does not trigger
« Reply #1 on: April 06, 2017, 07:04:41 pm »
TTimer is made in accordance with the event handling model. Your program does not handle the event.


pascalbythree

  • Jr. Member
  • **
  • Posts: 52
Re: TFPTimer does not trigger
« Reply #3 on: April 10, 2017, 06:49:19 am »
Does anybody have more example code to use the TTimer alongside with the lnet socket server?
« Last Edit: April 11, 2017, 02:12:45 pm by pascalbythree »

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus