ساخت کامپوننت VCL به زبان ساده

[یوسف زالی]

سخن نویسنده:
------------------
سلام.
دوستان عزیز به عنوان ادای دینی نسبت به عزیزان برنامه نویس تصمیم دارم این آموزش رو تا حدی که بلدم بگذارم.
کمی و کاستی هاش رو ببخشید. نظراتتون رو هم بگید تا مواردی رو که مدنظر دارید اصلاح کنم.
خود من هم مدت زیادی از شروع یادگیریم در این خصوص نمی گذره.
کامپوننت ها رو در بستر دلفی 7 انجام می دم به چند دلیل:
اول اینکه خیلی از دوستان هنوز از نسخه های قبل استفاده می کنند.
دوم اینکه نوشتن کامپوننتی که روی ورژن های قدیمی جواب می ده معمولا روی نسخ جدید هم جواب می ده.
دلیل سوم و آخر هم اینکه روی سیستم خودم ورژن 7 نصبه! و با این نسخه کار می کنم.

قبل از شروع هم ایـــــــــــــــــــــــ ــــــــــــن (http://barnamenevis.org/showthread.php?151716-%D8%AA%D8%B9%D8%B1%DB%8C%D9%81-VCL-%D8%8C-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-%D9%88-%DA%A9%D9%86%D8%AA%D8%B1%D9%84-%D8%AF%D8%B1-%D8%AF%D9%84%D9%81%DB%8C) تاپیک رو مطالعه کنید.

دوستان گرامی در حد توان و وقت و علمم مطالب رو ادامه می دم. حالا تا هر کجاش که رسیدیم شما حلال کنید. :لبخندساده:
ان شا ا... فایل های تصویری سر فرصت آماده می شه و اضافه می شه.


تیتر مطالب
-------------
پکیج و کامپوننت (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1757621&viewfull=1#post1757621)
کلیاتی راجع به کلاس ها (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1757900&viewfull=1#post1757900)
ساخت اولین کامپوننت (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1757935&viewfull=1#post1757935)
کلیاتی راجع به کامپوننت ها (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1760676&viewfull=1#post1760676)
رویداد ها در کامپوننت (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1763074&viewfull=1#post1763074)
خصیصه هایی از نوع کامپوننت در کامپوننت (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1769185&viewfull=1#post1769185)
مسیج ها در کامپوننت (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1791679&viewfull=1#post1791679)
ساخت یک کامپوننت ساده (http://barnamenevis.org/showthread.php?396089-%D8%B3%D8%A7%D8%AE%D8%AA-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA-VCL-%D8%A8%D9%87-%D8%B2%D8%A8%D8%A7%D9%86-%D8%B3%D8%A7%D8%AF%D9%87&p=1838698&viewfull=1#post1838698)
استفاده از ریسورس ها در کامپوننت
ساخت یک کامپوننت چند تکه ای (مثل TLabledEdit)
بررسی اجمالی چند کلاس (مثل TControl)
ساخت یک کامپوننت با اتصال به دیتابیس
تفکیک یک پکیج به دو پکیج RunTime و DesignTime و اهمیت انجام این کار
ساخت ویرایش گر خصیصه
ساخت ویرایش گر کامپوننت
نکات متفرقه

[یوسف زالی]

پکیج و کامپوننت
------------------

تعریف:
یک کامپوننت چیزی جز یک شی از کلاس TComponent یا زیرکلاسهای اون نیست. این اشیا دارای خصوصیاتی هستند که در برنامه نویسی دلفی خیلی کاربرد پیدا می کنند، از جمله این خصوصیات، قرار گرفتن اونها روی فرم یا دیتاماژول و درنتیجه اضافه شدن کد ساخت اونها به فایل DFM همنام هست. خصوصیت مهم دیگه آوردن برخی خصوصیات اونها در لیست Object Inspector است و در نتیجه تنظیم آسان و کاربرد راحت اونهاست. شما می تونید لیستی از تعریف کامپوننتها رو در قالب یک Package ذخیره کنید و اون رو انتقال بدید تا یکی دیگه اونها رو نصب کنه و استفاده کنه. بعد از نصب پکیج اونها در یک یا چند Tab در IDE ظاهر خواهند شد.
می تونید لیستی از کامپوننتهای استفاده شده رو از طریق خصوصیت Components ببینید.

توجه:

خصوصیات Components و Controls رفتار های متفاوتی دارند. برای تست می تونید یک ادیت درون یک پنل بگذارید و ببینید. Components برای فرم تمام کامپوننتهای بکار رفته در فرم رو در اختیار شما قرار می ده. یعنی اون ادیت رو هم حساب می کنه اما Controls درختی نیست و فقط کامپوننت هایی از نوع کنترل رو اون هم در شاخه ی اصلی درخت کامپوننت ها براتون در دسترس قرار می ده.

ببینید:


var
i: integer;
begin
for i := 0 to ComponentCount -1 do
ShowMessage(Components[i].Name);

for i := 0 to ControlCount -1 do
ShowMessage(Controls[i].Name);
end;


برای پیمایش کنترل ها باید درخت رو پیمایش کنید (با یکی از روشهای پیمایش، معمولا بازگشتی) پس حواستون باشه اگر قصد داشتید تمام اشیای یک فرم رو ببینید باید این نکته رو مد نظر داشته باشید.

تصویر بکار رفته برای کامپوننتی که شما می نویسید اگر به طور مستقیم اشاره نشه، از اولین آیکون پدر خواهد بود و اگر کلاس پدر هم آیکونی نداشت یک آیکون پیش فرض به اون اختصاص پیدا می کنه.
هر پکیج می باید فایل های سورس کامپوننت ها رو در خودش معرفی کنه. اگر لازمه ریسورس های بکار رفته رو هم معرفی کنه. معمولا این ریسورس ها همنام با فایل Pas معرفی شده هستند با پسوند DCR.
بعد از کامپایل موفقیت آمیز یک پکیج در شاخه ای از برنامه که از قبل Set شده یک فایل هم نام با پکیج با پسوند BPL ایجاد خواهد شد که برای نصب بکار می ره. این مسیر برای دلفی 7 آدرس C:\Program Files\Borland\Delphi7\Projects\Bpl و برای XE آدرس C:\Users\Public\Documents\RAD Studio\8.0\Bpl است. (الیته روی سیستم من!)
طریقه ی استفاده از این فایل معمولا به صورتی هست که دیگه نیازی به گذاشتنش کنار برنامه ندارید. الیته می تونید با عوض کردن تنظیمات کاری کنید که به جای ورود کدها به EXE اون رو همراه برنامه منتشر کنید.
می تونید کاری کنید که پکیج شما فقط در یکی از زمانهای کامپایل یا ران تایم استفاده بشه.

فایل های BPL نوع خاصی از فایل های کتابخانه ای هستند که مثل اکتیواکس ها در زمان کامپایل و طراحی هم مواردی رو در دسترس قرار می دن.
شما اجباری به پکیج کردن کامپوننتهای نوشته شدتون ندارید اما در این صورت باید اونها رو مثل کلاس های معمولی استفاده کنید و کد ساختشون رو دستی بنویسید.

نکته: در صورتی که در کامپوننت نوشته شدتون از کامپوننتهای دیگه ای استفاده کرده باشید بعد از نصب اون کامپوننت و استفاده از اون، کل شی گرفته شده از کامپوننت شما در شمارش، یک کامپوننت محسوب خواهد شد.

[یوسف زالی]

کلياتي راجع به کلاس ها
---------------------------
براي ساخت کامپوننت مي بايد از تسلط متوسطي روي شي گرايي برخوردار باشيد. به اين معني که چندريختي رو درک کنيد، براندازي متدها رو بلد باشيد، در مورد گرفتن و پس دادن حافظه دانشتون کافي باشه، کار با Property ها و ساخت اون ها رو بلد باشيد (تا حد آرايه اي) و يه کوچولو هم مسيج ها رو بشناسيد.

در حالت کلي ساخت کامپوننت جز در چند جا با ساخت کلاس تفاوت چنداني نداره.
نکاتي که به نظرم مي رسه براي ساخت کامپوننت در مورد کلاس ها بگم اينهاست:

- در مورد کجا گذاشتن Property ها مطمئن باشيد. هميشه اونها رو در Public يا Published نگذاريد. ممکنه شرايطي پيش بياد (باور کنيد درست کردنش خيلي سخت مي شه) که وجود دو تا پراپرتي در قسمت Pulished کامپوننتتون رو به حالت هنگ مي بره. فقط چيزهايي رو که واقعا لازم داريد در اين قسمت بگذاريد.

- در مورد Private کردن متغير هاتون مطمئن بشيد تا وقتي از روي اين کلاس يک زير کلاس مي گيريد دچار اشکال نشيد.

- براي تمام کارهاي تکراري که انجام مي ديد حتما متد هايي در نظر بگيريد. اين طوري براي اصلاح اون کار نيازي نداريد تمام کلاس رو شخم بزنيد.

- در مورد رفرش کردن کامپوننت و نحوه و تعداد اون، چه در مود نمايشي چه براي رفرش داده مطمئن بشيد. تعداد و چگونگي و زمان رفرش کردن ها بسيار اهميت داره و مي تونه کامپوننت يا کلاس شما رو بي مصرف کنه.

- تا حد امکان از اشياي جديد و پرهزينه يا آرايه هاي باز و دايناميک در کلاس هاتون استفاده نکنيد. فقط در مواقع خيلي خيلي ضروري از اشاره گرها يا ليست هاي پيوندي استفاده کنيد.

- اشياي بکار رفته در کلاستون رو تا حد امکان خودتون آزاد کنيد.

- از نام گذاري هاي عجيب يا تکراري که با خود سيستم تداخل دارند اجتناب کنيد.

- معمولا انواعي که لازم داريد در سيستم وجود دارند. قبل از ايحاد انواع مختلف يه سرچي در سورس دلفي انجام بديد.

- از ايجاد کلاس هاي واسطه اصلا نترسيد و اگر لازم بود کلاسي که مي خواهيد ايجاد کنيد رو به چند زير کلاس اشتقاقي تقسيم کنيد. معمولا يکي مونده به آخرين کلاس مد نظر شما همراه با نام Custom هست و اکثر خصوصياتش Protected هستند که در کلاس نهاييتون اونها رو افزايش Visibility مي ديد.

- قبل از ابجاد کامپوننت يا کلاس جديد، خوب فکر کنيد که نزديکترين کلاس به کلاس مد نظر شما چيه و يک کم در مورد سورس اون مطلب بخونيد.

- متد هايي که مسئول رفتار کامپوننتتون هستند رو Virtual در نظر بگيريد تا در هنگام لزوم در کلاس هاي فرزند اون ها رو براندازي کنيد.

- براي همه ي متغيرهاي استفاده شده در کلاستون مقادير پيش فرض در نظر بگيريد. حتي اگر مطمئن باشيد که سيستم خودش پيش فرض مطلوب رو در نظر مي گيره. اگر لازم هست مقادير پيش فرض رو از کاربر در متد سازنده دريافت کنيد يا متد سازنده رو OverLoad کنيد.

[یوسف زالی]

ساخت اولين کامپوننت
-------------------------
در اينجا يک کامپوننت ساده رو آموزش مي دم تا با کليات کار آشنا بشيم.
کامپوننتي که انتخاب کردم کامپوننت 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 اضافه شد!

[developing]

با سلام

معمولا توی توابع مقداردهی (Set کردن ها) به جای روش شما که به شکل زیر هست:
و سربار زیادی برای کامپوننت ایجاد می کنه.(در مواقعی که ست کردن های زیادی داشته باشیم)


if FTimer.Interval = Value then // avoiding to re-set same value
Exit;

FTimer.Interval := Value; // setting that value to inner timer interval


از روش زیر استفاده می شه:


if FTimer.Interval <> Value then // avoiding to re-set same value
FTimer.Interval := Value; // setting that value to inner timer interval

[یوسف زالی]

سربار زیادی برای کامپوننت ایجاد می کنه

چجوری سربار زیادی ایجاد می کنه؟!
الان اون دو خط چه فرقی داشت مهندس؟
کد اسمبلیش رو دیدی؟

دوستان نظر بدید تا نقاط ضعف مشخص شه.
تونستید کامپوننت رو راه بندازید؟
چه اشکالاتی داشتید؟

[soft-c]

یک سوال
اون published هایی را که خودمون جدید می خواهیم بنویسیم را چطوری مقدار دهی می کنیم ؟

[یوسف زالی]

برای مقدار دهی های اولیه در کلاس می تونید از Constructor کلاس استفاده کنید.
معمولا اگر خصیصه شما دارای یک فیلد نگهدارنده در Private هم باشه، برای مقداردهی از همون فیلد استفاده می شه.

[یوسف زالی]

کلياتي راجع به کامپوننت ها
-------------------------------
خب دوستان در ادامه بررسي ساخت کامپوننت مي بايد نکاتي رو قبل از ورود به بحث جديد مد نظر داشته باشيد.
در اينجا به اين نکته ها مي پردازيم.
روي همون کامپوننتي که باهم نوشتيم حرفهام رو ادامه مي دم.

اولين چيزي که در اين کامپوننت سريعا نظر ما رو جلب مي کنه تغيير رنگ اين کامپوننت حتي در زمان Design Time هست. يعني به محض گذاشتن اون روي فرم، رنگ ليبل شروع مي کنه به تغيير کردن.
اين امر ممکنه در سطح وسيع اشکالاتي رو ايجاد کنه يا در زمان طراحي سبب کندي سيستم بشه. چون رفرش شدن هاي متوالي اون در هر حال زماني رو مي طلبه.
از طرفي ما معمولا دوست داريم در زمان ران تايم حرکت و Motion ببينيم و عادت نداريم که کامپوننت براي ما در همون زمان طراحي شمايلش رو تغيير بده.

براي فهميدن اينکه الان در چه مودي هستيم، از خصيصه ComponentState استفاده مي کنيم.
وقتي csDesigning در اين مجموعه وجود داشته باشد به اين معني هست که کامپوننت در حالت ران نيست و در حالت طراحي قرار دارد.
براي تست کافيه اين کد رو اصلاح کنيد:


procedure TRainbowLabel.DoTick(Sender: TObject);
var
R, G, B: integer;
begin
if csDesigning in ComponentState then
Exit;

R := GetRValue(Self.Font.Color);
G := GetGValue(Self.Font.Color);
B := GetBValue(Self.Font.Color);
.
.


يادتون باشه، وقتي در اين سطح داريد کامپوننت رو اصلاح مي کنيد، يعني سطحي که دلفي بايد رفتار IDE خودش رو در قبال کامپوننتتون عوض کنه، نياز داريد يک بار ديگه کامپوننتتون رو کامپايل و Install کنيد.
اين کار رو با همون ويزارد انجام مي ديم.

خب، دوستان همون طور که مي بينيد وقتي کامپوننت رو روي فرم مي گذاريم تفاوتي در رنگ اون مشاهده نمي کنيم اما به محض ران شدن، مي بينيم که کامپوننت شروع کرد به تغيير رنگ.

اين کار خيلي لازمه. يعني در حالت معمول نميان اجازه بدن که کامپوننت رفتارش رو در زمان طراحي نشون بده.

نکته ديگه اين که همون طور که احتمالا متوجه شديد در تب Object Inspector Properties يک خصيصه با نام RefreshInterval اضافه شده و در همونجا در تب Events هم رويداد OnTick رو مي بينيد.

علت اضافه شدن اين خصيصه ها به اونجا PUBLISHED بودن اونهاست. دوستان به عمد اين کلمه رو Bold کردم تا يادمون باشه که چيزي که باعث مي شه يک خصيصه در اونجا ظاهر بشه، همين امره.
پس مهم ترين تفاوت Published و Public رو هم به طور ضمني فهميديم.
اگر روي فرم راست کليک کرده و View as text رو بزنيد مي بينيد که اين خصيصه اسمش و مقدارش آورده شده. اين کار به دليل اينه که دلفي مقدار اين خصيصه رو بفهمه چي ست کرديد و در فايل DFM همنام فرم قرارش مي ده.
در حقيقت به زبان فني تر مي تونيم بگيم که براي اون RTTI توليد شده.

مطلبي که بايد بدونيد اينه که چرا همه خصوصياتي که مشاهده مي کنيم در اين قسمت ديده نمي شند؟ يا به بيان ديگه اين که دلفي از کجا مي فهمه و نمياد تمام مقادير رو وارد DFM کنه؟

علت اين کار Default شدن بعضي از اين مقاديره.
توجه کنيد:
در کامپوننتي که نوشتيم اين خط رو به اين اصلاح کنيد (نياز به نصب مجدد):


property RefreshInterval: integer read GetRefreshInterval write SetRefreshInterval default 100;

اون کلمه Default باعث مي شه که اگر مقدار اين خصيصه غير از مقدار داده شده بود دلفي بياد ذخيرش کنه. (البته براي سادگي اين رو مي گم، کارش چيز ديگه است.)

در قسمت Object Inspector شي مون ببينيد، مقدار RefreshInterval فقط وقتي که 100 نيست Bold مي شه.
مي تونيد در ارث بري از کلاسي که براي خصيصه هاش Default نداره Default ست کنيد يا اگر داره با NoDefualt اون رو از بين ببريد.

نکته ديگه اينه که مي تونيد کاري کنيد که مقدار دست خورده ي خصيصه هاتون در فايل DFM وارد نشه. خب معلومه که ست کردن يا نکردنش در اين حالت در زمان ران تايم اثري روي رفتار کامپوننت نداره. ببينيد (نياز به بازنصب):


property RefreshInterval: integer read GetRefreshInterval write SetRefreshInterval stored false;

نکته ديگه اي که لازم مي دونم بگم اينه که حواستون باشه موقعي که داريد کامپوننت رو Create مي کنيد اگر مقدار Property اي رو اصلاح کنيد که براش متد Set نوشته شده، باعث مي شيد اون متد ران بشه.
در اينجا مقدار RefreshInterval چنين وضعي داره.
معمولا اين کار رو انجام نمي دن که روند طراحي از دستشون در نره و از اجرا شدن و تست هاي مکرر جلوگيري کنن. مي دونيد که با گذاشتن يک کامپوننت روي فرم، متد Ctreate ران مي شه و طبعا ممکنه با درگير شدن با چنين مساله اي باعث بشيم که زمان گذاشتن کامپوننت روي فرم افزايش پيدا کنه.

چاره جيه؟
چاره اينه که مستقيم مقاديري رو اصلاح مي کنن که نگه دارنده ي مقادير اون خصيصيه هست. در اينجا مي شه FTimer.Interval.

ببينيد کلکي که در همين خصيصه زدم (انتصاب و خواندن از شي تايمر) شما رو از نگه داري يک فيلد خصوصي براي مقدار RefreshInterval و ست کردن تايمر از روي اون بي نياز مي کنه.

يادتون باشه، هيچ وقت در متد Write يا همون Set يک خصيصه نيايد و مقدار اون خصيصه رو با به کار بردن نام خصيصه ست کنيد. اين کار باعث مي شه کامپوننت به حلقه ي بي نهايت بيفته چون براي ست کردن با استفاده از نام خصيصه مي بايد دوباره متد Set ران بشه. شما بايد از مقادير نگه دارنده استفاده کنيد و دليل اينکه دلفي براتون يک متغير که اولش F داره براتون مي سازه همينه. البته اگر از متد Set استفاده نمي کنيد که هيچ چي!

يک نکته ديگه رو بايد اضافه کنم و اينه که اگر داريد دو تا خصيصه ايجاد مي کنيد که از روي هم ديگه ست مي شند، حواستون به نيفتادن در دام حلقه باشه.
فرض کنيد دو تا خصيصه مي خواهيد ايجاد کنيد مثلا يکي براي تاريخ شمسي يکي ميلادي که از روي هم ست مي شند، اگر کاربر يکيش رو اصلاح کنه شما بايد تشخيص بديد و از دوباره ست شدن اين خصيصه از روي اون يکي جلوگيري کنيد که در حلقه نيفتيد.

توصيه مهم:
در مواقعي که چند تا خصيصه از روي هم ست مي شوند، فقط يکي از اونها رو Published کنيد.

شما مي تونيد کاري کنيد که کاربر نتونه مقدار دلخواهش رو در Object Inspector وارد کنه و با ترک اونجا، مقدار شما دوباره ست بشه.

يادمه در خصيصه ورژن يک کامپوننت ارسال به اکسل و يا Fast ديده بودم.
خب کاري نداره.
کافيه براي خصوصيت دلخواهتون متد Set داشته باشيد ولي داخل متد ست فقط دو تا Slash بگذاريد.
اين کار باعث مي شه کامپايلر اون رو بهينه نکنه و حذفش نکنه.
البته اگر در نسخ جديد کامپايلر باهوش تر شده باشه مي تونيد يک دستور الکي جاش بگذاريد.

فکر مي کنم براي اين جلسه کافي باشه.
دوستان عزيز نظر ندادن شما علاوه بر اين که باعث دلسردي مي شه، نمي گذاره بدونم که تا به اينجا توضيحات کافي / ناکافي / گنگ / نادرست بوده يا نه.
از دادن نظر دريغ نکنيد.

[hp1361]

سلام

خیلی خوبه که تجربه سالهای سال کار کردنتون رو به اشتراک میزارید و شاید همین نکات برای هر کدوم از خوانندگان ساعت ها و حتی روزها وقت تلف کنه برای رسیدن بهش!

ولی پیشنهاد میدم نکات رو در قالب آموزش قرار بدید تا اینکه بصورت موردی بهش اشاره کنید. چون من خواننده که هنوز خیلی با نوشتن کامپوننت آشنا نشدم شنیدن نکات باعث گیج شدنم میشه.(مثل موسسات کنکوری که کلی نکته طلایی و نقره ای و برنزی میگن و دانشجو بیچاره غرق در نکات میشه!)

موفق باشیم

[یوسف زالی]

رویداد ها در کامپوننت
-----------------------
این جلسه در مورد رویداد ها صحبت می کنم.

رویداد ها چیزی جز نگهدارنده ی آدرس یک متد نیستند.
رویداد در حقیقت مثل یک متغیر از نوع پروسیجر است که در مواقعی تصمیم می گیریم اون رو کال کنیم.
این مثال رو ببینید:


var
x: procedure(Sender: TObject);

procedure Proc1(Sender: TObject);
begin
ShowMessage('Proc1 for ' + Sender.ClassName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
x := Proc1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
x(Sender);
end;


در اینجا x یک نگه دارنده آدرس پروسیجر است.

نکته:
برای ایجاد یکی از همین نگه دارنده ها در Property حتما باید نوع اون متد باشه، یعنی این که پروسیجری از یک شی باشه.

مثال:


x: procedure(Sender: TObject) of Object;


یا حتی:


x: TNotifyEvent;


خب، اگر همین متغیر رو به عنوان یک خصیصه در یک کلاس بگذاریم، یعنی یک رویداد درست کردیم!

همین!

فقط باید تحت شرایطی اون رو کال کنیم.
برای کال کردن اون هم باید قبلش تست کنیم ببینیم این متغیر آدرسی رو در خودش نگه داشته یا نه.

ببینید،
وقتی روی یک فرم یک دکمه می گذارید و روش کلیک می کنید تا رویداد OnClick براتون ایجاد بشه، در حقیقت در DFM یک انتصاب برای یک متغیر رویداد انجام می شه.
می تونید این رویه رو با View as Text فرم مشاهده کنید.

توصیه مهم:
وقتی یک رویداد درست می کنید برای جلوگیری از تکرار و نیز برای کنترل روی رویداد در کلاس های مشتق شده، لازمه که یک پروسیجر در قسمت Protected اضافه کنید که Virtual (یا Dynamic) باشه.
درون این پروسیجر تست انتصاب برای رویداد و کارهای لازمه رو انجام می دید. هر کجا لازمه این پروسیجر رو کال می کنید. در کلاس های مشتق شده هم دستتون بازه که رفتار اون رو اصلاح کنید.

در همین مثال که زده شد، رویداد OnTick رو ببینید.


procedure DoTick(Sender: TObject); virtual;

.
.


property OnTick: TNotifyEvent read FOnTick write FOnTick;


ببینید در کجا کال می شه:


FTimer.OnTimer := DoTick;


این یعنی هروقت تایمر رویدادش اتفاق افتاد رویداد ما رو جاش بگذار.
و چگونه رویداد ران می شه:


.
.
if Assigned(FOnTick) then
FOnTick(Self);

یک مثال دیگه رو ببینیم. می خواهیم ببینیم که رویداد OnDropDown شی ComboBox کی کال می شه و چطور می تونیم کارکردش رو در یک کلاس مشتق شده عوض کنیم.

- یک کمبوباکس روی فرم بگذارید.
- با کنترل کلیک روی تعریف اون یعنی TComboBox به تعریف اون برید.
- همون طور که می بینید فقط میدان دید خصیصه ها افزایش داشته. پس همین خصیصه رو باید در یکی از کلاس های بالاتر دنبال کنیم.
- روی TCustomComboBox هم کنترل کلیک
- در اینجا خبری ازش نیست. پس از کلاس بالاتر یعنی TCustomCombo
- رویداد مورد نظر همین جاست. دنبال نگه دارنده ی این رویداد یعنی FOnDropDown می گردیم.
- در متد DropDown یک مورد پیدا می شه. با کلید های Shift Ctrl ArrowUp به اعلان این پروسیجر می ریم.
- همون طور که می بینید در Protected و از نوع Dynamic تعریف شده.
- از این به بعدش خیلی مهم نیست، خود کلاس می دونه چه موقع این رویداد رو از طریق این متد کال کنه. کافیه در کلاس مشتق شده این متد رو OverRide کنید و به جای کاری که پیش فرض انجام می شه، هنگام اتفاق افتادن DropDown کاری رو که دوست دارید انجام بدید.

فعلا تا جلسه ی بعدی خدانگهدار.

[یوسف زالی]

خصيصه هايي از نوع کامپوننت در کامپوننت
----------------------------------------------
خصيصه ي PopupMenu در فرم،
خصيصه ي DataSource در DBGrid،
خصيصه ي Converter در HTTPRIO،
خصيصه ي TransformRead در XMLTransformProvider

کلا هر خصيصه اي که با رنگ قرمز در Inspector مشخص شده، معين کننده ي اينه که کامپوننت ما داره از اجزايي استفاده مي کنه که خودشون يک کامپوننت ديگه هستند.
مثلا شما اين کد رو ببينيد:


property Test: TControl read FTest write SetTest;

با اضافه شدن اين خصيصه، دلفي به طور اتوماتيک رنگ خصيصه رو قرمز مي کنه و از طرفي با باز کردن ليست دراپ دان خصيصه، دلفي آيتم هاي تطبيق پذير با اين خصيصه رو ليست مي کنه. يعني تشخيص مي ده که چه چيزهايي براي ست شدن در اين آيتم مناسبند.
موضوع به اينجا خلاصه نمي شه و دلفي با ست شدن يک آيتم، به شرط اينکه خود کامپوننت جاري نباشه، يک علامت + هم مي گذاره که با باز کردنش مي تونيد خصوصيات اون کامپوننت و حتي در تب رويدادها، رويدادهاي اون کامپوننت رو هم اصلاح کنيد.
دو مورد اول از مواردي که اول اين درس گفته شد، همين وضع رو دارند.

اما دو مورد دوم چي؟
در مورد سوم، در متد Read به طور پيش فرض از يک آبجکت ساخت داخل خود کامپوننت استفاده مي شه، يعني اينکه خود کامپوننت داره مي گه چي باشه، مگر اينکه کاربر بياد و عوض کنه، مورد آخر هم همين طوره، فقط ReadOnly هست. يعني متد Write نداره. همين!

در آخر بايد يک نکته در مورد کامپوننتی که قبلا نوشتیم اضافه کنم که متد Create هم در هنگام Design و هم در Run اجرا مي شه. پس مي تونيد تايمر رو در همون متد در هنگام Design خاموش کنيد.

[یوسف زالی]

ادامه بدیم آیا؟!

[سعید صابری]

ادامه بدیم آیا؟!
بدون شک.حتما این کار ادامه بدید.البته خواهش.

[یوسف زالی]

مسیج ها در کامپوننت
-------------------------

اول یکم داستان در مورد مسیج:
سیستم ویندوز بر پایه مسیج کار می کنه. برای کارهاش از اون استفاده می کنه. تقریبا هر کار می خواد کنه با این مسیج ها در گیر می شه. یعنی یک جورایی زبان صحبت کردن ویندوز با اجزایی که در حال اجرا هستند همین مسیج هاست. مثلا وقتی ماوس کلیک می شه، دکمه فشرده می شه، برنامه بسته می شه و ... برای هر کدوم مسیج مخصوص خودش ارسال می شه.

یکم تخصصی ترش این می شه، هر ویندو ای که در سیستم وجود داره، هر کنترلی که وجود داره، یک عدد 4 بایتی به نام هندل داره، ویندوز کنترل رو با همین هندل می شناسه و بهش دسترسی داره. از طریق همین هندل هم با هم ارتباط برقرار می کنند. شما هم می تونید با گرفتن هندل یک کنترل حتی روی برنامه دیگه ای که در حال اجراست، به اون پیغام بدید. پیغام هم در حقیقت چیزی نیست به جز یک عدد 4 بایتی دیگه. ویندوز یک تعداد از این اعداد رو رزرو کرده که براش یک معنی خاصی دارند. مثلا مسیج فشرده شدن کلیک جپ یا متد رفتن ماوس روی یک منطقه..



0 through WM_USER –1
Messages reserved for use by the system.
WM_USER through 0x7FFF
Integer messages for use by private window classes.
WM_APP (0x8000) through 0xBFFF
Messages available for use by applications.
0xC000 through 0xFFFF
String messages for use by applications.
Greater than 0xFFFF
Reserved by the system.


حالا وقتی می خواهیم که با فلان اتفاق کامپوننت ما عکس العمل نشون بده، باید مسیج مخصوص به اون اتفاق رو پیدا کرده و براش کد بنویسیم.
قبلش توضیح این که ویندوز هم می تونه برای تمام هندل ها یک مسیج ارسال کنه، هم می تونه برای یک هندل خاص این کار رو کنه. وقتی مسیج برای همه ارسال می شه، بعضی ها در قبالش عکس العمل نشون می دن. مثل اینه که بلندگوی فرودگاه بگه گیت شماره 2 داره بسته می شه، بعضی ها پا می شن می دوئن، بعضی ها هم اصلا به روی خودشون نمیارن. گاهی هم بلندگو اسم یکی رو می گه و فقط اون یک نفر عکس العمل نشون می ده.
اینجا هم دقیقا همین اتفاق داره می افته.

برای مدیریت کردن (اینجا بهش می گن هندل کردن) یک مسیج چکار باید کرد؟
برای این کار دلفی نوع خاصی از متد رو معرفی کرده به نام مسیج متد:


procedure YourProcName(var Message: TMessage); message YoueMessage;

با تعریف این متد و جایگذاری مسیجی که می خواهید کنترلش کنید می تونید کاری که می خواهید رو انجام بدید.
مثلا:


procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;


مهم نیست این متد رو کجا می نویسید، معمولا در Private قرارش می دن، اما مهمه که بدونید با این که این متد رو OverRide نمی کنید، می تونید اون رو Inherited کنید. به این معنی که اگر در کدتون اشاره نکنید به Inherited ، اون وقت کلاس پدر هر کاری که با این مسیج می کرده رها می کنه.
اگر نیاز داشته باشید که دسته ای از مسیج ها رو رها کنید یا براشون کد جدید بنویسید، باید بدونید که هر کنترلی (و نه هر کامپوننتی) یک متد داره به نام WndProc که می تونید با OverRide کردنش پیغام های خاصی رو پردازش نکنید یا رفتار کامپوننتون رو در قبال اونها تغییر بدید.

می تونید از متدهایی مثل SendMessage هم استفاده کنید برای این که اگر هندلی دارید بتونید بهش مسیج ارسال کنید.
البته اگر هندل شما داخل برنامه ای باشه که دارید می نویسید، می تونید از Perform هم استفاده کنید. این متد ربطی به ویندوز نداره و به نظر سریع تر می رسه. در حقیقت فقط داره WindowProc یک کامپوننت خاص رو کال می کنه.

اون پارامتری که در متد وجود داره شامل کد مسیج می شه و دو تا عدد اضافی دیگه که در ارسال مقادیر و اطلاعات اضافی ازش استفاده می شه. مثلا به یک فرم مسیج می دید که برو به مختصات 100 و 200، این دو تا عدد رو می تونید در همین WParam و LParam براش ارسال کنید، اون هم تو متد WndProc اون ها رو پردازش می کنه و می ره به نقطه ای که مختصاتش تو اون دوتاست (کدش رو شما می نویسید، این تفسیر از اعداد کاملا دست شماست)

اگر لازم داشتید که یک مسیج به یک هندل ارسال کنید و این مسیج یک مسیج استاندارد نیست، باید از رنج بالای WM_User استفاده کنید.. (بالاتر گفته شد)

نکته: اگر می خواهید رفتاری رو در کامپوننتتون پیاده کنید که مسیجش پردازش شده، اول بگردید دنبال متدی که مسئول پردازششه، و اون رو OverRide کنید. اگر نتونستید یا اگر چنین متدی وجود نداشت به مسیج متد رو بیارید.
مثلا اگر قراره برای یک دکمه، وقتی واردش شدید فونتش بزرگتر شه، در نسخه های XE متد هاش وجود داره و کافیه اونها رو دستکاری کنید اما در دلفی 7 اصلا چنین مسیجی (WM_MOUSEENTER) برای دکمه پردازش نمی شه، بنابراین براش متد می نویسیم.

مثال: افزودن رویداد OnCursorChange به یک Memo (وقتی کرسر اون رو عوض کنیم یک رویداد رو Fire کنه) :


type
// defining an event type method
TCursorEvent = procedure (Sender: TObject; Cursor: TCursor) of object;

TMyMemo = class(TCustomMemo{not TMemo})
private
FOnCursorChange: TCursorEvent;
// your message handler defining
procedure CMCursorChanged{or any other name}(var Message: TMessage); message CM_CURSORCHANGED{here is your message};
protected
// a handler method, it is virtual, then you can override it in child
// classes without any concern for defining other message method
procedure DoCursorChange(ACursor: TCursor); virtual;
published
// an extra event you want to define, it is just a method holder
property OnCursorChange: TCursorEvent read FOnCursorChange write FOnCursorChange;
// other properties of parent class you like to have
property Align;
property Alignment;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

// TMyMemo2 = class(TMyMemo)
// protected
// procedure DoCursorChange(ACursor: TCursor); override;
// end;

implementation

{ TMyButton }

procedure TMyMemo.CMCursorChanged(var Message: TMessage);
begin
// inherite call for probably previous handling in base class
inherited;

// call handler method for this message
DoCursorChange(Self.Cursor);
end;

procedure TMyMemo.DoCursorChange(ACursor: TCursor);
begin
if Assigned(FOnCursorChange){if we have a method for this event} then
// fire it!
FOnCursorChange(Self, ACursor);
end;


یک مثال ازش:


TForm1 = class(TForm)
Button2: TButton;
Edit1: TEdit;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure CursorMethod(Sender: TObject; Cursor: TCursor);
public
{ Public declarations }
end;

.
.

var
MyMemo: TMyMemo;

procedure TForm1.FormCreate(Sender: TObject);
begin
MyMemo := TMyMemo.Create(Self);
MyMemo.Parent := Self;
MyMemo.OnCursorChange := CursorMethod;
end;

procedure TForm1.CursorMethod(Sender: TObject; Cursor: TCursor);
begin
MyMemo.Font.Color := clRed;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
MyMemo.Cursor := crHandPoint
end;


همون طور که می بینید برای هندل کردن این مسیج که در کلاس های پایه وجود نداشت، یک متد نوشتیم، در کد اون "مسیج متد" یک متد مجازی رو کال کردیم و در کد اون متد مجازی تست کردیم ببینیم که در رویداد کدی وجود داره یا نه که اگر داشت اون کد ران شه. علت استفاده از اون متد مجازی هم این بود که اگر یکی اومد از این کلاس ما یک کلاس مشتق کرد دیگه نره درگیر مسیج بشه و از همون جا به راحتی بیاد و متد ما رو براندازی کنه. مثال عملی این جریان رو می تونید در متد Change از TCustomEdit یا در متد MouseDown و DoMouseWheelDown از TControl ببینید.

امیدوارم از برنامه نویسی کامپوننت هاتون لذت ببرید.

[sara.mahdavi]

ا سلام
آموزش خیلی خوبی قرار دادید مطمئنم به من و خیلیا توی این زمینه کمک میکنید

میشه در مورد Private , Public , Protected , Published هم توضیح بدید ؟ و بفرمایید که چطوری بفهمیم که کدوم متد رو توی کدوم یک از اینها وارد کنیم درستتره
با تشکر

[یوسف زالی]

توضيح در اين موارد زيرمجموعه کلاس هاست، فکر مي کنم ديدن فيلم هاي آموزشي که دوستمون Object Pascal قرار دادند بتونه خيلي از سوالاتتون رو مرتفع کنه.
اما در حالت کلي:
Private -> مقادير اختصاصي کلاس که دوست نداريم کسي اونها رو ببينه و دست کاري کنه، تنها موردي که داره اينه که در همون يونيتي که داريم کلاس رو تعريف مي کنيم، از بيرون ديده ميشه
Strict Private -> همون قبليه با اين تفاوت که در همون يونيت و خارج از کلاس هم ديده نمي شه
Protected -> مقاديري که دوست داريم فقط اين کلاس و بچه هاي اين کلاس ببينند
Public -> مقاديري که دوست داريم از بيرون کلاس هم ديده بشه
Published -> همون بالاييه با اين تفاوت که براش RTTI توليد مي شه، به زبان ساده يعني در کامپوننت ها در ليست Object Inspector آورده ميشه
Automated -> مثل Public با اين تفاوت که در برنامه نويسي هاي اتوماسيون استفاده ميشه، منظور از اتوماسيون، مثلا ارتباط با ورد و اکسل و کام و اين داستان هاست

اينها اصطلاحا بهشون مي گن ميدان ديد

حالا اين که کي از کدوم استفاده کنيم دقيقا بستگي به آينده نگري ساخت کلاس داره.
متغير هايي که در کلاس تعريف مي شن بهشون مي گن فيلد، براي همين هم معمولا متغير هاي Private اولشون F دارند.
زمان استفاده از هر کدام:

Private : براي متغير ها و متدهاي درون کلاسي که ديدنشون از بيرون، دستکاري شون و استفاده يا فراخواني شون معني نداره
مثال: فيلد هاي نگهدارنده Property Value، متغير هاي فلگ، شمارنده هاي داخلي، متغير هايي که بين متد هاي کلاس Share مي شه و استفاده خاصي براي کاربر نداره، متد هاي مياني، متد هاي دسترسي به Property، متد هاي دروني که از بيرون لزومي براي فراخواني ندارند مثل متد هاي مسيج، متدهاي مقدار دهي اوليه..

Protected : متغير ها يا متدهايي که ممکنه فرزند اون کلاس بخواد دستکاري شون کنه، يا فراخواني کنه، يا اين که اونها رو براندازي کنه (معمولا تمام اين متدها مجازي اند)
مثال: پياده سازي شکل يک کامپوننت، پياده سازي کليک يک دکمه، پياده سازي اکثر رويداد ها، پياده سازي رفتار کلاس در قبال اتفاقاتي مثل Resize, Enabled يا ارسال يک مسيج

Public : چيزهايي که مي خواهيم حتما از بيرون بشه ديد تا بشه خوند يا دستکاري کرد
مثال: تست فوکوس بودن، متد هاي تخريب مثل Destroy، متدهاي سازنده، متد Add، Clear، معمولا متغيرها در اين قسمت کمتر ديده مي شن مگر اين که کلاس ما کامپوننت نباشه

Published : اعضايي که عمومي هستند ولي مي خواهيم در خصوص کامپوننت ها در ليست Object Inspector آورده شوند، اين اعضا توسط متدهاي يونيت TypInfo قابل شناسايي هستند
مثال: تمام رويداد ها، موقعيت و اندازه فرم، رنگ پنل، ...

حالا اين که استفاده درست کدومه يکم تجربه مي خواد.
ممکنه بعد از مدتي بفهميد که گذاشتن يک متغير يا متد در قسمتي اشتباه بوده..
شما بايد دقيقا طراحي تون رو درست انجام داده باشيد و روي کاغذ بياييد و با خودتون بگيد، خب، حالا يک کلاسي ازش مشتق مي کنم، بايد چيا داشته باشه و چيا نداشته باشه، خب، حالا يک آبجکت ازش مي سازم، لازمه چه چيزايي رو داشته باشم و چه جيزايي رو نبايد بتونم ببينم يا دست بزنم، اين قسمت ها رو از ديد يک برنامه نويس غريبه هم تکرار کنيد، ممکنه بعضي چيز ها رو بخواهيد از دسترس تغييرات خارج کنيد، ممکنه بخواهيد برنامه نويس EndPoint رو درگير بعضي پيچيدگي ها نکنيد و ...
نکته مهم اينه که بي حساب نيايد هرچي Public داريد بگذاريد تو Published که اين کار زمان لود رو بالا مي بره، و ممکنه کامپوننت رو به يک لوپ وارد کنه.
مثلا در مورد مثال TRainbowLabel:
FTurn رو کسي جز خود اين کلاس لازم نداره، حتي اشتقاق هاي اين کلاس
DoTick ممکنه در کلاس هاي مشتق شده لازم باشه تغيير رفتار داده بشه، اما شي که از روش ساخته مي شه لازم نداره اون رو ببينه
Create رو بايد بشه از بيرون ديد
RefreshInterval رو لازم داريم برنامه نويس بتونه در زمان طراحي مقدار دهي کنه
و ...

نکته: ننوشتن Scope اون رو Published مي کنه.
در صورتي که باز هم سوال داشتيد لطفا بعد از جستجو و نرسيدن به جواب، تاپيک جداگانه اي باز کنيد تا مطالب انسجام خودش رو از دست نده.
موفق باشيد.

[یوسف زالی]

در اين جلسه قصد دارم يک کامپوننت ساده بسازم که البته مي تونه کاربردي هم باشه.
سعي مي کنم تا حد ممکن نکاتي رو که لازمه درش بگنجونم.

کامپوننتي که در نظر دارم يک کامپوننت براي ورود زمان يا همون تايم اديت هست.
اول بياييد ببينيم اصلا چي مي خواهيم:

- يک کامپوننت با سه اديت براي ورود ساعت - دقيقه - ثانيه به ترتيب از چپ به راست
- دو عدد کولون (:) براي جدا کردن اين اديت ها از هم
- پرش اتوماتيک بين اديت ها بعد از پر شدن هر کدوم از اونها
- قابليت ست شدن زمان از روي زمان سيستم
- قابليت گرفتن خروجي به فرمت هاي عددي و رشته اي با کولون و بدون اون
- داشتن رويداد OnChange

براي ساخت اين کامپوننت، به دليل اين که چند تا آبجکت دروني داريم، نياز به يک آبجکت نگهدارنده داريم که همه اين ها رو روش بگذاريم، اين شي مي تونه يک پنل باشه يا يک گروپ باکس
من TCustomControl رو انتخاب مي کنم به اين دليل که هر چه درخت کلاس ما کم عمق تر باشه کار باهاش راحت تر و لودينگ سريع تر و آيتم هاي اضافي کمتري داره.
اين کلاس از TWinControl مشتق مي شه اما دست شما رو در کشيدن چيزي روش آزاد مي گذاره چون Canvas رو پياده سازي کرده.
انتخاب اين که از چه چيزي مشتق کنيم به ما خيلي در روند برنامه نويسي کمک مي کنه، مثلا من مي تونستم مستقيم از TComponent بگيرم که در اين صورت بايد تک تک آيتم هايي رو که در کلاس هاي TControl و TWinControl وجود داره دوباره نويسي مي کردم يا بي خيالشون مي شدم.
اسم کلاسم رو مي گذارم TU30TimeEdit،
تا اينجاي کار:


TU30TimeEdit = class(TCustomControl)
end;


خب، بريم سراغ اشيايي که بايد در اين کامپوننت وجود داشته باشه،
سه تا اديت و دو تا ليبل


TU30TimeEdit = class(TCustomControl)
protected
label1: TLabel;
label2: TLabel;
MaskEdit1: TMaskEdit;
MaskEdit2: TMaskEdit;
MaskEdit3: TMaskEdit;
end;


علت Protected بودن اين اشيا اينه که در زيرکلاسها دستمون براي دادن تغييرات در اينها باز باشه. ولي لزومي نداره که شي اونها رو عمومي اعلام کنه.
براي ساخت اونها بايد از متد سازنده کمک بگيريم:


public
constructor Create(AOwner: TComponent); override;


اجازه بديد باقي ماجرا رو روي سورس ادامه بديم.
کلاس نهايي:


TU30TimeEdit = class(TCustomControl)
private
FChangeTag: integer;
F_Author: string;
FOnChange: TNotifyEvent;
FPairKeyDownWithUp: integer;
FLastDownKey: word;
procedure Set_Author(const Value: string);
procedure AdjustWidthHeight;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure MyOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure MyOnKeyPress(Sender: TObject; var Key: Char);
procedure MyOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure MyOnEnter(Sender: TObject);
procedure MyOnExit(Sender: TObject);
procedure MyOnChange(Sender: TObject);
procedure MyOnClick(Sender: TObject);
procedure MyOnDblClick(Sender: TObject);
procedure MyOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MyOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MyOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SetValueInColonStringFormat(const Value: string);
procedure SetValueInIntegerFormat(const Value: integer);
procedure SetValueInStringFormat(const Value: string);
function GetValueInColonStringFormat: string;
function GetValueInIntegerFormat: integer;
function GetValueInStringFormat: string;
protected
label1: TLabel;
label2: TLabel;
MaskEdit1: TMaskEdit;
MaskEdit2: TMaskEdit;
MaskEdit3: TMaskEdit;
public
constructor Create(AOwner: TComponent); override;
property _Author: string read F_Author write Set_Author;
property ValueInIntegerFormat: integer read GetValueInIntegerFormat write SetValueInIntegerFormat;
property ValueInStringFormat: string read GetValueInStringFormat write SetValueInStringFormat;
procedure SetToCurrentTime;
published
property ValueInColonStringFormat: string read GetValueInColonStringFormat write SetValueInColonStringFormat;
property Anchors;
property BevelKind;
property BiDiMode;
property Color;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;


دليل وجود CMFontChanged اينه که کامپوننت با تغيير فونت خودش رو منطبق کنه. اين متد يک متد مسيج هست که کاربردش رو مي بينيد.
در قسمت published هم يک سري افزايش ميدان ديد انجام شده تا برنامه نويس بتونه از اين آيتم ها در هنگام طراحي استفاده کنه.

قسمت پياده سازي:


{اين پروسيجر ربطي به کلاس نداره و با گرفتن يک متن اندازه هاي اون رو بر مي گردونه}

function Get_TextWidthHeightByPixel(aFont: TFont; aText: string): TWidthHeight;
var
fCanvas: TCanvas;
begin
fCanvas := TCanvas.Create;
try
fCanvas.Handle := GetDC(0);
fCanvas.Font := aFont;
Result.Width := fCanvas.TextWidth(aText);
Result.Height := fCanvas.TextHeight(aText);
finally
fCanvas.Destroy;
end;
end;

Const
TIME_24H_SIGN = 'D';
TIME_12H_SIGN = 'A';
TIME_AM_SIGN = 'am';
TIME_PM_SIGN = 'pm';

{ TU30TimeEdit }
{اين متد اندازه ها رو ريست مي کنه}
procedure TU30TimeEdit.AdjustWidthHeight;
var
WH: TWidthHeight;
FFont: TFont;
begin
FFont := Self.Font;
{اين کار اجازه مي ده اندازه ها قابل تغيير باشند}
Self.Constraints.MinHeight := 0;
Self.Constraints.MaxHeight := 0;
Self.Constraints.MinWidth := 0;
Self.Constraints.MaxWidth := 0;
{اينجا داريم ارتفاع رو بر حسب فونت جديد بدست مياريم تا ارتفاع کامپوننت رو ست کنيم}
WH := Get_TextWidthHeightByPixel(FFont, TIME_24H_SIGN);
Self.Height := WH.Height +7;
Self.label1.Height := WH.Height;
Self.label2.Height := WH.Height;

{همين کار براي درازاي ليبل هاي کولون}
WH := Get_TextWidthHeightByPixel(FFont, ':');
Self.label2.Width := WH.Width;
Self.label1.Width := WH.Width;

{همين کار براي اندازه ي آيتم ها}
WH := Get_TextWidthHeightByPixel(FFont, '99');

Self.MaskEdit3.Height := WH.Height;
Self.MaskEdit2.Height := WH.Height;
Self.MaskEdit1.Height := WH.Height;
Self.MaskEdit3.Width := WH.Width +1;
Self.MaskEdit2.Width := WH.Width +1;
Self.MaskEdit1.Width := WH.Width +1;

WH := Get_TextWidthHeightByPixel(FFont, TIME_AM_SIGN);

{کامپوننت ها بايد در جاهاي جديد دوباره بازنشاني بشوند}
Self.MaskEdit3.Left := 1;
Self.label2.Left := Self.MaskEdit3.Left +Self.MaskEdit3.Width +1;
Self.MaskEdit2.Left := Self.label2.Left +Self.label2.Width +1;
Self.label1.Left := Self.MaskEdit2.Left +Self.MaskEdit2.Width +1;
Self.MaskEdit1.Left := Self.label1.Left +Self.label1.Width +1;

Self.Width := MaskEdit1.Left +MaskEdit1.Width +6;

{اين کار باعث مي شه برنامه نويس نتونه اندازه کامپوننت رو عوض کنه و اون رو قفل مي کنه}
Self.Constraints.MinHeight := Self.Height;
Self.Constraints.MaxHeight := Self.Height;
Self.Constraints.MinWidth := Self.Width;
Self.Constraints.MaxWidth := Self.Width;

{اين متد کامپوننت رو در "اولين فرصت" رفرش مي کنه}
Self.Invalidate;
end;

procedure TU30TimeEdit.CMFontChanged(var Message: TMessage);
begin
{بايد ببينيم کامپوننت آيتم هاش وجود داره يا نه، ممکنه به هر دليلي در هنگامي که کامپوننت آماده نيست، اين متد کال بشه}
if Assigned(MaskEdit1)
and Assigned(MaskEdit2)
and Assigned(MaskEdit3)
and Assigned(label1)
and Assigned(label2) then
AdjustWidthHeight;
{اين کلمه پاييني مي گه قبلا هر کاري مي کردي حالا هم همون کار رو کن و با تغييرات من کارهاي قبلي رو در قبال اين مسيج رها نکن}
inherited;
end;

constructor TU30TimeEdit.Create(AOwner: TComponent);
begin
{اول از همه ساخت خود نگهدارنده، يعني خود کامپوننت}
inherited Create(AOwner);
{ست کردن Parent در اينجا به دليل ضعف بعضي نسخ دلفي هست که در هنگام گذاشتن کامپوننت روي فرم ايجاد مي شد}
Self.Parent := TWinControl(AOwner);
{شکل عمومي کامپوننت}
Self.BevelKind := bkFlat;
Self.Color := clWindow;
Self.Caption := '';
Self.Color := clWhite;
{ليبل ها}
Self.label1 := TLabel.Create(Self);
Self.label1.Parent := Self;
Self.label1.AutoSize := false;
Self.label1.Caption := ':';
Self.label1.Top := 4;
{خود ليبل ها بايد به رويداد ها حساس باشند، کليک روي ليبل با کيلک روي کامپوننت بايد يک معني رو بده، به همين خاطر رويدادهاي لازم رو ست مي کنيم به هندلر هاي خودمون}
Self.label1.OnClick := MyOnClick;
Self.label1.OnDblClick := MyOnDblClick;
Self.label1.OnMouseDown := MyOnMouseDown;
Self.label1.OnMouseMove := MyOnMouseMove;
Self.label1.OnMouseUp := MyOnMouseUp;

Self.label2 := TLabel.Create(Self);
Self.label2.Parent := Self;
Self.label2.AutoSize := false;
Self.label2.Caption := ':';
Self.label2.Top := 4;
Self.label2.OnClick := MyOnClick;
Self.label2.OnDblClick := MyOnDblClick;
Self.label2.OnMouseDown := MyOnMouseDown;
Self.label2.OnMouseMove := MyOnMouseMove;
Self.label2.OnMouseUp := MyOnMouseUp;
{ساخت اديت ها}
Self.MaskEdit3 := TMaskEdit.Create(Self);
Self.MaskEdit3.Parent := Self;
Self.MaskEdit3.BorderStyle := bsNone;
Self.MaskEdit3.EditMask := '99;1;_';
Self.MaskEdit3.MaxLength := 2;
Self.MaskEdit3.TabOrder := 0;
Self.MaskEdit3.Tag := 1;
Self.MaskEdit3.Text := '12';
Self.MaskEdit3.Top := 2;
{اين اديت ها هم بايد رويداد ها رو ساپورت کنند، علاوه بر اون، بايد در هنگام تغيير يا تايپ چيزي، بتونيم براشون رويداد درست کنيم}
Self.MaskEdit3.OnExit := MyOnExit;
Self.MaskEdit3.OnEnter := MyOnEnter;
Self.MaskEdit3.OnChange := MyOnChange;
Self.MaskEdit3.OnKeyDown := MyOnKeyDown;
Self.MaskEdit3.OnKeyPress := MyOnKeyPress;
Self.MaskEdit3.OnKeyUp := MyOnKeyUp;
Self.MaskEdit3.OnClick := MyOnClick;
Self.MaskEdit3.OnDblClick := MyOnDblClick;
Self.MaskEdit3.OnMouseDown := MyOnMouseDown;
Self.MaskEdit3.OnMouseMove := MyOnMouseMove;
Self.MaskEdit3.OnMouseUp := MyOnMouseUp;

Self.MaskEdit2 := TMaskEdit.Create(Self);
Self.MaskEdit2.Parent := Self;
Self.MaskEdit2.BorderStyle := bsNone;
Self.MaskEdit2.EditMask := '99;1;_';
Self.MaskEdit2.MaxLength := 2;
Self.MaskEdit2.TabOrder := 1;
Self.MaskEdit2.Tag := 2;
Self.MaskEdit2.Text := '00';
Self.MaskEdit2.Top := 2;
Self.MaskEdit2.OnExit := MyOnExit;
Self.MaskEdit2.OnEnter := MyOnEnter;
Self.MaskEdit2.OnChange := MyOnChange;
Self.MaskEdit2.OnKeyDown := MyOnKeyDown;
Self.MaskEdit2.OnKeyPress := MyOnKeyPress;
Self.MaskEdit2.OnKeyUp := MyOnKeyUp;
Self.MaskEdit2.OnClick := MyOnClick;
Self.MaskEdit2.OnDblClick := MyOnDblClick;
Self.MaskEdit2.OnMouseDown := MyOnMouseDown;
Self.MaskEdit2.OnMouseMove := MyOnMouseMove;
Self.MaskEdit2.OnMouseUp := MyOnMouseUp;

Self.MaskEdit1 := TMaskEdit.Create(Self);
Self.MaskEdit1.Parent := Self;
Self.MaskEdit1.BorderStyle := bsNone;
Self.MaskEdit1.EditMask := '99;1;_';
Self.MaskEdit1.MaxLength := 2;
Self.MaskEdit1.TabOrder := 2;
Self.MaskEdit1.Tag := 3;
Self.MaskEdit1.Text := '00';
Self.MaskEdit1.Top := 2;
Self.MaskEdit1.OnExit := MyOnExit;
Self.MaskEdit1.OnEnter := MyOnEnter;
Self.MaskEdit1.OnChange := MyOnChange;
Self.MaskEdit1.OnKeyDown := MyOnKeyDown;
Self.MaskEdit1.OnKeyPress := MyOnKeyPress;
Self.MaskEdit1.OnKeyUp := MyOnKeyUp;
Self.MaskEdit1.OnClick := MyOnClick;
Self.MaskEdit1.OnDblClick := MyOnDblClick;
Self.MaskEdit1.OnMouseDown := MyOnMouseDown;
Self.MaskEdit1.OnMouseMove := MyOnMouseMove;
Self.MaskEdit1.OnMouseUp := MyOnMouseUp;

Self.FChangeTag := 0;
Self.AdjustWidthHeight;
Self.SetToCurrentTime;
Self.F_Author := 'Yousef Zalli, U3F.Zalli@GMail.Com, Tel = 09123780840';

FPairKeyDownWithUp := 0;
FLastDownKey := 0;
end;
{مقداري که الان در تايم اديت هست رو به فرم رشته اي همراه با کولون مي ده، مثل '12:01:01'}
function TU30TimeEdit.GetValueInColonStringFormat: string;
begin
Result := MaskEdit3.Text + ':' + MaskEdit2.Text + ':' + MaskEdit1.Text;
end;
{مقدار رو به فرم عددي مي ده، مثل 120101}
function TU30TimeEdit.GetValueInIntegerFormat: integer;
begin
Result := StrToInt(StringReplace(GetValueInColonStringFormat , ':', '', [rfReplaceAll]));
end;
{مقدار رو به فرم رشته بدون کولون مي ده مثل '120101'}
function TU30TimeEdit.GetValueInStringFormat: string;
begin
Result := StringReplace(GetValueInColonStringFormat, ':', '', [rfReplaceAll]);
end;
{در اينجا داريم هندلر خودمون رو پياده مي کنيم، اين هندلر همون طور که ديديم در هنگام تغيير هر کدوم از اديت ها کال مي شه}
procedure TU30TimeEdit.MyOnChange(Sender: TObject);
begin
if FChangeTag = 0 then
if Assigned(OnChange) then
Self.OnChange(Self);
end;
{اين هم مثل همونه، ولي مثلا در هنگام کليک ليبل ها هم کال مي شه}
procedure TU30TimeEdit.MyOnClick(Sender: TObject);
begin
if Assigned(Self.OnClick) then
Self.OnClick(Self);
end;

procedure TU30TimeEdit.MyOnDblClick(Sender: TObject);
begin
if Assigned(Self.OnDblClick) then
Self.OnDblClick(Self);
end;
{در اينجا مي خوايم بگيم که اگر رفت تو اديت، متن داخلش آبي بشه و انتخاب شه تا راحت عوض شه}
procedure TU30TimeEdit.MyOnEnter(Sender: TObject);
begin
{اين تگ مشخص مي کنه که در اين اديت هستيم، اضافيه و مي تونيد برش داريد}
(Sender as TMaskEdit).Tag := 1;
(Sender as TMaskEdit).SelectAll;
end;
{در هنگام خروج بايد ببينيد که کاربر هر دو رقم رو زده يا نه، اگر نزده يک صفر قبلش مي ذاريم}
procedure TU30TimeEdit.MyOnExit(Sender: TObject);
var
x: integer;
begin
(Sender as TMaskEdit).Text := RightStr('00' + trim((Sender as TMaskEdit).Text), 2);

x := StrToIntDef(trim((Sender as TMaskEdit).Text), 0);
{اعتبار اعدادي که زده شده تست مي شه و در صورت اشتباه بودن تصحيح مي شه}
if (Sender = Self.MaskEdit1) and ((x > 59) or (x < 0)) then
Self.MaskEdit1.Text := '01'
else if (Sender = Self.MaskEdit2) and ((x > 59) or (x < 0)) then
Self.MaskEdit2.Text := '01'
else if (Sender = Self.MaskEdit3) and ((x > 23) or (x < 0)) then
Self.MaskEdit3.Text := '01';

(Sender as TMaskEdit).Tag := 0;
end;
{اين متد خيلي مهمه و نکته داره، مثلا مي خواهيم عدد 12 رو بزنيم، خب، اول يک رو فشار مي ديم بعد 2 ديگه! اما اتفاقي که عملا در کار در سرعت بالا مي افته اينه که قبل از رها شدن دکمه 1 دکمه 2 فشرده مي شه، اگر اين کار رو هندل نکرده باشيد کامپوننت در اين وضعيت دچار مشکل مي شه.
براي اصلاح و کنترل اين وضع، بايد آمار فشرده شدن و رها شدن دکمه ها رو دستمون داشته باشيم تا ببينيم به ازاي هر فشرده شدن رها شدني هم انجام مي شه يا نه.
نکته ديگه اينه که قسمت اعداد بالا با قسمت اعداد نام پد در اين متدها کدهاي متفاوتي توليد مي کنه و بايد حواسمون به اين موضوع باشه}
procedure TU30TimeEdit.MyOnKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Assigned(Self.OnKeyDown) then
Self.OnKeyDown(Sender, Key, Shift);
{اينجا قسمتيه که چک مي کنيم ببينيم عددي فشرده شده يا نه، اگر عدد فشرده شده با آخرين عدد فشرده شده يکي نبود يعني کاربر قبل از رها کردن يک دکمه ديگه رو فشار داده}
if (Key in [48..57, VK_NUMPAD0..VK_NUMPAD9]) then
if FLastDownKey <> Key then
begin
inc(FPairKeyDownWithUp);
FLastDownKey := Key;
end;
end;

procedure TU30TimeEdit.MyOnKeyPress(Sender: TObject; var Key: Char);
begin
if Assigned(Self.OnKeyPress) then
Self.OnKeyPress(Sender, Key);
end;
{اينجا هم همين موضوع رو براي رها کردن دکمه ها داريم}
procedure TU30TimeEdit.MyOnKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
OnExitPtr: TNotifyEvent;
begin
if Assigned(Self.OnKeyUp) then
Self.OnKeyUp(Sender, Key, Shift);

if not (Key in [48..57, VK_NUMPAD0..VK_NUMPAD9]) then
Exit;

dec(FPairKeyDownWithUp);

if FPairKeyDownWithUp <> 0 then
Exit;

FLastDownKey := 0;

OnExitPtr := Self.OnExit;
Self.OnExit := nil;
{در اين قسمت چک مي کنم ببينيم لازمه که به اديت بعدي بپريم يا نه}
if Sender = Self.MaskEdit1 then
begin
if (Length(trim(Self.MaskEdit1.Text)) = 2) or (StrToIntDef(trim(Self.MaskEdit1.Text), 0) > 5) then
begin
MaskEdit1.OnExit(MaskEdit1);
MaskEdit3.OnEnter(MaskEdit3);
if not SameText(F_Author, '') then
{اين خيلي مهمه، هرگز از SetFocus خود دلفي در اين زمينه استفاده نکنيد، اين کار جلوي گرفتن AV رو در هنگام آماده نبودن فوکوس مي گيره}
Windows.SetFocus(MaskEdit3.Handle);
end;
end
else if Sender = Self.MaskEdit2 then
begin
if (Length(trim(Self.MaskEdit2.Text)) = 2) or (StrToIntDef(trim(Self.MaskEdit2.Text), 0) > 5) then
begin
MaskEdit2.OnExit(MaskEdit2);
MaskEdit1.OnEnter(MaskEdit1);
if not SameText(F_Author, '') then
Windows.SetFocus(MaskEdit1.Handle);
end;
end
else if Sender = Self.MaskEdit3 then
begin
if (Length(trim(Self.MaskEdit3.Text)) = 2) or (StrToIntDef(trim(Self.MaskEdit3.Text), 0) > 2) then
begin
MaskEdit3.OnExit(MaskEdit3);
MaskEdit2.OnEnter(MaskEdit2);
if not SameText(F_Author, '') then
Windows.SetFocus(MaskEdit2.Handle);
end;
end;

Self.OnExit := OnExitPtr;
end;

procedure TU30TimeEdit.MyOnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Assigned(Self.OnMouseDown) then
Self.OnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TU30TimeEdit.MyOnMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if Assigned(Self.OnMouseMove) then
Self.OnMouseMove(Self, Shift, X, Y);
end;

procedure TU30TimeEdit.MyOnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Assigned(Self.OnMouseUp) then
Self.OnMouseUp(Self, Button, Shift, X, Y);
end;
{اينجا زمان سيستم رو مي ديم به کامپوننت}
procedure TU30TimeEdit.SetToCurrentTime;
begin
SetValueInStringFormat(StringReplace(Time_CurrentT ime, ':', '', [rfReplaceAll]));
end;

procedure TU30TimeEdit.SetValueInColonStringFormat(const Value: string);
begin
SetValueInStringFormat(StringReplace(Value, ':', '', [rfReplaceAll]));
end;

procedure TU30TimeEdit.SetValueInIntegerFormat(const Value: integer);
begin
SetValueInStringFormat(RightStr('000000' + IntToStr(Value), 6));
end;

procedure TU30TimeEdit.SetValueInStringFormat(const Value: string);
begin
inc(FChangeTag);

Self.MaskEdit1.Text := Copy(Value, 5, 2);
Self.MaskEdit2.Text := Copy(Value, 3, 2);
Self.MaskEdit3.Text := Copy(Value, 1, 4);
BeforeExit;

dec(FChangeTag);
if FChangeTag = 0 then
if Assigned(OnChange) then
Self.OnChange(Self);
end;
{اين هم يک کلکه براي اينکه برنامه نويس در زمان طراحي نام نويسنده رو ببينه ولي نتونه اصلاحش کنه}
procedure TU30TimeEdit.Set_Author(const Value: string);
begin
//
end;


دوستان اگر مي بينيد که داره سخت مي شه دليلش اينه که بايد با آزمون و خطا مسايل پيش اومده رو مديريت کنيد. خود من 6 ماه بعد از به کار بردن کامپوننت هام، متوجه موضوع فشرده شدن دکمه ها شدم، يا مثلا فرق داشتن کد هاي اعداد، بنابراين با ديدن چند تا ارور مايوس نشيد و دست از کار نکشيد.

اميدوارم که عزيزان با نظر دادن من رو براي ادامه آموزش دلگرم کنند.
هر جا گنگ بود يا نياز به توضيح بيشتر داشت بفرماييد تا توضيح بدم.
فعلا تا جلسه ي بعدي..

[SayeyeZohor]

با سلام خدمت یوسف عزیز و عرض تشکر

من به عنوان یکی از کارآموزات یک property برای Active کردن رنگ label درست کردم


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 ---
FActive: Boolean;
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 SetActive(Value: Boolean);
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 Active: Boolean read FActive write SetActive default False;

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;
property EllipsisPosition;
property GlowSize; // Windows Vista only
property Touch;
property StyleElements;
property OnGesture;
property OnMouseActivate;
END;

PROCEDURE Register;

implementation


PROCEDURE Register;
BEGIN
RegisterComponents('Rainbow', [TRainbowLabel]); // first name is a tab name
END;

{ TRainbowLabel }

constructor TRainbowLabel.Create(AOwner: TComponent);
begin
inherited;

FTimer := TTimer.Create(Self);
FTimer.Interval := 1000;
FTimer.OnTimer := DoTick;
FActive := False;

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 Exit; // avoiding to re-set same value

FTimer.Interval := Value; // setting that value to inner timer interval
end;

procedure TRainbowLabel.SetActive(Value: Boolean);
begin
if FActive <> Value then FActive := Value;
end;

procedure TRainbowLabel.DoTick(Sender: TObject); // calculation and changing color
var
R, G, B: integer;
begin
IF csDesigning in ComponentState THEN Exit;

IF NOT FActive THEN
BEGIN
Self.Font.Color := clWindowText;
Exit;
END;

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.

[یوسف زالی]

این هم یک نمونه کامپوننت دیگه همراه با سورس:
http://barnamenevis.org/showthread.php?447655-%DA%A9%D8%A7%D9%85%D9%BE%D9%88%D9%86%D9%86%D8%AA%D B%8C-%D8%A8%D8%B1%D8%A7%DB%8C-%D9%86%D9%85%D8%A7%DB%8C%D8%B4-%DB%8C%DA%A9-%D8%A7%D9%86%DB%8C%D9%85%DB%8C%D8%B4%D9%86-%D8%AF%D8%B1-%D9%87%D9%86%DA%AF%D8%A7%D9%85-Freeze-%D8%B4%D8%AF%D9%86-%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D9%87&p=2002703#post2002703

[مرد مباح]

با تشکر فراوان از شما you-see عزیز.
من سوالی برام پیش اومده که نمیدونم چطوری این کار انجام میشود. برای BidiMode در دلفی قاعدتا کدی نوشته شده. شما هم با اضافه کردن اون در published براحتی از اون استفاده کردید.
اولا این کد کجای سورسهای دلفی نوشته شده ؟
ثانیا من دارم سعی میکنم یک کامپوننت که این قابلیت رو نداره بهش اضافه کنم. ولی نتونستم. میتونی لطفا راهنماییم کنید؟

والد اصلی از TCustomControl منشا گرفته و اکثر کامپوننتها از اون تولید شدن
مجموعه کامپوننت هدف من DevExpress هست که تقریبا همه دوستان آشنایی دارن. کامپووونت اولیه هم cxGrid بود. ولی وقتی اومدم بالا دیدم اکثر خصوصیاتش رو از TcxControl میگیره. اگه Bidimode رو توی Private اون اضافه کنم مشکل حل میشه؟
برای اینستال مجدد این مجموعه به این گندگی چی کار باید کرد؟

[یوسف زالی]

TCustomControl = class(TWinControl)

TWinControl = class(TControl)

TControl = class(TComponent)
property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;


آوردن یک پراپرتی در Private مثل نیاوردنشه. باید در Published بگذارید.
با بیلد مجدد مجموعه کامپوننت، همه چیز درست خواهد شد.
ممکنه بخواهید برای حالات مختلف کارهای متفاوتی کنید، باید این ها رو دست بزنید:


procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED;
procedure SetParentBiDiMode(Value: Boolean); virtual;
procedure SetBiDiMode(Value: TBiDiMode); virtual;

[مرد مباح]

ممنون از پاسخ سریع شما. این کار رو انجام دادم و دوباره build کردم. به تمام کامپوننتها BidiMode اضافه شد. ولی کار نمیکنه.
یعنی برای مثال DBGrid وقتی RTL میشه کلا راست چین شده و خونه اولیه میشه بالاترین سمت راست.
ولی تویه این Grid هیچ اتفاقی نمی افته و عمل نمیکنه. مشکل چیه؟
نه فقط توی گرید. Tree هم سمت چپ هستش و راست چین تغییری نمی کنه و ...

[یوسف زالی]

پس باید ببینید کامپوننت چطور داره اون رو مدیریت می کنه. سورس رو باید مطالعه کنی

[مرد مباح]

خیلی توش چرخ زدم.
امکانش هست شما توی پیدا کردنش کمکم کنی؟ به هر حال استاد مایی و من هم توی این زمینه کامپوننت ها و تغییراتش ضعیفم.
جاشو نشونم بدین سعیم رو میکنم اگر اصلاحی بخواد انجام بدم و بعد بزارم همینجا دوستان ازش استفاده کنن.
حیفه آخه کامپوننت به این قدرت RTL ساپورت نمی کنه. حداقل درستش کنیم برای ایرانیا خوب کار کنه.

تمام سورسهایی که ممکنه به هر نحوی درگیر باشن رو سعی کردم جدا کنم و براتون گذاشتم.
فایل اصلی تعریف گریدها و انواع اون
118885

فایل اصلی library که تعریف کلیه کامپوننت ها اینجا انجام شده. در cxclass
118886

فایلهای library جانبی که نمی دونم کجا ازش استفاده شده
118888
118887

البته بجز اینا یک مجمئعه هم هست که کلیه editor ها توش تعریف شده مثل Checkbox, label و... که نتونستم آپلود کنم. 780KB هست که اجازه آپلود بهم نداد
اگر اونا هم لازمه بفرمائید لینک میزارم.
ولی فکر میکنم اصل داستان همون دو تا فایل اول هستن و اصلیاش هم cxGrid در فایل Grid و cxclasses توی فایل library

خیلی ازتون ممنون میشم و کلی دعا گو پیدا میکتپنین. البته بجز خود من که ما مخلص شماییم. :بوس:

[یوسف زالی]

شما به بنده لطف دارید. برای تشکر هم زدن دکمه کفایت می کنه.
پس باید صبر کنید. این روزها خیلی وقت آزاد ندارم. فرصت شد نگاه می کنم. هنوز اصلاحیه کامپوننت خودم رو انجام ندادم.

[یوسف زالی]

امروز وقت کردم کامپوننت رو بررسی کنم، اما سر و تهش رو نشد به هم ربط بدم.
اگر کامپوننت رو کامل بگذارید بهتر می شه کمک کرد.

[مرد مباح]

ممنون از شما. کم کم داشتم نا امید میشدم.
خیلی بزرگه. و نمیتون اینجا آپ کنم. پیشنهادی دارید؟
البته لینک دانلود از روی وب اینه :
DevExpress 12.1.6+Source (http://depositfiles.com/files/rqwiegw16) حجم 120 مگ
DevExpress 13.1.4+Source (http://depositfiles.com/files/rq7qnlv1v) حجم 440 مگ

من خودم ورژن 12.1.6 رو دارم چون حجمش کمتره راحتتر بودم. البته فکر نکنم فرق زیادی باهم بکنن. میدونم یک سری عکس و ... رو 13 اضافه شده که حجمش رفته اینقدر بالا.
ولی اگه 13 مد نظر شما بود، بفرمائید تا منم Download کنمش.

[SayeyeZohor]

با تشکر فراوان از شما you-see عزیز.
من سوالی برام پیش اومده که نمیدونم چطوری این کار انجام میشود. برای BidiMode در دلفی قاعدتا کدی نوشته شده. شما هم با اضافه کردن اون در published براحتی از اون استفاده کردید.
اولا این کد کجای سورسهای دلفی نوشته شده ؟
ثانیا من دارم سعی میکنم یک کامپوننت که این قابلیت رو نداره بهش اضافه کنم. ولی نتونستم. میتونی لطفا راهنماییم کنید؟

والد اصلی از TCustomControl منشا گرفته و اکثر کامپوننتها از اون تولید شدن
مجموعه کامپوننت هدف من DevExpress هست که تقریبا همه دوستان آشنایی دارن. کامپووونت اولیه هم cxGrid بود. ولی وقتی اومدم بالا دیدم اکثر خصوصیاتش رو از TcxControl میگیره. اگه Bidimode رو توی Private اون اضافه کنم مشکل حل میشه؟
برای اینستال مجدد این مجموعه به این گندگی چی کار باید کرد؟

فایل .pas دستکاری شده رو جایگزین اصلی میکنی ok

[مرد مباح]

ممنون. دوستمون جواب رو قبلا داده بود. این کار باعث نمیشه کتمپوننت عمل کنه.
باید کلش رو یکبار دیگه Build کنی تا سرجاش بشینه

[SayeyeZohor]

ممنون. دوستمون جواب رو قبلا داده بود. این کار باعث نمیشه کتمپوننت عمل کنه.
باید کلش رو یکبار دیگه Build کنی تا سرجاش بشینه

نسخه کرکی رو من build نکردم یکی از دوستان فایل pas رو جایگزین کرد
البتع فایل pas رو کنار فایل dpr پروژه جایگزین کرد

[مرد مباح]

دوست عزیز، You-See من کماکان منتظرم تا جواب از شما بگیرم. خیلی دوست دارم این کار رو بکنیم. چون دلم میسوزه که کامپوننت راست به چپ این رو توی .net دادن و ما هنور تو دلفی نداریم. دوست ندارم جا بمونن بچه ها.کمک کن

ترتیبشو بدیم. گرچه میدونم که سرت شلوغه و این کار شاید برات اونقدا ارزش نداشته باشه. ولی ازتون خواهش دارم بعنوان استاد منرو راهنمایی کن.

ممنونم ازت

[یوسف زالی]

ببخشید که این قدر دیر جواب می دم.
شروع کن، کمکت می کنم.
ایراد هات رو از اول یکی یکی بگو تا بتونم برسم جواب بدم.