28 Ağustos 2012 Salı

Firemonkey DbExpress MySQL Bağlantısı

Merhaba ;
Delphi FireMonkey ile dbexpress kullanarak MySQL Server bağlantısını anlatmaya çalışacağım. Formun üzerine dbexpress sekmesinden TSQLConnection ve TSQLQuery nesneleri bırakılır.Daha sonra;

Windows için ;

TSQLConnection nesnesinin ConnectionName MySQL seçmeniz yeterli. MySQL Client ‘library dosyasının versionu 5.1.59 olmalıdır.

MacOSX için;

  SQLConnection1.ConnectionName:='MySQLConnection';
  SQLConnection1.DriverName:='MySQL';
  SQLConnection1.LibraryName:='libsqlmys.dylib';
  SQLConnection1.VendorLib:='libmysqlclient.dylib';
  SQLConnection1.LoginPrompt:=False;
  SQLConnection1.Open;
 http://dev.mysql.com/downloads/mysql/5.1.html  adresine girilir,ilgili sürüm indirilir.

Ben ; Version 5.1.63 ve Platform MAC OS X seçerek;

Mac OS X ver. 10.6 (x86, 32-bit), Compressed TAR Archive dosyasını indirdim.

mysql-5.1.63-osx10.6-x86lib klasörü içersindeki ;

libmysqlclient.dylib (Kısayol dosyasını) ve libmysqlclient.16.dylib dosyasını da MAC OS işletim sistemine publish etmeniz gerekiyor.

MySQL Client Library dosyalarını MAC’a yüklemek için;

Aktif firemonkey projenizin Project -> Deployment menüsüne tıklanır

Gelen ekrandan Add Feature Files butonuna tıklanır.

Gelen ekrandan DbExpress MySQL Driver düğümü altındaki OSX32 düğümü altındaki libsqlmys.dylib dosyası seçilir.

Add Files butonu tıklanarak MySQL sitesinden indirdiğimiz mysql-5.1.63-osx10.6-x86lib dizini içersindeki libmysqlclient.dylib ve libmysqlclient.16.dylib dosyalarıda deployment listesine eklenir.

Connect To Remote Machine butonuna tıklanarak bağlandıktan sonra Deploy butonu ile MAC’a MySQL Client Library dosyalarını yükleyebilirsiniz.

Demo Görünüm : 




Denemelerimi MAC OS X Lion 10.7.4 üzerinde yaptım.
Vakit buldukça yaptığım denemeleri sizlerle paylaşmaya çalışıcam.

TcxBarEditItem programatik olarak elemanlara erişmek


TcxBarEditItem classına inspektor da design time da eleman eklenebiliyor bilindiği üzere...
Kodlayarak yapmak istersek.

Örnek :

(.Properties as TcxComboBoxProperties).Items.Add(newitem);
(cmbSkinList.Properties as TcxComboBoxProperties).Items.Add('eleman');
Kaynak : http://www.devexpress.com/Support/Center/p/Q32066.aspx

TcxExtLookupComboBox ve TcxGrid Seçili Satıra Erişmek

Diyelim ki TcxExtLookupComboBox ve TcxGrid ile lookUp gerçekleştiriyorsunuz.
Ve yapmak istediğiniz açılan listeden seçili satırın değerlerine erişmek.
procedure TForm1.cxExtLookupComboBox1KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
var
 RecordIndex: Integer;
 AValue: Variant;
begin
  if Key = VK_RETURN then 
  begin
    RecordIndex := (Sender as TcxDBExtLookupComboBox).Properties.View.DataController.GetFocusedRecordIndex;
   //Seçili satırın 0 ile ilk kolonunda değere erişiliyor
   AValue := (Sender as TcxDBExtLookupComboBox).Properties.View.ViewData.DataController.GetValue(RecordIndex, 0);
   ShowMessage(AValue);
 end;
end;

TMessageDlg Özelleştirme

Bilindiği üzere MessageDlg daki ibareler ingilizce.Nasıl türkçeleştirebiliriz. Forumda da baktığım pas dosyasını düzenleyerek çözüme ulaşanları gördüm.Bu da benim çözümüm. Biraz uğraştırdı ama uğraşmaya değer...Ana Formunuza bir tane TApplicationEvents nesnesi bırakın.
 private
    { Private declarations }
    procedure ConvertToTurkish(H: HWND);

procedure TfrmMain.ConvertToTurkish(H: HWND);
begin
  if FindWindowEx(H, 0, 'TButton', '&Yes') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', '&Yes'), WM_SETTEXT, 0,
      Integer(PCHAR('Evet')));
  end;
  if FindWindowEx(H, 0, 'TButton', '&No') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', '&No'), WM_SETTEXT, 0,
      Integer(PCHAR('Hayır')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'OK') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'OK'), WM_SETTEXT, 0,
      Integer(PCHAR('Tamam')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'Cancel') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'Cancel'), WM_SETTEXT, 0,
      Integer(PCHAR('İptal')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'Abort') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'Abort'), WM_SETTEXT, 0,
      Integer(PCHAR('Durdur')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'Retry') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'Retry'), WM_SETTEXT, 0,
      Integer(PCHAR('Tekrar')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'Ignore') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'Ignore'), WM_SETTEXT, 0,
      Integer(PCHAR('Umursama')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'All') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'All'), WM_SETTEXT, 0,
      Integer(PCHAR('Hepsi')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'N&o to All') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'N&o to All'), WM_SETTEXT, 0,
      Integer(PCHAR('Tümünü Hayır')));
  end;
  if FindWindowEx(H, 0, 'TButton', 'Yes To &All') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', 'Yes To &All'), WM_SETTEXT, 0,
      Integer(PCHAR('Tümünü Evet')));
  end;
  if FindWindowEx(H, 0, 'TButton', '&Close') <> 0 then
  begin
    SendMessage(FindWindowEx(H, 0, 'TButton', '&Close'), WM_SETTEXT, 0,
      Integer(PCHAR('Kapat')));
  end;

end;
Daha sonra TApplicationEvent nesnesinin OnMessage Eventine.
procedure TfrmMain.ApplicationEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
var
  H: HWND;
begin
  H := FindWindow('TMessageForm', 'Information');
  if H <> 0 then
  begin
    SendMessage(H, WM_SETTEXT, 0, Integer(PCHAR('Bilgi')));
    ConvertToTurkish(H);
    exit;
  end;
  H := FindWindow('TMessageForm', 'Warning');
  if H <> 0 then
  begin
    SendMessage(H, WM_SETTEXT, 0, Integer(PCHAR('Dikkat')));
    ConvertToTurkish(H);
    exit;
  end;
  H := FindWindow('TMessageForm', 'Error');
  if H <> 0 then
  begin
    SendMessage(H, WM_SETTEXT, 0, Integer(PCHAR('Hata')));
    ConvertToTurkish(H);
    exit;
  end;
  H := FindWindow('TMessageForm', 'Confirm');
  if H <> 0 then
  begin
    SendMessage(H, WM_SETTEXT, 0, Integer(PCHAR('Onay')));
    ConvertToTurkish(H);
    exit;
  end;
end;

Regular Expression(Delphi)

Bilindiği üzere artık delphi de de Regular Expressions kullanabiliyoruz.Bana da ömrü hayatım boyunca bugün kullanmak nasib oldu
Edite bilgi girerken ;
İlk iki karakteri ÜP ile başlayıp, devamındaki 7 karakterin sayısal olması, tire(-), T1,T2,T3 gibi şeklinde bir giriş olacaktı.
Yani ;
ÜP1234567-T1 (Doğru)
ÜP1234567-T2 (Doğru)
ÜP1234567-T3 (Doğru)

ÜP1234567-T5 (Yanlış) T1,T2,T3 olabilir
KS1234567-T1 (Yanlış) KS ile başlayamaz.
KS1H34567-T1 (Yanlış) 1 den sonra H karakteri var.0 ile 9 arasında bir değer olması lazım.

Bunun için kullandığım RegEx pattren [ÜP]{2})([0-9]{7})[-]([T][1-3]{1} budur.

uses'e RegularExpressions unitini ekleyin.

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    if TRegEx.IsMatch(editValue.Text, editPattern.Text) then
      ShowMessage('tamam')
    else
      ShowMessage('olmadı');
  except

    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

Regular Expression kullanarak veri girişlerini kontrol etmek daha kullanışlı gibi geldi bana. Neden derseniz.
ÜP1234567-T1 şeklindeki bir verinin formatını kontrol etmek için.Bir ton takla atmamız gerecekti.Delphi tarafında.
Bir ton ifler,string parçalaması vs.
Kaldıki statik bir yöntem olacaktı.

Ama şimdi [ÜP]{2})([0-9]{7})[-]([T][1-3]{1} şeklindeki bir desen ile kontrol etmek daha kolay.Neden ?
Yarın derselerki ÜP ile başlamasın efendim.Benim bir dediğim,diğer dediğimi tutmaz.Bu Başlarken A ile C arasında değer girilsin derseler.
Sadece [A-C]{2})([0-9]{7})[-]([T][1-3]{1} diye deseni değiştirmesi daha teknik olacaktır.Diye düşünüyorum.
Hem deseni istersek harici bir dosyadan da okuma çok pis teknik olacaktır.

Ve bu iş hazırlanmış bir web uygulaması : http://gskinner.com/RegExr/
Desen hazırlarken ki karakterlerin anlamları adreste mevcut

frxPreview Nesnesinde Nasıl Resim Gösterebiliriz

Rapor önizleme yapılıp ,daha sonra resim formatında export ettikten sonra.Rapor resimlerinin gösterilmesi ihtiyacı için hazırladım.

var
  Page: TfrxReportPage;
begin
  Page := TfrxReportPage.Create(frxReport1);
  Page.BackPicture.LoadFromFile('dosya.jpg');

  frxReport1.PreviewPages.AddPage(Page);
  frxReport1.ShowReport;
end;

TField için Validator

Dataset’teki Verinin, kaydedilmeden önce( TBL_UserBeforePost) doğrulanması için, TField class’ına Eklenti olarak yazdığım fonksiyonlardır.
{ İsmail Kocacan }
unit uValidation;
interface
uses

   SysUtils, Variants, Classes, DB,RegularExpressions;

type
  TFieldValidatorHelper=class Helper for TField
  public
      function IsMailFormat:Boolean;
      function IsIPFormat:Boolean;
      function IsURLFormat:Boolean;

  end;

implementation

{ TFieldValidatorHelper }
function TFieldValidatorHelper.IsIPFormat: Boolean;
begin
  Result:=TRegEx.Create('(([0-9]){1,3}.){1,3}[0-9]{1,3}').IsMatch(Trim(Text));
end;

function TFieldValidatorHelper.IsMailFormat: Boolean;
begin
  Result:=TRegEx.Create('^([\w\.-]{1,64}@[\w\.-]{1,252}\.\w{2,4})$').IsMatch(Trim(Text));
end;

function TFieldValidatorHelper.IsURLFormat: Boolean;
begin
  Result:=TRegEx.Create('^(https?)://[^\s/$.?#].[^\s]*$').IsMatch(Trim(Text));
end;
end.

TObjectListde Değere Göre Sıralama

Diyelim ki elinizde Key ve Value lardan oluşan bir Object List var.
Key'iniz String.
Value niz Sayı.
Sizde Valuye göre sıralamak istiyorsunuz.

Çözüm :

unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  Generics.Defaults,
  Generics.Collections;
type


  //Liste saklayacağımız ikili değer
  TItemKeyValuePair = class
    fvalue: Integer;
    fkey: string;
  end;

  //Object Listemiz
  TObjectList = class(TObjectList)
  end;

  TForm1 = class(TForm)
    btnSortList: TButton;
    ListBox1: TListBox;
    procedure btnSortListClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnSortListClick(Sender: TObject);
var
  objList: TObjectList;
  itemKeyVal: TItemKeyValuePair;
begin
  objList := TObjectList.Create();

  itemKeyVal := TItemKeyValuePair.Create;
  itemKeyVal.fvalue := 20;
  itemKeyVal.fkey := 'dosya1';
  objList.Add(itemKeyVal);

  itemKeyVal := TItemKeyValuePair.Create;
  itemKeyVal.fvalue := 10;
  itemKeyVal.fkey := 'dosya3';
  objList.Add(itemKeyVal);

  itemKeyVal := TItemKeyValuePair.Create;
  itemKeyVal.fvalue := 4;
  itemKeyVal.fkey := 'dosya2';
  objList.Add(itemKeyVal);

  //value ye göre sırala
  objList.Sort(
    TComparer.Construct(
      function(const left,rigth:TItemKeyValuePair): Integer
      begin
          if left.fvalue < rigth.fvalue then
              Result := -1
            else if left.fvalue > rigth.fvalue then
              Result := 1
            else
              Result := 0;
      end));

  for itemKeyVal in objList do
  begin
    ListBox1.Items.Add(
    itemKeyVal.fkey+' ='+
    IntToStr(itemKeyVal.fvalue));
  end;

objList.Free;
end;
end.

Rtti CallProc

Nesnelerin, parametresiz prosedürlerini, isimden çağırmak için yazdığım bir prosedür.
uses
  Rtti,
  Classes;

procedure CallProc(AClass: TClass; AInstance: TObject;ProcedureName: string);
var
  r:TRttiContext;
  t:TRttiType;
  params:array of TValue;
begin
  r:=TRttiContext.Create;
  t:=r.GetType(AClass);
  t.GetMethod(ProcedureName).Invoke(AInstance,params);
  r.Free;
end;

Bir sınıftan türeyen alt sınıfların listesi(Rtti)

// Bir class'tan türeyen alt class'ların listesini döndürür

uses
   Rtti,
   TypInfo,
   Classes;

function GetSubClassList(AClass: TClass): TStrings;
var
  atypes:TArray;
  atype:TRttiType;
  alist:TStringList;
begin
   r:=TRttiContext.Create;
   atypes:=r.GetTypes;

   alist:=TStringList.Create;
   for atype in atypes do
   begin          
      if (atype.TypeKind=tkClass) and atype.IsInstance and
          atype.AsInstance.MetaclassType.InheritsFrom(AClass)
         and (atype.Name<>AClass.ClassName) then
         begin
            alist.Add(atype.Name);
         end;
   end;
  //atype.AsInstance.BaseType.MetaclassType.ClassName
  Result:=alist;
end;

 // Kullanımı

 ShowMessage(GetSubClassList(TControl).Text);

TProc Kullanımı

{İsmail Kocacan}
unit uTasks;

interface
uses
  SysUtils,
  ExtCtrls,
  Forms;

type
  TTask = class
  private
    FProc: TProc;
    FTimer: TTimer;

    procedure OnTimer(Sender: TObject);
  public
    procedure Run(AProc: TProc);
    procedure Start;
    procedure Stop;
    constructor Create;
    destructor Destroy;
  end;

implementation

{ TTask }
constructor TTask.Create;
begin
  inherited;
  FTimer := TTimer.Create(Application);
  FTimer.Interval := 50000;
end;

procedure TTask.Run(AProc: TProc);
begin
  FProc := AProc;
  FTimer.OnTimer := OnTimer;
end;

procedure TTask.Start;
begin
  FTimer.Enabled := True;
end;

procedure TTask.Stop;
begin
  FTimer.Enabled := false;
end;

destructor TTask.Destroy;
begin
  FTimer.Free;
end;

procedure TTask.OnTimer(Sender: TObject);
begin
  FProc();
end;

end.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;

implementation

uses uTasks;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  ATask: TTask;
begin
  ATask:=TTask.Create;
  ATask.Run(
    procedure
     begin
       Memo1.Lines.Add('Çalışıyor...');
     end
  );
  ATask.Start;
end;

end.

Bir prosedüre referans gösteren tip diye açıklayabiliriz.
Benim örnektede Run Prosedürünün parametresine bir procedüre gövdesi geçtik.
Detaylar SysUtils.pas 3903 den itibaren başlıyor.
İyi Çalışmalar

TPredicate(T) Kullanımı

{
 İsmail Kocacan
 TPredicate Kullanımı
}
unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls;

type

  TStringListHelper = class helper for TStringList
    function Where(Condition: TPredicate): TStringList;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
 
  public

  end;

var
  Form1: TForm1;




implementation

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
var
  AList: TStringList;
begin
  AList := TStringList.Create;
  AList.Add('Ali');
  AList.Add('Veli');
  AList.Add('Deli');
  AList.Add('İsmail');

  Memo1.Lines.AddStrings(
      AList.Where(
              function(Arg: Integer): Boolean
                  begin
                    Result := Arg > 3;
                  end
      )
  );

  AList.Free;
end;


{ TStringListHelper }
function TStringListHelper.Where(Condition: TPredicate): TStringList;
var
  I: Integer;
  NewList: TStringList;
begin
  NewList := TStringList.Create;
  for I := 0 to Self.Count - 1 do
  begin
    if Condition(Length(Self[I])) then
      NewList.Add(Self[I]);
  end;
  Result := NewList;
end;

end.

Yukarıdaki örnekte TStringList'e Where isminde bir extension(uzanım) fonksiyon yazdık.
Bu fonksiyon TStringList de bulunan,karakter sayısı 3 den büyük elemanları, yeni bir liste olarak geriye döndürür.

C# Predicate Kullanımı Bknz : http://msdn.microsoft.com/en-us/library/bfcke1bz.aspx
C# Extension Method Kullanımı Bknz : http://msdn.microsoft.com/en-us/library/bb383977.aspx

Rtti Ortak Method Çağırma(Poliformizm İçerir)

{ By İsmail Kocacan }
unit uReflection;
interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,

  System.Rtti,
  System.TypInfo;

type
  TForm1 = class(TForm)
    Button1: TButton;
    lBox: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TTabanClass = class abstract(TObject)
  protected
    procedure Guncelle; virtual; abstract;
  end;

  TGumrukYonetmeligi = class(TTabanClass)
  public
    procedure Guncelle; override;
  end;

  TTebligler = class(TTabanClass)
  public
    procedure Guncelle; override;
  end;

var
  Form1: TForm1;

  atebligler: TTebligler;
  agumrukyonetmeligi: TGumrukYonetmeligi;

implementation

{$R *.dfm}

{ TTebligler }
procedure TTebligler.Guncelle;
begin
  ShowMessage('Tebliğler Güncellendi...');
end;

{ TGumrukYonetmeligi }
procedure TGumrukYonetmeligi.Guncelle;
begin
  ShowMessage('Gümrük Yönetmeliği Güncellendi...');
end;



procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRttiContext;
  rtype: TRttiType;
  obj: TObject;
begin
  r := TRttiContext.Create;
  for rtype in r.GetTypes do
  begin
    if (rtype.TypeKind = tkClass) and rtype.IsInstance and
      rtype.AsInstance.MetaclassType.InheritsFrom(TTabanClass) and
      (rtype.Name <> TTabanClass.ClassName) then
    begin
      lBox.Items.Add(rtype.Name);
      obj := rtype.AsInstance.MetaclassType.Create;
      TTabanClass(obj).Guncelle;
    end;
  end;
  r.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  atebligler         := TTebligler.Create;
  agumrukyonetmeligi := TGumrukYonetmeligi.Create;
end;
end.

Yukarıda TTabanClass isminde soyut bir sınıf ve bu sınıfa ait Guncelle isminde soyut bir prosedür var.
TGumrukYonetmeligi ve TTebligler sınıfları TTabanClass isimli sınıftan türetilmiş ve Güncelle prosedürlerinin gövdeleri yapılandırılmıştır.
FormCreate eventinde de TTabanClass sınıfından türetilen TTebligler ve TGumrukYonetmeligi sınıflarından birer tane nesne referansı oluşturulmuştur.

Şimdi benim yapmak istediğim de şuydu.
"TTabanClass" sınıfından türeyen tüm sınıfların,nesne referanslarının, ortak methodu olan "Guncelle" prosedürünü çalıştırmaktı.
Yaptım oldu  :)

Düzenlemeler : DelphiTürkiye Forum

Derleme sonrası dcu dosyalarının silinmesi

Delphi IDE ->Project->Options->Build Events->Post Build->Commands kısmına aşağıdaki komutu yapıştırın.
DEL Debug\Win32\*.dcu*

Bu sayede derleme sonrası oluşan *.dcu dosyaları otomatik silinip,ortalık ferahlıyacaktır
İyi Çalışmalar

TObjectList'in OnNotify Eventini Kullanalım

Elimizde TTask isminde bir Class'ımız ve bu class'a ait Start; isminde bir procedure'miz var.
yine TTask class'ının nesne referanslarının listesini tuttuğumuz TObjectList classından türeme bir TTaskList sınıfımız(Torbamız(!),Collection'ımız) var.

Ve şunu yapmak istiyoruz.Her taskı torbaya attığımda(eklediğimde) otomatik olarak Start; procedürü çalışsın.
Evet listeye ekledikten hemen sonra ATask.Start; şeklinde çağırabiliriz.Fakat bunu yapmak istemiyoruz....
unit uTasks;

interface

uses
  Dialogs,
  Generics.Defaults,
  Generics.Collections;
type
  TTask = class
  private
    FTaskName: string;
  public
    property TaskName: string read FTaskName write FTaskName;
    procedure Start;
  end;
  TTaskList = class(TObjectList)
  private
    procedure OnNotifyEvent(Sender: TObject; const Item: TTask;
      Action: TCollectionNotification);
  public
    constructor Create;
  end;
implementation

{ TTask }
procedure TTask.Start;
begin
  ShowMessage('Task is Started');
end;

{ TTaskList }
constructor TTaskList.Create;
begin
  inherited;
  Self.OnNotify := OnNotifyEvent;
end;

procedure TTaskList.OnNotifyEvent(Sender: TObject; const Item: TTask;
  Action: TCollectionNotification);
begin
  if Action = cnAdded then
    Item.Start;
end;
end.

unit Unit2;

interface

uses
  uTasks,
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form2: TForm2;
  ATask: TTask;
  ATaskList: TTaskList;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  ATaskList := TTaskList.Create;
  ATask := TTask.Create;
  ATask.TaskName := 'Task 1';
  ATaskList.Add(ATask);
end;
end.

27 Ağustos 2012 Pazartesi

Delphi XE3 Helpers

XE3 ile gelen yeniliklerden biride daha önce record'lara ve class'lara yazdığımız uzanım fonksiyonlarını artık temel veritiplerine de yazabiliyoruz.Bu güzel bir durum.Bak şimdi oldu :)
unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs;

type
  TDoubleHelper = record helper for Double
    function KareKokAl: Double;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
 sayi:Double;
begin
 sayi:=100;
 ShowMessage(FloatToStr(sayi.KareKokAl));
end;

{ TDoubleHelper }
function TDoubleHelper.KareKokAl: Double;
begin
  Result:=Sqrt(Self);
end;

end.