[Lazarus] TTimer woes (newbie)

Bob Axtell bob.axtell at gmail.com
Mon Mar 31 19:24:16 CEST 2014


mine (a morse-code blinker) just doesn't work:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    procedure FormKeyPress(Sender: TObject; var Key: char);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    procedure morse;
    procedure dash;
    procedure dot;
    procedure wait(x: longint);
    { public declarations }
 end;

var
  Form1: TForm1;
  a,b,i: byte;
  count,dat,
  ms,ls,mchar: byte;
  tick: integer;
  col: integer = clblue;
  mtbl: string[16] =
   #$bf#$be#$bc#$b8#$b0#$a0#$a1#$a3#$a7#$af#$42#$81#$85#$61#$20#$84;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 timer1.enabled:= false;
end;

procedure TForm1.wait(x: longint);
begin
 tick:= x;
 while tick > 0 do
  begin
    timer1.enabled:= true;
    repeat until not timer1.enabled;
    dec(tick)
  end;
end;

procedure Tform1.dash;
begin
 Panel1.color:= col;
 wait(30);
 Panel1.color:= clwhite;
 wait(10);
end;

procedure Tform1.dot;
begin
 panel1.color:= col;
 wait(10);
 panel1.color:= clwhite;
 wait(10);
end;

procedure tform1.morse;
begin
 mchar:= $33;
 ms:= ord(mtbl[succ((mchar shr 4) and 15)]);
 ls:= ord(mtbl[succ(mchar and 15)]);
 count:= (ms shr 5) and 7;
 dat:= ms and 31;
 for i:= 1 to count do
 begin
  if ((dat and 1) > 0) then dash else dot;
  wait(10);
  dat:= dat shr 1;
 end;
 wait(50);
 { ms done, ls begins}
 count:= (ls shr 5) and 7;
 dat:= ls and 31;
 for i:= 1 to count do
 begin
  if ((dat and 1) > 0) then dash else dot;
  wait(10);
 end;
 wait(100);
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
begin
   case key of
   'r': begin
         col:= clred;
         wait(15);
        end;
   'g': begin
         col:= clgreen;
         wait(15);
        end;
   'b': begin
         col:= clblue;
         wait(15);
        end;
   ' ': morse;
  end;

end;

end.

any ideas? using v1.0.14 under WinXP.

--Bob A





On Mon, Mar 31, 2014 at 2:35 AM, Howard Page-Clark <hdpc at talktalk.net>wrote:

> On 31/03/2014 10:25, Michael Schnell wrote:
>
>> On 03/31/2014 01:44 AM, Bob Axtell wrote:
>>
>>> can someone show a newbie how to use the two system timers?
>>>
>>
>> What do you mean by system timers ?
>>
>
> I think he means the TTimer and TIdleTimer found on the System page of the
> Component Palette.
> If you drop one of each on the main form of a new project with a label and
> a memo, and add this code, it should give you an idea of how to use them.
>
> -- code begin --
>
> unit Unit1;
>
> {$mode objfpc}{$H+}
>
> interface
>
> uses
>   SysUtils, Forms, ExtCtrls, StdCtrls;
>
> type
>
>   { TForm1 }
>
>   TForm1 = class(TForm)
>     IdleTimer1: TIdleTimer;
>     LAverageSoFar: TLabel;
>     MNumbers: TMemo;
>     Timer1: TTimer;
>     procedure FormCreate(Sender: TObject);
>     procedure IdleTimer1Timer(Sender: TObject);
>     procedure Timer1Timer(Sender: TObject);
>   private
>     FNumber: integer;
>     FRunningTotal: integer;
>     FCount: integer;
>   end;
>
> var
>   Form1: TForm1;
>
> implementation
>
> {$R *.lfm}
>
> { TForm1 }
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
>   Randomize;
>   MNumbers.Clear;
>
>   Timer1.Interval:=500;
>   Timer1.OnTimer:=@Timer1Timer;
>   Timer1.Enabled:=True;
>
>   IdleTimer1.Interval:=1000;
>   IdleTimer1.OnTimer:=@IdleTimer1Timer;
>   IdleTimer1.Enabled:=True;
> end;
>
> procedure TForm1.IdleTimer1Timer(Sender: TObject);
> begin
>   LAverageSoFar.Caption:=
>     Format('Average of random numbers so far is
> %n',[FRunningTotal/FCount]);
> end;
>
> procedure TForm1.Timer1Timer(Sender: TObject);
> begin
>   FNumber:=Random(101);
>   MNumbers.Lines.Add(IntToStr(FNumber));
>   Inc(FCount);
>   Inc(FRunningTotal, FNumber);
> end;
>
> end.
>
> -- code end --
>
> Howard
>
>
>
> --
> _______________________________________________
> Lazarus mailing list
> Lazarus at lists.lazarus.freepascal.org
> http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20140331/56e4d92e/attachment-0003.html>


More information about the Lazarus mailing list