ساخت اولين کامپوننت
-------------------------
در اينجا يک کامپوننت ساده رو آموزش مي دم تا با کليات کار آشنا بشيم.
کامپوننتي که انتخاب کردم کامپوننت RainbowLabel هست که مي خوام کاري کنم که ليبل رنگش عوض بشه. خيلي موضوع رو پيچيده نمي کنم و خيلي ساده مي نويسم.
براي ساخت اولين کامپوننت اول از همه بايد يک يونيت جديد درست کنيم.
در يونيت جديد يک کلاس مي سازيم با نام کامپوننتي که مي خواهيم براي ما بوجود بياد.
نکته ي خيلي خيلي مهم:
هرگز کامپوننتتون رو از همون ابتدا و قبل از تست نصب نکنيد. ممکنه گند بخوره تو محيط کاري دلفي تون.
هميشه از کلاسش در ران تايم شي بگيريد و تست کنيد و آزادش کنيد تا خوب تست بشه.
قدم به قدم پيش مي ريم:
يونيتتون رو ايجاد کنيد و همين دم در ذخيرش کنيد. من به اسم Rainbow ذخيرش کردم.
يک کلاس مي سازيم به نام TRainbowLabel. از جايي که اين کلاس قراره يک ليبل باشه بايد از ليبل مشتق بشه. اما قبل از اين کار بريم ببينيم ليبل چطور ساخته شده. اگر سورس رو مطالعه کنيد مي بينيد که از TCustomLabel گرفته شده و فقط داره ميدان ديد خصيصه ها رو افزايش مي ده. ما هم از همين TCustomLabel مشتق مي گيريم تا دوباره کاري نشه.
براي رفرش شدن بايد زمان مشخص شه. ما اين کار رو با يک تايمر انجام مي ديم.
باقي توضيحات رو در سورس مي گذارم.
unit Rainbow;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TRainbowLabel = class(TCustomLabel)
private
FTimer: TTimer; // this is a timer who is responsible to refresh periodic
FTurn: integer; // a used simple variable
FOnTick: TNotifyEvent; // this is a field to hold a event method address
// TNotifyEvent is a procedure compatible by timer event
procedure SetRefreshInterval(const Value: integer);
function GetRefreshInterval: integer;
protected
procedure DoTick(Sender: TObject); virtual; // this is a method for refreshing color
// that is virtual cause of enabling for override in derrived classes
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property RefreshInterval: integer read GetRefreshInterval write SetRefreshInterval;
property OnTick: TNotifyEvent read FOnTick write FOnTick; // adding a event
// here we increase visibility to show in object inspector
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color nodefault;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;
implementation
{ TRainbowLabel }
constructor TRainbowLabel.Create(AOwner: TComponent);
begin
inherited;
FTimer := TTimer.Create(Self);
FTimer.Interval := 100;
FTimer.OnTimer := DoTick;
FTurn := 1;
end;
destructor TRainbowLabel.Destroy;
begin
FTimer.Destroy; // be sure to release used memory
inherited;
end;
function TRainbowLabel.GetRefreshInterval: integer;
begin
Result := FTimer.Interval; // resulting our inner timer interval
end;
procedure TRainbowLabel.SetRefreshInterval(const Value: integer);
begin
if FTimer.Interval = Value then // avoiding to re-set same value
Exit;
FTimer.Interval := Value; // setting that value to inner timer interval
end;
procedure TRainbowLabel.DoTick(Sender: TObject);
var
R, G, B: integer;
begin
// calculation and changing color
R := GetRValue(Self.Font.Color);
G := GetGValue(Self.Font.Color);
B := GetBValue(Self.Font.Color);
case FTurn of
1: begin
inc(R, 10);
if R > 255 then
begin
R := R -255;
FTurn := 2;
end;
end;
2: begin
inc(G, 10);
if G > 255 then
begin
G := G -255;
FTurn := 3;
end;
end;
3: begin
inc(B, 10);
if B > 255 then
begin
B := B -255;
FTurn := 1;
end;
end;
end;
Self.Font.Color := RGB(R, G, B);
// IMPORTANT: always check your events assigned or not
// if not, you must avoid access violation
// call events on JUST ONE place, then maek your own method and call it every where
if Assigned(FOnTick) then
FOnTick(Self);
end;
end.
یک برنامه جدید ایجاد کنید و این یونیت رو در اون یوز کنید.
تست کنید.
var
rb: TRainbowLabel;
procedure TForm1.Button1Click(Sender: TObject);
begin
rb := TRainbowLabel.Create(Self);
with rb do
begin
Parent := Self;
SetBounds(10, 10, 100, 22);
Caption := 'This is a test';
RefreshInterval := 10;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
rb.Destroy;
end;
خب تا اینجا ظاهرا همه چی خوبه.
بریم برای تبدیلش به کامپوننت.
يک پکيج جديد درست کنيد و همين اول کار اون رو هم کنار فايل يونيت ذخيره کنيد.
من نام RainbowPackage رو انتخاب کردم.
از گزينه ي Add در ويزارد پکيج فايل يونيت ايجاد شدتون رو اضافه کنيد. ذخيره کنيد. همه پروژه ها رو ببنديد و دوباره پکيج رو باز کنيد.
در قسمت Contains بايد نام فايل يونيت شما بياد. روش دوبار کليک کنيد.
اگر سورس رو مشاهده مي کنيد تا اينجا رو درست انجام داديد.
حالا بايد کدهايي رو درون اين فايل اضافه کنيم تا دلفي بفهمه چه کنه.
پروسيجر زير رو دقيقا بعد از تعريف کلاستون بگذاريد:
procedure Register;
بايد، بايد و بايد حرف اولش بزرگ باشه.
اين خيلي عجيب بود براي من که دلفي در مواردي Case Sensitive هست!
دقيقا زير implementation اين پروسيجر رو تعريف کنيد.
نتيجه بايد شبيه زير باشه:
unit Rainbow;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TRainbowLabel = class(TCustomLabel)
private
FTimer: TTimer; // this is a timer who is responsible to refresh periodic
FTurn: integer; // a used simple variable
FOnTick: TNotifyEvent; // this is a field to hold a event method address
// TNotifyEvent is a procedure compatible by timer event
procedure SetRefreshInterval(const Value: integer);
function GetRefreshInterval: integer;
protected
procedure DoTick(Sender: TObject); virtual; // this is a method for refreshing color
// that is virtual cause of enabling for override in derrived classes
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property RefreshInterval: integer read GetRefreshInterval write SetRefreshInterval;
property OnTick: TNotifyEvent read FOnTick write FOnTick;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color nodefault;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
// first name is a tab name
RegisterComponents('Rainbow', [TRainbowLabel]);
end;
{ TRainbowLabel }
constructor TRainbowLabel.Create(AOwner: TComponent);
begin
inherited;
FTimer := TTimer.Create(Self);
FTimer.Interval := 100;
FTimer.OnTimer := DoTick;
FTurn := 1;
end;
destructor TRainbowLabel.Destroy;
begin
FTimer.Destroy;
inherited;
end;
function TRainbowLabel.GetRefreshInterval: integer;
begin
Result := FTimer.Interval;
end;
procedure TRainbowLabel.SetRefreshInterval(const Value: integer);
begin
if FTimer.Interval = Value then
Exit;
FTimer.Interval := Value;
end;
procedure TRainbowLabel.DoTick(Sender: TObject);
var
R, G, B: integer;
begin
R := GetRValue(Self.Font.Color);
G := GetGValue(Self.Font.Color);
B := GetBValue(Self.Font.Color);
case FTurn of
1: begin
inc(R, 10);
if R > 255 then
begin
R := R -255;
FTurn := 2;
end;
end;
2: begin
inc(G, 10);
if G > 255 then
begin
G := G -255;
FTurn := 3;
end;
end;
3: begin
inc(B, 10);
if B > 255 then
begin
B := B -255;
FTurn := 1;
end;
end;
end;
Self.Font.Color := RGB(R, G, B);
if Assigned(FOnTick) then
FOnTick(Self);
end;
end.
به ویزارد پکیج برمی گردیم و اون رو کامپایل می کنیم.
از طریق همون ویزارد هم Install می کنیم.
تبریک می گم!
اولین کامپوننتتون در تب Rainbow اضافه شد!
پاسخ با نقل قول