Anasayfa > delphi, Lazarus > Karaşimşek Işığı yapalım mı – Knight Rider Leds

Karaşimşek Işığı yapalım mı – Knight Rider Leds


Karaşimşek dizisini hatırlar mısınız? Karaşimşek çok akıllı bir araba olur ve sahibinin dedikleri ile kendisine musallat olan cemil cümle elemanlara karşı bir çok önlem alabilmektedir. Karaşimşeğin en çok akılda kalan özelliği sürekli sağa sola giden öndeki ışıklandırmasıdır.

Tabiki burada IC4017 serisini ve 555,556 lı bir devre tasarlamayacağız çünkü şimdilik elektronik projeleri burada yayınlamıyorum.

Bu yazımızda lazarus ile bir komponent nasıl oluşturulur ve ek özellikler nasıl eklenir bunu inceleyeceğiz.Yukarıda anlattığımız gibi bir projemiz olsun ve led simulasyonu yapalım…

Ledler günümüzde bir çok yerde kullanılıyor ledlere enerji verdiğinizde üzerindeki metalden tek yöne bir akım geçişi sağlanır (diyot) ve ışıma sağlanır enerjiyi kestiğinizde ise ledin ışığı hemen gitmez.

Tasarlayacağımız ledin grafik özelliklerinden faydalanabileceğimiz bir nesneden türetirsek işimiz daha kolay olacak gibi.

Bunun için TShape komponentini kendimize temel alalım…

Package menüsünden New package ile kendi komponentimizi oluşturalım:

Oluşturacağımız komponentin adı LedShape olsun ve LedShape.pas olarak \lazarus\components\ledshape klasörü içerisine saklayalım.


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.

Oluşturduğumuz komponentlerle bir form tasarlayalım:

Ve biraz da kodlama ancak çok fazla optimizasyonla uğraşmadığımı hemen söyliyeyim…


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.

Şimdi de motor:

Proje ile ilgili kaynak kodları şu adresten de bulabilirsiniz:

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

Yeni bir yazıda görüşmek üzere…

Kategoriler:delphi, Lazarus
  1. Cesur
    Ağustos 6, 2016, 12:10 am

    Sanırım kodunuza da eksik var. RedGreenBlue diye bir prosedüre değer atıyorsunuz ama paylaştığınız komponent kodunda böyle bir prosedür tanımlamamışsınız hata veriyor.

    • mehmetulukaya
      Ağustos 8, 2016, 8:25 am

      Merhaba Cesur,

      RGBtoColor ve RedGreenBlue function’ları Graphics unitesinde bulunmaktadır.
      Uses kısmında bulunuyor mu? Kullandığınız fpc/lazarus versiyonu ile işletim sisteminiz nedir?

      İyi çalışmalar.

  2. Cesur
    Ağustos 10, 2016, 9:43 pm

    Merhaba ben bu örneğinizi Delphi Xe6 versiyonunda kullanmak istedim sanırım dolayısı ile uses kısmında Graphics ekli fakat sanırım ben başaramadım. Emeğiniz için teşekkürler

    • mehmetulukaya
      Ağustos 11, 2016, 7:56 am

      Merhaba,

      Delphi’nin alt sürümlerinden Lazarus’a (fpc) aktarımda problem yok ancak bazı fonksiyonlar ve procedureler farklı olabiliyor.
      Xe6 bende yok ancak component oluşturmak sureti ile benzeri bir çalışma yapılabilir.
      Aynı nesneyi delphi içerisinde oluşturmak gerekiyor.

  3. Cesur
    Ağustos 10, 2016, 9:47 pm

    Özür dileyerek birşey eklemek istedim , Amacım bu bileşeninizi saat yönünde iki farklı renk ile dönen daire şeklinde yapmak .

    • mehmetulukaya
      Ağustos 11, 2016, 7:57 am

      Yapılabilir hatta güzel bir düşünce ancak öncelikli olarak analog saat örneklerini incelemenizi tavsiye ederim.

      İyi çalışmalar.

  1. No trackbacks yet.

Görüşlerinizi belirtin

Aşağıya bilgilerinizi girin veya oturum açmak için bir simgeye tıklayın:

WordPress.com Logosu

WordPress.com hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Twitter resmi

Twitter hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Facebook fotoğrafı

Facebook hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Google+ fotoğrafı

Google+ hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Connecting to %s