Borland Delphi TimerButton component


Copyright© by Yusuf CELIK

yusufcelik@gmail.com 

TimerButton kısaca, geri sayım yapan ve sıfırlandığı zaman bir event’i tetikleyen bir buton component’idir.

Aşağıdaki örnekte görüldüğü gibi geri sayım işlemi başlamıştır.

 

Resim - TimerButton

Geri sayım işlemi bittiğinde ya da süre bitmeden button tıklandığında OnClick ya da OnTimerExpires event’i çalışır.

Standart TButton event’lerine ek olarak, süre bittiğinde çalışan OnTimerExpires event’i eklenmiştir.

 

Resim - ObjectIspector

Şimdi kısaca nasıl yapıldığına bakalım.

Öncelikle bir tane DesignTime package tanımlayalım.

 

·         File|New|Package – Delphi for Win32

·         Package Options’unu aşağıdaki şekilde değiştirip OK’leyelim.

 

Resim - ProjectOptions

·         Bu Package’i TimerButtonComponent.bdsproj olarak save edelim.

·         Daha sonra yeni bir Unit eklememiz gerekir.

·         File|New|Unit – Delphi for Win32

·         Bu unit’i TimerButtonUnit.pas olarak save edelim.

·         Projenin son hali Project Manager’de aşağıdaki gibi görünür.

Resim - ProjectManager

Bir sonraki aşama olan TimerButtonUnit.pas unit’i oluşturmaya başlayalım.

 

Bilindiği gibi Delphi görsel kütüphane yapısı component yapısı üzerine kuruludur. Buna da VCL yani Visual Component Library denir.

Tool Palette ya da eski adıyla Component Palette üzerinde bulunan ve Form üzerinde kullandığımız bütün componentlar TComponent sınıfından türemiştir.

TComponent sınıf yapısına kısaca bir göz atalım.

 

TComponent = class(TPersistent, IInterface, IInterfaceComponentReference)
    private
      ...
      ...
      ...
    protected
      ...
      ...
      ...
    public
      constructor Create(AOwner: TComponent); virtual;
      destructor Destroy; override;
      ...
      ...
      ...
      property Components[Index: Integer]: TComponent read GetComponent;
      property ComponentCount: Integer read GetComponentCount;
      ...
      ...
      ...
    published
      property Name: TComponentName read FName write SetName stored False;
      property Tag: Longint read FTag write FTag default 0;
    end;

 

 

Class yapısı çok büyük olduğu için bir çok Metod ve Property silinmiştir. Yalnızca sıkça kullanılanları inceleyelim.  

constructor Create(AOwner: TComponent); virtual; Adından da anlaşılacağı gibi, component form üzerine bırakıldığı zaman ilk çalışacak rutindir.

destructor Destroy; override; Aynı şekilde, component’ın yaşam döngüsünde çalışacak son  rutindir. Burada constructor Create rutininde initialize ya da yarattığımız bazı hafıza değişkenlerini burada serbest bırakıyoruz (Free).
property Components[Index: Integer]: TComponent read GetComponent;
Bu property birden fazla component içeriyor ise bu property’den o component’lere buradan ulaşabiliriz. Örneğin, TPanel component’ini ele alalım, bu component  bir konteyner konumundadır, içerisine Buttonlar,  Label’lar ve de envayi çeşit kontrol konabilir. Bu durumda, Panel’in Components[] propertisini kullanarak Panel içinde bulunan diğer component’lara erişilebilir.

property ComponentCount: Integer read GetComponentCount; Component içerisinde bulunan component sayısını verir. Bir önceki örneği inceleyecek olursak, Panel içinde 2 Button 3 Label olduğunu düşünelim.  ComponentCount 5 sayısını vercektir. 

property Name: TComponentName read FName write SetName stored False; Form üzerine bıraktığımızda property değerlerinde Name yazan kısımdır. stored False anlamı ise, bu property (yani Name) form dosyasına save edilip edilmeyeceğini belirtir. Burada save edilmeyeceği söyleniyor.

property Tag: Longint read FTag write FTag default 0; Form üzerine bıraktığımızda property değerlerinde Tag yazan kısımdır. İstediğimiz herhangi bir değeri verilebilir. default 0 anlamı ise, bu property (yani Tag) alacağı ilk default değerin 0 olacağı söyleniyor.

Daha fazla bilgi için Classes.pas incelenebilir. Bulunduğu yer, Delphi’yi kurduğunuz klasörün altında ...\BDS\4.0\Source\Win32\rtl\Common\ Classes.pas. (Delphi 2005 için 3.0)

 

Yukardaki bilgiler ışığında component’imizi yazmaya başlayalım.

TimerButton yaratırken gaz ve toz bulutundan başlamamıza hiç gerek yoktur, TButton ile benzer iş yapacağından Object Oriented Programlama Teknolojisini kullanarak bu component’dan inherit (miras devralmak) edebiliriz. Tanımlayacağımız class yapısı aşağıdaki gibi olmalıdır.

 

const
  MSG_TIMER_EXPIRES = WM_USER + 2;
type
  TTimerThread = class;
  TTimerButton = class(TButton)
  private
    { Private declarations }
    FTimeout: Integer;
    FTimerEnabled: Boolean;
    FOnTimerExpires: TNotifyEvent;
    tt : TTimerThread;
    bCaptionChanged : Boolean;
    FFormatStr : string;
    CaptionStr : string;
    procedure DoTimerExpires(var Message: TMessage);

                            message MSG_TIMER_EXPIRES;
    procedure TerminateFnc(Sender:TObject);
    procedure CMTextChanged(var Message: TMessage); 

                            message CM_TEXTCHANGED;
    procedure SetFormatStr(Value:string);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(Owner:TComponent);override;
    destructor  Destroy;override;
    procedure Click; override;
    procedure Start;
    procedure Stop;
    procedure Pause;
  published
    { Published declarations }
    property OnTimerExpires : TNotifyEvent 

                              read FOnTimerExpires 

                              write FOnTimerExpires;
    property TimeOut : Integer read FTimeout write FTimeout;
    property FormatStr : string read FFormatStr write SetFormatStr;
  end;

 

 

 

TTimerThread = class(TThread)
  private
    FEvent : TSimpleEvent;
    cmp    : TTimerButton;
    CountDown : Integer;
    Signaled  : Boolean;
    procedure SyncChangeCaption;
  public
    procedure Execute;override;
    procedure Terminate;reintroduce;
    constructor Create(btn:TTimerButton; TimeOutValue:Integer);overload;
    destructor Destroy; override;
  end;

 

Bu class yapısında en önemli metod procedure Execute; çünkü bir Thread classının çalışması için Execute metodu çalışır, Thread‘in yaşam döngüsü Execute metodu içinde sınırlıdır, yani bu methodun dışına çıkarsa Thread yaşam döngüsünü tamamlamış olur. reintroduce’un anlamı ise, procedure Terminate; fonksiyonu inherit edilen class’da tanımlıdır, tekrar aynı ismi kullanmak için reintroduce kullanılır.

 
procedure TTimerThread.Execute;
var
  wr : TWaitResult;
begin
  try
    wr := FEvent.WaitFor(1000);
    while wr = wrTimeout do
    begin
      if CountDown <> 0 then
         Synchronize(SyncChangeCaption);
      Dec(CountDown);
      if CountDown < 0 then Break;
      wr := FEvent.WaitFor(1000);
    end;
  except
    ApplicationHandleException(Self);
    Exit;
  end;
  Signaled := wr = wrSignaled;
end;
 

 

Yukarda Execute metodunda FEvent.WaitFor(1000); içinde bekleme süresi 1000 milisaniye yani 1 sn’dir. Buradan çıkmak için FEvent.WaitFor(1000) dönen değerin wrTimeout‘dan farklı ya da CountDown sıfından küçük olması gerekir . Bunu yapmanın tek yolu da wrSignaled değeri göndermek ya da CountDown sıfından küçük olmasını beklemek. Dönen değerin wrTimeout‘dan farklı yapmak için de Thread aşağıdaki gibi sonlandırılır.

 

procedure TTimerThread.SyncChangeCaption;
begin
  cmp.Caption := Format(cmp.FormatStr, [cmp.CaptionStr,  CountDown]);
end;

procedure TTimerThread.Terminate;
begin
  FEvent.SetEvent;
end;

 

FEvent.SetEvent ile wr := FEvent.WaitFor(1000); dönen değer wrSignaled olur. Ayrıca, CountDown sıfır’a indiğinde de döngü dışına çıkacağından, o zaman zaman aşımına uğramış olur. Döngü içinde dönerken de button’daki Caption değiştirilir.

TTimerThread’in diğer metodlarını da yazalım.

 
constructor TTimerThread.Create(btn:TTimerButton; TimeOutValue:Integer);
begin
  inherited Create(True);
  FEvent := nil;
  if TimeOutValue <= 0 then
     raise Exception.Create(
'Değer 1 dan küçük olamaz');
  FreeOnTerminate := False;
  Signaled := False;
  CountDown := TimeOutValue-1;
  FEvent := TSimpleEvent.Create();
  cmp    := btn;
end;

destructor TTimerThread.Destroy;
begin
  if Assigned(FEvent) then
     FreeAndNil(FEvent);
  inherited Destroy;
end;

 

Arka planda çalışan class tanımlandıktan sonra bunu uygulayacağımız button class’ına dönelim.

 

//Button üzerindeki caption değişirse bu mesaj handler çağrılır
//Yani, Button1.Caption := 'Press Me!'; yazıldığında
//aşağıdaki otomatik olarak çağrılır.
//Geri sayım işlemi olacağından her durumda burası çağrılacaktır
//bunu engellemek için kontrol eklenmiştir.
procedure TTimerButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if bCaptionChanged then Exit;
  CaptionStr := Caption;
  bCaptionChanged := True;
end;

constructor TTimerButton.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FTimerEnabled := False;
  bCaptionChanged := False;
  FormatStr := 
'%s(%d)';
end;

//İşimiz bittiğinden Thread’i durdurmamız gerekir
destructor TTimerButton.Destroy;
begin
  Stop;
  inherited Destroy;
end;

//FormatStr’nin atandığı kısım.
procedure TTimerButton.SetFormatStr(Value: string);
  
//----------------------------------------
  function CountNumberOf(s : string):Integer;
  var
    j : Integer;
  begin
    Result := 0;
    j := 1;
    while j <= Length(Value) do
    begin
      if Copy(Value, j, Length(s)) = s then
      begin
        Inc(Result);
        Inc(j, Length(s));
      end
      else
        Inc(j);
    end;
  end;
  
//----------------------------------------
begin
  if FFormatStr <> Value then
  begin 
    if CountNumberOf('%') > 2 then
       raise Exception.Create(
'FormatStr içinde max. 2 tane % olmalıdır'); 
    if CountNumberOf(
'%s') <> 1 then
       raise Exception.Create(
'FormatStr içinde 1 tane %s olmalıdır');
    if CountNumberOf(
'%d') <> 1 then
       raise Exception.Create(
'FormatStr içinde 1 tane %d olmalıdır');
    FFormatStr := Value;
  end;
end;

//Geri sayım işlemini başlatmak için.
//Görüldüğü gibi burada, geri sayım görevini üstlenen TTimerThread yaratılıyor.
//Ve Thread bittiğinde çağrılacak fonksiyon attanıyor
procedure TTimerButton.Start;
begin
  if Assigned(tt) then Exit;
  tt := TTimerThread.Create(Self, TimeOut);
  tt.OnTerminate := TerminateFnc;
  tt.Resume;
end;

//Geri sayım işlemini sonlandırmak için.
//Görüldüğü gibi burada, geri sayım görevini üstlenen TTimerThread sonlandırılıyor.
procedure TTimerButton.Stop;
begin
  if not Assigned(tt) then Exit;
  if tt.Suspended then
     tt.Resume;
  tt.Terminate;
  tt.WaitFor;
  FreeAndNil(tt);
end;

//Geri sayım işlemini askıya almak için.
//Görüldüğü gibi burada gene iş, geri sayım görevini
//üstlenen TTimerThread class’ına düşüyor.
procedure TTimerButton.Pause;
begin
  if not Assigned(tt) then Exit;
  if tt.Suspended then
     tt.Resume
  else
     tt.Suspend;
end;

//Ve Thread bittiğinde çağrılacak fonksiyon
//Geri sayım işlemi bitiğnde Thread sonlandı ise
//DoTimerExpires mesaj handler’e mesaj gönderiliyor.
//Varsa bizim tanımladığımız Zaman aşımı event’i devreye girsin diye.
procedure TTimerButton.TerminateFnc(Sender: TObject);
begin
  if not tt.Signaled then
     PostMessage(Handle, MSG_TIMER_EXPIRES, 0, 0);
end;

//Button tıklandığında çağrılacak rutin
procedure TTimerButton.Click;
begin
  Stop;
  inherited Click;
end;

//Geri sayım işlemi bitti ise, Button üzerindeki Caption eski haline gelsin.
procedure TTimerButton.DoTimerExpires(var Message: TMessage);
begin
  Stop;
  Caption := CaptionStr; 
//Caption eski haline gelsin
  if Assigned(FOnTimerExpires) then
     FOnTimerExpires(Self);
end;

 

Şimdi artık component’imizi Register edebiliriz. Delphi unit içerisinde otomatik olarak Register fonsiyonunu arar, bulduğunda da çağırır. Component’i install etmek için Resim - ProjectManager üzerinde Sağ-Tuş ve Install seçeneğiniz seçiniz.

 

procedure Register;
begin
  RegisterComponents(
'Samples', [TTimerButton]);
end;

 

Anlaşıldığı gibi component’imiz Tool Palette üzerinde Samples sayfası üzerinde yer alır.

 

Dikkat edilirse, TTimerButton’ umuzu TButton’dan inherit ettiğimizden ve biz de bir icon tanımlamadığımızdan, TButton icon’unu kullanmaktadır.

 

Yukarıda anlatılan örnek için kaynak kod: Kaynak Kod

 

Sorularınız için bana yusufcelik@gmail.com adresinden ulaşabilirsiniz.

 

Not: Yukardaki örnek Borland Delphi 2005 ve 2006 da test edilmiştir.