LedShape Component & Knight Rider project

[tr_escape]

Does anybody remember Knight Rider T.V. series? In this T.V. series there is a car and its very smart car. Most remember of this car it has front led device.

http://www.dizidizi.net/wp-content/uploads/2007/11/knight-rider-nbc.jpg

This led device generates flip flop led operations. I am not give you IC4017 chip and 555 chip details in this article. But we can do it in lazarus component...

For this LEDs we can use a father component that name is TShape object. We will modify this component to TLedShape.

In Lazarus Package menu you should add a new component based on TShape:
http://mehmetulukaya.files.wordpress.com/2011/12/create_new_component.jpg?w=1024&h=617



Save this component in to \lazarus\components\ledshape directory.

Code: [Select]

unit LedShape;

{$mode objfpc}{$H+}

interface

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

type

 { TLedShape }

 TLedShape = class(TShape)
 private
 ReadBlue: TColor;
 ReadColor: TColor;
 ReadGreen: TColor;
 ReadRed: TColor;
 ReadColorStep: TColor;

 tmrAnim : TTimer;
 procedure OnTmrAnim(Sender: TObject); // for led animation
 tmrState : Integer; // state machine global var.
 ledColorCnt : Tcolor;

 r,g,b,
 t_r,t_g,t_b : byte;

 ReadFromColor: TColor;
 ReadStatus: boolean;
 ReadStep: Integer;
 ReadToColor: TColor;
 procedure SetBlue(const AValue: TColor);
 procedure SetColor(const AValue: TColor);
 procedure SetColorStep(const AValue: TColor);
 procedure SetFromColor(const AValue: TColor);
 procedure SetGreen(const AValue: TColor);
 procedure SetRed(const AValue: TColor);
 procedure SetStatus(const AValue: boolean);
 procedure SetStep(const AValue: Integer);
 procedure SetToColor(const AValue: TColor);
 { Private declarations }
 protected
 procedure Paint; Override; //mu added
 constructor Create(AOwner : TComponent); Override;
 destructor Destroy; Override;
 public
 { Public declarations }
 published
 { Published declarations }
 property StartAnimation: boolean read ReadStatus write SetStatus; // some functions aren't neccessary
 property LedFromColor : TColor read ReadFromColor write SetFromColor;
 property LedToColor : TColor read ReadToColor write SetToColor;
 property LedColorStep : TColor read ReadColorStep write SetColorStep;
 property LedRed : TColor read ReadRed write SetRed;
 property LedGreen : TColor read ReadGreen write SetGreen;
 property LedBlue : TColor read ReadBlue write SetBlue;
 property AnimationStep : Integer read ReadStep write SetStep default 100;
 property LedColor : TColor read ReadColor write SetColor;

 property Align;
 property Brush;
 property Name;
 property Pen;
 property Shape;
 property Visible;
 property Height;
 property Width;


 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Sample',[TLedShape]);
end;


{ TLedShape }

procedure TLedShape.SetStatus(const AValue: boolean); //it is added automaticly CTRL + SHIFT + C
begin
 //if ReadStatus=AValue then exit;
 ReadStatus:=AValue;
 tmrAnim.Enabled := ReadStatus;
 if ReadStatus then
 begin
 ledColorCnt := LedFromColor;
 tmrState := 1;
 end;
end;

procedure TLedShape.SetStep(const AValue: Integer);
begin
 if ReadStep=AValue then exit;
 ReadStep:=AValue;
 tmrAnim.Interval:= ReadStep;
end;

procedure TLedShape.SetFromColor(const AValue: TColor); //it is added automaticly
begin
 if ReadFromColor=AValue then exit;
 ReadFromColor:=AValue;
 Self.Brush.Color:= ReadFromColor;
end;

procedure TLedShape.SetBlue(const AValue: TColor);
begin
 if ReadBlue=AValue then exit;
 ReadBlue:=AValue;
end;

procedure TLedShape.SetGreen(const AValue: TColor);
begin
 if ReadGreen=AValue then exit;
 ReadGreen:=AValue;
end;

procedure TLedShape.SetRed(const AValue: TColor);
begin
 if ReadRed=AValue then exit;
 ReadRed:=AValue;
end;

procedure TLedShape.SetColor(const AValue: TColor);
begin
 if ReadColor=AValue then exit;
 ReadColor:=AValue;
end;


procedure TLedShape.SetColorStep(const AValue: TColor);
begin
 if ReadColorStep=AValue then exit;
 ReadColorStep:=AValue;
end;

procedure TLedShape.SetToColor(const AValue: TColor); //it is added automaticly
begin
 if ReadToColor=AValue then exit;
 ReadToColor:=AValue;
end;

procedure TLedShape.Paint;
begin
 inherited Paint;
end;

//tmranim ontmr
procedure TLedShape.OnTmrAnim(Sender: TObject);
begin
 //

 case tmrState of
 0: begin
 end; // do nothing...
 1: begin
 ledColorCnt := ReadFromColor;
 Self.Brush.Color := ledColorCnt;
 RedGreenBlue(ReadToColor,t_r,t_g,t_b);
 RedGreenBlue(ledColorCnt,r,g,b);
 tmrState := 2; // go next state
 SetRed(r);
 SetGreen(g);
 SetBlue(b);

 end;
 2: begin

 if r<t_r then
 inc(r)
 else
 if r>t_r then
 dec(r);

 if g<t_g then
 inc(g)
 else
 if g>t_g then
 dec(g);

 if b<t_b then
 inc(b)
 else
 if b>t_b then
 dec(b);

 SetRed(r);
 SetGreen(g);
 SetBlue(b);

 ledColorCnt:= RGBToColor(r,g,b);

 Self.Brush.Color:= ledColorCnt; // refresh
 if ledColorCnt=ReadToColor then
 tmrState := 3; // go next state;

 SetColor(ledColorCnt);
 //Invalidate;
 end; // 2:

 3: begin
 tmrState:=0; // do nothing
 StartAnimation := false;
 //Invalidate;
 end; // 3:
 end; // case tmrstate


end;


constructor TLedShape.Create(AOwner: TComponent);
begin
 ReadStep := 1;
 // we should create timer object for animation
 tmrAnim := TTimer.Create(self);
 tmrAnim.OnTimer := @OnTmrAnim; // animations will in this event by state machine , you must remember @ (address)
 tmrAnim.Enabled := ReadStatus;
 tmrAnim.Interval := ReadStep;

 inherited Create(AOwner);
end;

destructor TLedShape.Destroy;
begin
 // we should destroy our objects...
 tmrAnim.Free;

 inherited Destroy;
end;

end.

OK we are ready for new project... Our form is designed like as:

http://mehmetulukaya.files.wordpress.com/2011/12/knight_rider_form_design.jpg?w=1024&h=619

And our codes not optimized but enough for education are prepared :

Code: [Select]

unit main;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
 ExtCtrls, StdCtrls, LedShape;

type

 { TForm1 }

 TForm1 = class(TForm)
 CheckBox1: TCheckBox;
 LedShape1: TLedShape;
 LedShape10: TLedShape;
 LedShape11: TLedShape;
 LedShape12: TLedShape;
 LedShape13: TLedShape;
 LedShape14: TLedShape;
 LedShape15: TLedShape;
 LedShape16: TLedShape;
 LedShape17: TLedShape;
 LedShape18: TLedShape;
 LedShape19: TLedShape;
 LedShape2: TLedShape;
 LedShape20: TLedShape;
 LedShape3: TLedShape;
 LedShape4: TLedShape;
 LedShape5: TLedShape;
 LedShape6: TLedShape;
 LedShape7: TLedShape;
 LedShape8: TLedShape;
 LedShape9: TLedShape;
 Timer1: TTimer;
 Timer2: TTimer;
 procedure CheckBox1Change(Sender: TObject);
 procedure LedShape1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure Timer1Timer(Sender: TObject);
 procedure Timer2Timer(Sender: TObject);
 private
 { private declarations }
 public
 { public declarations }
 end;

var
 Form1: TForm1;
 led_cnt : integer=0;
 up_down : boolean=true; //up means left to right, down means right to left
 be_wait_up : tdatetime=0;
 be_wait_dn : tdatetime=0;
implementation

{ TForm1 }

procedure TForm1.Timer1Timer(Sender: TObject);
var
 obj : string;
begin
 if be_wait_up>now then exit;

 if not CheckBox1.Checked then
 Timer1.Enabled:=false;

 if up_down then
 if led_cnt<20 then
 inc(led_cnt);

 obj := 'LedShape'+inttostr(led_cnt);
 if TLedShape(FindComponent(obj))<>nil then
 TLedShape(FindComponent(obj)).StartAnimation := true;

 if led_cnt>=20 then
 begin
 up_down := false;
 be_wait_dn := now + (((1/24)/60)/60)*(2/1);
 be_wait_up := now +1;
 led_cnt := 21;
 exit;
 end;

end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
 obj : string;
begin
 if be_wait_dn>now then exit;

 if not CheckBox1.Checked then
 Timer2.Enabled:=false;

 if not up_down then
 if led_cnt>1 then
 dec(led_cnt);

 obj := 'LedShape'+inttostr(led_cnt);
 if TLedShape(FindComponent(obj))<>nil then
 TLedShape(FindComponent(obj)).StartAnimation := true;

 if led_cnt<=1 then
 begin
 up_down := true;
 be_wait_up := now + (((1/24)/60)/60)*(2/1);
 be_wait_dn := now +1;
 led_cnt := 0;
 exit;
 end;

end;

procedure TForm1.CheckBox1Change(Sender: TObject);
var
 obj : string;
 n:integer;
begin
 for n:=1 to 20 do
 begin
 obj := 'LedShape'+inttostr(n);
 if TLedShape(FindComponent(obj))<>nil then
 TLedShape(FindComponent(obj)).Brush.Color := clGreen;
 end;
 if CheckBox1.Checked then
 begin
 Timer1.Enabled:=true;
 Timer2.Enabled:=true;
 led_cnt:=0;
 be_wait_up:=0;
 be_wait_dn:=now+1;
 up_down:= true;
 end;
end;

procedure TForm1.LedShape1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 cmp : TLedShape;
begin
 cmp := sender as TLedShape;
 cmp.StartAnimation:= true;
end;




initialization
 {$I main.lrs}

end.


And motors... we can run our program...

http://mehmetulukaya.files.wordpress.com/2011/12/knight_rider_runtime.jpg?w=500

You can find all codes and component source at this address:

https://sourceforge.net/projects/ezberim/files/lazarus_sample_components/

Orginal article:

http://mehmetulukaya.wordpress.com/2011/12/28/karasimsek-isigi-yapalim-mi-knight-rider-leds/

See on another project