PDA

View Full Version : مشکل واقعا عجیب با دلفی 7- Access Violation ...


آیدا رضایی
یک شنبه 09 بهمن 1384, 23:16 عصر
سلام دوستان.
من الان حدود 3 هفته هست که دارم روی یک پروژه در دلفی 7 کار میکنم و برنامه نویسی میکنم.
در چند روز اخیر با پیغام های عجیب دلفی مواجه شدم.
مثلا هنگامی که دستور
ReminderForm.show که به یک Button نصب میدم با error عجیب :

Access Violation at address 005e62fa in module '<Mainproject.exe' .read of address 0000000078
مواجه میشم.
حالا در مورد فراخوانی یا حتی Close کردن بقیه فرمها هم با این مشکل ربرو میشم.
خلاصه اینکه کل برنامه من رو بهم ریخته و حسابی وقتم تلف شده.
دوستان اگه تا حالا به همچین مشکلی بر خورد کردن و یا اینکه راه حل این مسئله رو میدونن خواهشا کمک کنند.
Naficy
یک شنبه 09 بهمن 1384, 23:51 عصر
خطای access violation، هنگام دسترسی غیر مجاز به حافظه رخ می دهد. و متاسفانه یکی از بدقلق ترین خطاهای موجود است.
اگر دقیقا مطمئنید که برنامه حین اجرای همین خط خطا می دهد، قاعدتا فرم ReminderForm شما یا قبل از اجرای این دستور ساخته نشده است، و یا تخریب شده است.
آیدا رضایی
دوشنبه 10 بهمن 1384, 01:13 صبح
مسئله اصلی اینه که اطلا نه ساخته شده و نه free شده.
آیا ممکنه مشکل از دلفی باشه ؟
mehranFX
دوشنبه 10 بهمن 1384, 08:50 صبح
توضیحات تکمیلی بذار ببینم چی کار کردی ؟
- دیتا بیس داری یا نه ؟
- یه دونه پروژ0ه جدید تعریف کن ببین این مشکل هنوز وجود داره یا نه؟ اگه آره که حتما دوبراه دلفی نصب کن ؟
- از چه کامپوننت هایی استفاده کردی ؟
- جایی دسترسی به یه ایندکس یا چیزه دیگه تعریف نکردی ؟
و خیلی چیزای دیگه ... اول درست سئوالت مطرح کن بگو چی کار کردی و چی می خوای ؟
آیدا رضایی
دوشنبه 10 بهمن 1384, 10:40 صبح
از دیتابیس استفاده میکنم :
DBIsam
از کامپیوننت های زیر هم استفاده میکنم :
TrayIcon
SUIPack
ThreadedTimer
SalarSoftHint
MaskForm(salasoft)
1Class(ImageButton)
و یک یا دو یونیت توابع تاریخ هجری شمسی
//--
در بعضی مواقع که فرم هارو داینامیک Create میکنم دیگه اون مشکل صدا زدنشون پیش نمیاد.
اما وقتی مثلا در اون فرم یه Button میخواد عمل Close کردنشون رو بعهده بگیره همین Error رو میده
ali_abbasi22145
دوشنبه 10 بهمن 1384, 10:48 صبح
سلام دوستان.
من الان حدود 3 هفته هست که دارم روی یک پروژه در دلفی 7 کار میکنم و برنامه نویسی میکنم.
در چند روز اخیر با پیغام های عجیب دلفی مواجه شدم.
مثلا هنگامی که دستور
ReminderForm.show که به یک Button نصب میدم با error عجیب :

Access Violation at address 005e62fa in module '<Mainproject.exe' .read of address 0000000078
مواجه میشم.
حالا در مورد فراخوانی یا حتی Close کردن بقیه فرمها هم با این مشکل ربرو میشم.
خلاصه اینکه کل برنامه من رو بهم ریخته و حسابی وقتم تلف شده.
دوستان اگه تا حالا به همچین مشکلی بر خورد کردن و یا اینکه راه حل این مسئله رو میدونن خواهشا کمک کنند.

سلام
در ضمن چه خبره اینهمه کامپوننت!!!!
من هم مشکل شبیه به شما داشتم آخرین دستورالعمل ها یا کامپوننت را را که استفاده کردی حذف کن ببین چه می شود یا در هنگام اجرا معمولا خطا فوق در خطی که رخ داده نشان می دهد.
یا یک گام به قبل برگرد و برنامه قبلی را استفاده کن.
SATTAR
دوشنبه 10 بهمن 1384, 10:53 صبح
مشکل تو همون دینامیک create کردنه
و بی احتیاطی دیگه بعد از show و showmodal پیش میاد. این دو تامتد به جز فرقهای ظاهری خیلی فرقها تو بازگشت اشاره گر و آزاد شدن حافظه داره.
به نظر من مشکل اینجاس که احتمالا شما اول فرم را میسازی و تو خط بعد با متد show نشونش میدی و مثلا تو خط بعد free میکنیش . خوب قطعا اینجا error میده.
در صورتی error نمیده که شما از showmodal استفاده کنی یا اینکه هنگام بسته شدن اون فرم حافظشو free کنی.
vcldeveloper
دوشنبه 10 بهمن 1384, 14:22 عصر
احتمالا شما اول فرم را میسازی و تو خط بعد با متد show نشونش میدی و مثلا تو خط بعد free میکنیش .
یه همچین کاری چه کاربردی می تونه داشته باشه؟!!
VouDou_ir
دوشنبه 10 بهمن 1384, 14:28 عصر
لطفا اون تیکه را کامل در اینجا قرار بدید
و توی Event فرم تون بگید از کدومشون استفاده کردید :)

پ.ن : این خطا ، خطای دلپذیریست ، "نازنین" ;)
Kamyar.Kimiyabeigi
دوشنبه 10 بهمن 1384, 14:57 عصر
سلام دوستان.
من الان حدود 3 هفته هست که دارم روی یک پروژه در دلفی 7 کار میکنم و برنامه نویسی میکنم.
در چند روز اخیر با پیغام های عجیب دلفی مواجه شدم.
مثلا هنگامی که دستور
ReminderForm.show که به یک Button نصب میدم با error عجیب :

Access Violation at address 005e62fa in module '<Mainproject.exe' .read of address 0000000078
مواجه میشم.
حالا در مورد فراخوانی یا حتی Close کردن بقیه فرمها هم با این مشکل ربرو میشم.
خلاصه اینکه کل برنامه من رو بهم ریخته و حسابی وقتم تلف شده.
دوستان اگه تا حالا به همچین مشکلی بر خورد کردن و یا اینکه راه حل این مسئله رو میدونن خواهشا کمک کنند.
احتمالا" فرمتون هنوز create نشده و شما می خواین اون رو show کنین من همیشه از روش زیر کارمو انجام میدم و مطمئن هم هست


try
Application.CreateForm(TForm2, Form2);
Form2.ShowModal;
finally
FreeAndNil(Form2);
end;

خوش باشین
mamizadeh
دوشنبه 10 بهمن 1384, 15:20 عصر
با سلام دوست عزیز من کوچکتر از اونی هستم که در کنار دوستانی مثل این جمع بلبل زبانی بکنم ولی به نظر من
برای FreeAndNil ایراد می گیره چون این تابع برای متغییر ها خوب هستش نه برای فرم ها
از طرفی شما گغتید try کن تا فرم باز بشه بعد گفنید که Finally یعنی هر اتفاقی افتاد چه درست چه خطا تو فرم را نابود کن.
دوست عزیز این کار صد در صد ایراد داره شما بیا و بزرگی کن و این کود را استفاده کن


form2:=Tform2.creat(applicatin)
form2.show;
form2.update;
و در قسمت onclose فرم بنویس
Action:=CaFree;
با تشکر محمد ممی زاده
البته نظر من هستش (من بودم این کار را می کردم چون کلاسی به بزرگی کلاس فرم بستنش با Nil کمی خوب نیست بهتره که فرم را فقط آزاد کنی)
Kamyar.Kimiyabeigi
دوشنبه 10 بهمن 1384, 15:41 عصر
برای FreeAndNil ایراد می گیره چون این تابع برای متغییر ها خوب هستش نه برای فرم ها
از طرفی شما گغتید try کن تا فرم باز بشه بعد گفنید که Finally یعنی هر اتفاقی افتاد چه درست چه خطا تو فرم را نابود کن.
دوست عزیز این کار صد در صد ایراد داره شما بیا و بزرگی کن و این کود را استفاده کن


form2:=Tform2.creat(applicatin)
form2.show;
form2.update;
و در قسمت onclose فرم بنویس
Action:=CaFree;
با تشکر محمد ممی زاده
البته نظر من هستش (من بودم این کار را می کردم چون کلاسی به بزرگی کلاس فرم بستنش با Nil کمی خوب نیست بهتره که فرم را فقط آزاد کنی)
خیلی ممنون از نظرتون
اما صرف استفاده از try به منظور این نیست که حتما" try کن تا فرم باز بشه ... نه مطمعنا" اگر Error ایی باشه حتما exception میده.. اگر از try ... except استفاده کرده بودم صحبت شما درست بود...
اما در مورد freeandnil باید بگم که این function برای object , variable , هر چیزی که حافظه مصرف کنه استفاده میشه و فرم هم یک object هست ... همونطور که خودتونم نوشتین دارین از free استفاده میکنین
خوش باشین
آیدا رضایی
دوشنبه 10 بهمن 1384, 19:01 عصر
مسئله اصلی اینه که من در مورد فرمهای غیر داینامیک هم همین مشکل رو دارم.
یعنی حتی وقتی میخوام فرمهای Auto Create رو فراخونی کنم بازم همین Error رو میده.
جالب اینجاست که وقتی اون فرمهای رو به لیست فرمهای Available اضافه میکنم و بعدا اونها رو بوسیله کد Create میکنم مشکل حل میشه !!!! . نکته عجیب دقیقا همین جاست !! .
تازه من سورس اصلی رو هم اصلا دست نزدم !.
ببینید :


program MainProject;

uses
Forms,
MainUnit in 'MainUnit.pas' {MainForm},
DTMUnit in '..\DTMUnit.pas' {DTM: TDataModule},
ReminderUnit in '..\ReminderUnit.pas' {ReminderForm},
CalenderUnit in '..\CalenderUnit.pas' {CalenderForm},
EventFormUnit in '..\EventFormUnit.pas' {EventForm},
ReminderWindowUnit in '..\ReminderWindowUnit.pas' {ReminderWindow},
RemindeListUnit in '..\RemindeListUnit.pas' {RemindeListForm},
SplashUnit in '..\SplashUnit.pas' {SplashForm},
SmallModeUnit in 'SmallModeUnit.pas' {Form_SmallMode},
ReminderForm2Unit in 'ReminderForm2Unit.pas' {ReminderForm_Window};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TDTM, DTM);
Application.CreateForm(TReminderForm, ReminderForm);
Application.CreateForm(TCalenderForm, CalenderForm);
Application.Run;
end.

//---
برنامه هم درست نوشته شده .
البته من در این برنامه حدود 355 تا Button داینامیک دارم .
اما فکر نمیکنم اونها مشکلی رو ایجاد کنن.
چون بموقع Create و بموقع Free میشن .!
اما خوب فعلا که با Create کردن داینامیک دلفی زیاد گیر نمیده !!! :ناراحت: :ناراحت: :ناراحت: .
Naficy
سه شنبه 11 بهمن 1384, 09:08 صبح
اووووووه چه خبره اینجا!

ببینم، منظورتون چیه که با کد create می کنین؟ بهتره کدهای مربوطه به همین create کردنتون رو هم اینجا بذارین.
احتمال زیادی می ره که تویه close کردن فرم و ... ایرادی وجود داشته باشه. پس لطفا کدهای قسمتهای زیر رو توی فوروم بذارین:
1 - محلهای create فرمها
2 - رویدادهای onclose و onshow و oncreate و سایر روالهای مشابه این ها از فرم .
3 - کلیه مکانهایی که توش سعی کردین این فرم رو close کنین.

.... البته قبل از ارسال اینها، کاری رو که این زیر گفتم انجام بدین تا دقیقا متوجه بشیم خطا از کجاست:
***************
لطف کنید یک breakpoint روی همون خطی که فکر می کردین ایراد رو ایجاد کرده قرار بدین. و با زدن کلید f7 اجرای برنامه رو دنبال کنید. ببینید دقیقا بعد از اجرای کدوم خط برنامه خطا می ده. بعد اون خط رو با متعلقاتش بذارین اینجا.
anubis_ir
سه شنبه 11 بهمن 1384, 10:42 صبح
مشکل در close‌ کردن و ایجاد خطای شما از کامپوننت ThreadedTimer ناشی میشه.
چند روزی هست تردها در دلفی اشک من رو درآورده. به سایت بورلند هم که مراجعه می‌کنی می‌بینی که تردها در دلفی بسیار پر باگ پیاده سازی شده‌اند:
برای مثال: باگی در تقریبا تمامی نگارش های دلفی در مورد خاتمه و آزاد سازی تردها.
http://qc.borland.com/wc/qcmain.aspx?d=22267
http://qc.borland.com/wc/qcmain.aspx?da=135
babak869
سه شنبه 11 بهمن 1384, 10:59 صبح
مشکل شما را برنامه Suipack ایجاد کرده.کامپوننت Suipack رو از برنامه حذف کن درست میشه .این مشکل زمانی پیدا میشه که در برنامه از دیتابیس استفاده کنی و پس از گذاشتن کامپوننت Suipack یا SuiSkin مجددا فرم جدید با کنترلهای دیتابیس ایجاد کنید.
موفق باشید
VouDou_ir
سه شنبه 11 بهمن 1384, 11:53 صبح
با توجه به همه اطلاعاتی که دادید بازم اظهار نظر قطعی مشکل است
چند سئوال :
1- شما چطوری فرم ها رو Free میکنید ؟
2- آیا دفعه اول Show این اتقاق می افتد ؟
3- از صحبتهای شما چنین برداشت میکنم شما بعد از مدتی با این مشکل برخوردید ، میتونید بگید از چه زمانی بوده ؟

من فکر کنم نیاز به بازنگری کلی در مدیریت فرم دارید .
رفع مشکل با حذف یک Component بدون یافتن منبع مشکل کار عاقلانه ای نیست .
babak869
سه شنبه 11 بهمن 1384, 16:17 عصر
رفع مشکل با حذف یک Component بدون یافتن منبع مشکل کار عاقلانه ای نیست .

شما اگه متخصص اینکاری این گوی و این میدان .اما من نظر شخصی خودم رو گفتم .منم با این مشکل زیاد ور رفتم اما آخر سر نتیجه این شد که با برداشتن کامپوننت مشکل حل شد حالا اگه شما راهی سراغ دارید که این مشکل رو اصولی رفع میکنه بفرمایید
vcldeveloper
چهارشنبه 12 بهمن 1384, 07:34 صبح
به سایت بورلند هم که مراجعه می‌کنی می‌بینی که تردها در دلفی بسیار پر باگ پیاده سازی شده‌اند:

هر مشکلی که در QC مطرح میشه لزوما نشان دهنده وجود یک باگ نیست!
در ضمن در دلفی همیشه دستتون بازه که مستقیما از توابع API استفاده کنید، هر چند به نظر من ایراداتی که از TThread گرفتند اکثرا جزئی هستند.
anubis_ir
چهارشنبه 12 بهمن 1384, 10:56 صبح
مثالی که لینکش را دادم می تونید دانلود و اجرا کنید. (بعد از لاگین در سایت)
http://qc.borland.com/wc/AttachmentHandler.ashx?r=22267&fn=Synchronize%20And%20WaitFor.zip
روی دلفی 6 و 7 و 2006 دقیقا خطا رخ داد و برنامه هنگ کرد. (اتفاقا ایراد بسیار وخیم است!)
vcldeveloper
چهارشنبه 12 بهمن 1384, 11:34 صبح
روی دلفی 6 و 7 و 2006 دقیقا خطا رخ داد و برنامه هنگ کرد. (اتفاقا ایراد بسیار وخیم است!)
ایراد مربوط به برنامه های Mulit Threaded ایی هست که از Synchronize و WaitFor بصورت همزمان استفاده می کنند .
ایراد بزرگی نیست، چون از Synchronize به عنوان یک راه ابتدایی برای بروز رسانی رابط کاربر استفاده میشه. شما می تونید به راحتی از روش های دیگه ایی بجای Synchronize استفاده کنید. از طرفی همونطور که گفتم همیشه امکان استفاده مستقیم از توابع API ویندوز هم وجود داره.
VouDou_ir
چهارشنبه 12 بهمن 1384, 15:30 عصر
متاسفانه کسی که مشکل داشت(خانوم آیدا رضایی) به سئوالات بنده جواب ندادند !
اگر مشکل حل شده اعلام کنند.


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

ممکنه با حذف کامپوننت مشکل حل شود ولی من حرفم اینست که تا دلیل این حذف را ندانیم نباید این کار را انجام داد ، ممکنه در کوتاه مدت جواب مطلوب دریافت کنید ولی مطمئنا در پروژه های بعدی یقه شما را خواهد گرفت.
تا اطلاعات کامل درباره مشکل دریافت نکنم درباره آن اظهار نظر نمی کنم برای همین آن سئوالات را مطرح کردم.

لازم میدونم یادآوری کنم بنده نقدی به "نظر شخصی" شما (که تکنیکال بود )داشتم.
esi022
پنج شنبه 13 بهمن 1384, 03:08 صبح
سلام
من همه پیشنهادهارو خوندم . یه 2-3 کیلو پیشهاد هم از من:

0 - زنده باد علی کشاورز - off :D
1 - روی یک دستگاه دیگه که دلفی 7 داره تست کنید.
2 - روی دلفی 5 هم تست کنید
3 - تمام کامپوننتهای غیر استاندارد رو برای تست cancel کن و بجاش استاندارد بگذارید . می دونم سخته
4 - مطمئنی که دستورای sql مثل copy در هنگام اجرا به مشکل نمی خورن؟؟؟؟!!
5 - چرا dbisam؟
6 - سلامت و موفق باشی
vcldeveloper
پنج شنبه 13 بهمن 1384, 08:40 صبح
Access Violation یک پیغام خطای عمومی و نمیشه به تنهایی از پیغام خطا به مشکل مربوطه رسید، در نتیجه نمیشه یه راه حل شسته و رفته براش ارائه کرد. منطقی ترین راه حل ممکن اینه که برنامه نویس خودش از طریق ابزارهای Debug ایی که داره به دنبال محل وقوع خطا بگرده که این مطلب را هم آقای Naficy توضیح دادند. پس بهتره همون کاری را که ایشون گفتند انجام بدید.
آیدا رضایی
پنج شنبه 13 بهمن 1384, 11:45 صبح
دوستان عزیز .
در ابتدا باید بگم این ID ماله من نیست و به پیشنهاد یکی از همکاران من با ID ی که خودش داشت این موضوع رو مطرح کردم ( تنبلی کردم که خودم ID بسازم و این تاپیک مربوط به خانم رضایی نیست. حالا بگذریم .)
---
من سورس قسمتهایی که از کنترلهای داینامیک استفاده کردم رو میذارم .
ادر ضمن یکی از دوستان گفته بودن که SUIPack رو حذف کنم.
اینکار رو کردم و مشکل حل نشد.
البته باید بگم الان دیگه هیچ مشکلی تو برنامه نیست و گاهی اوقات اون هم به علت دسترسی های واقعا غیر مجاز به این مشکلات برخورد میکنم.
اما در جهت اینکه دوستان ببینند راهی که من رفتم به ناکجا آباد در مورد کنترلهای داینامیک نمیره این کدها رو میذارم تا در صورت وجود مشکل راهنمایی کنند.
در ضمن این کدها طولانی هستند و جاهای دیگشو به علت بی اهمیت بودن من اینجا نیوردم.
نکته دیگه این که این کدها رو همیشه بررسی میکنم و اگه جایی ببینم با راه حل بهتری که انجام عملی رو سریع تر و آسان تر میکنه اونها رو تغییر میدم ( واسه قسمتهایی که Query گرفته شده و میشه با روش های بهتری انجام داد . البته اگه دوستان متذکر بشن خوشحال میشم اما در کل جای تغییر در این کدها زیاده !).
شروع کدها :

.
.
.
public
.
.
MyBtn : array [1300..1500] of array [1 .. 12] of array [1..31] of TfcImageBtn ;
SmallIcon : array [1300..1500] of array [1 .. 12] of array [1..31] of TfcImageBtn ;
Function WhatsThisButtonImage(Date:String):String;
Procedure CreateDynamicProgressBar;
Procedure CreateYear ;
Procedure CreateButton ;
Procedure butclick(sender : TObject );
procedure butRightClick(Sender: TObject; Button: TMouseButton;
var
.
.
.

Function SetDataBaseState():String; // &#202;&#199;&#200;&#218; &#211;&#199;&#206;&#202; &#207;&#211;&#202;&#230;&#209;&#199;&#202; &#199;&#211; ˜&#237;&#230; &#199;&#225;
var
SqlTemp,SqlTemp2 : String ;
Begin
with DTM.Query_ReminderID DO
Begin
SQL.Clear ;
SQL.Add('select * from RemindeDateIDTable where Date = ' + QuotedStr(TodayDate) +'OR Date = ' + QuotedStr

(Trim(AllYearField))) ;
ExecSQL ;
//ShowMessage(AllYearField);
//ShowMessage(TodayDate);
//-----
IF DTM.Query_ReminderID.RecordCount > 0 Then
Begin
First;
while not Eof Do
Begin
SqlTemp := SqlTemp + ' OR ID = ' + inttostr(DTM.Query_ReminderID.FieldValues['ID']);
Next ;
End ;
End ;

SqlTemp := (copy(SqlTemp,5,length(SqlTemp)));
sqltemp2 := 'select * from remindertable where ' + SqlTemp;
End ;

with DTM.Query_Reminder do
Begin
SQL.Clear ;
SQL.Add(Trim(SqlTemp2) ) ;
ExecSQL ;
End;
Result := SqlTemp2 ;
End;

//----
//=========== پروسه نمایش روز راست کلیک شده ===============

Procedure TMainForm.ShowRemindeVeiwOFButton(Date:string); // &#202;&#199;&#200;&#218; &#211;&#199;&#206;&#202; &#207;&#211;&#202;&#230;&#209;&#199;&#202; &#199;&#211; ˜&#237;&#230; &#199;&#225;
var
SqlTemp,SqlTemp2,AllYearFieldDate : String ;
Begin
AllYearFieldDate := 'Year/' + copy(date,6,5);
with DTM.Query_ReminderID DO
Begin
SQL.Clear ;
SQL.Add('select * from RemindeDateIDTable where Date = ' + QuotedStr(Date) +'OR Date = ' + QuotedStr(Trim

(AllYearFieldDate))) ;
ExecSQL ;
//-----
IF DTM.Query_ReminderID.RecordCount > 0 Then
Begin
First;
while not Eof Do
Begin
SqlTemp := SqlTemp + ' OR ID = ' + inttostr(DTM.Query_ReminderID.FieldValues['ID']);
Next ;
End ;
//ShowMessage(SqlTemp);
//---
SqlTemp := (copy(SqlTemp,5,length(SqlTemp)));
sqltemp2 := 'select * from remindertable where ' + SqlTemp;
//ShowMessage(SqlTemp2);
with DTM.Query_ReminderView do
Begin
SQL.Clear ;
SQL.Add(Trim(SqlTemp2) ) ;
ExecSQL ;
End;
RemindeListForm := TRemindeListForm.Create(MainForm) ;
try
RemindeListForm.Caption := 'لیست یادآوری های ' + Date ;
RemindeListForm.ButtonSenderDate := Date ;
RemindeListForm.Show;
finally
end ;
End
Else
ShowMessage('هیچ یادآوری برای امروز وجود ندارد');
End ;
End;

//===
procedure TMainForm.butclick(sender : TObject );
var
btname : string ;
begin
btname := TButton(sender).Name;
ReminderForm.Edit_RemindeDate.Text := inttostr(CurrentYear) + '/' + copy(btname,8,2) + '/' + copy(btname,11,2);
ReminderForm.ShowModal ;
end;

//===
procedure TMainForm.butRightClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer );
var
btname,DateTemp : string ;
begin
IF Button = mbRight Then
Begin
btname := TButton(sender).Name;
//ShowMessage(btname);
DateTemp := inttostr(CurrentYear) + '/' + copy(btname,8,2) + '/' + copy(btname,11,2);
//ShowMessage(DateTemp);
//ThreadedTimer.Enabled := False ;
ShowRemindeVeiwOFButton(DateTemp);
//ThreadedTimer.Enabled := True ;
End ;
end;
//===
Procedure IsThisYearHaveEvent(YearNumber : Integer) ;
begin
with DTM.DBQuery do
begin
SQL.Clear ;
sql.Add('select * from EventTable where date like ' + QuotedStr( '%' + IntToStr(CurrentYear) + '%'));
ExecSQL ;
ShowMessage(IntToStr(RecordCount));
end ;
IF DTM.DBQuery.RecordCount > 0 Then IsYearHaveEvent := True Else IsYearHaveEvent := False ;
end ;
//===
Function TMainForm.WhatsThisButtonImage(Date:String):String ;
var
AllYear : String ;
HintEventTypeTemp,HintRemindeMessageTemp,HintCompo sed : String ;
Day,Mount : integer ;
freecomp : TComponent ;
Begin
AllYear := 'Year/' + copy(Date,6,5); // &#202;&#199;&#209;&#237;&#206; &#199;&#237;&#228; &#207;˜&#227;&#229; &#207;&#209; &#221;&#237;&#225;&#207;&#229;&#199;&#237; &#229;&#227;&#229; &#211;&#199;&#225;&#229;
day := strtoint(copy(Date,6,2));
Mount := strtoint(copy(Date,9,2)) ;
// &#202;&#218;&#237;&#237;&#228; &#212;˜&#225;˜&#229;&#199;&#237; &#207;˜&#227;&#229; &#229;&#199;&#237;
with DTM.Query_Reminder do
begin
SQL.Clear ;
SQL.Add('Select * from remindertable where EventDate = ' + QuotedStr(Date) + 'OR EventDate = ' + QuotedStr

(AllYear));
ExecSQL ;
end ;
//===
IF DTM.Query_Reminder.RecordCount = 1 Then // &#199;�&#209; &#221;&#222;&#216; &#237;˜ &#218;&#228;&#230;&#199;&#228; &#227;&#230;&#204;&#230;&#207; &#200;&#230;&#207;
Begin
// IF Not Assigned(SmallIcon[CurrentYear][day][Mount]) Then
SmallIcon[CurrentYear][day][Mount] := TfcImageBtn.Create(self);
with SmallIcon[CurrentYear][day][Mount] do
Begin
Caption := '' ;
Parent := MyBtn[CurrentYear][day][Mount].Parent ;
Height := 16 ;
Width := 16 ;
SmallIcon[CurrentYear][day][Mount].Top := MainForm.MyBtn[CurrentYear][day][Mount].Top ;
SmallIcon[CurrentYear][day][Mount].Left := MainForm.MyBtn[CurrentYear][day][Mount].Left ;
HintEventTypeTemp := DTM.Query_Reminder.FieldValues['RemindeType'] ;
HintRemindeMessageTemp := DTM.Query_Reminder.FieldValues['RemindeMessage'] ;
HintComposed := HintEventTypeTemp + ' : ' + HintRemindeMessageTemp ;
Case DTM.Query_Reminder.FieldValues['RemindeIntType'] OF
0 : Begin
Image.LoadFromFile('C:\button\IcAp.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
1 : Begin
Image.LoadFromFile('C:\button\IcBirthday.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
2 : Begin
Image.LoadFromFile('C:\button\IcCheck.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
3 : Begin
Image.LoadFromFile('C:\button\IcQuiz.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
4 : Begin
Image.LoadFromFile('C:\button\IcMarry.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
5 : Begin
Image.LoadFromFile('C:\button\IcDead.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
6 : Begin
Image.LoadFromFile('C:\button\IcImportant.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
7 : Begin
Image.LoadFromFile('C:\button\IcUnknow.bmp');
ImageDown := Image ;
Hint := HintComposed ;
End ;
end;
SmallIcon[CurrentYear][day][Mount].Repaint ;
End ;
End ;
//--
IF DTM.Query_Reminder.RecordCount > 1 Then
Begin
//IF Not Assigned(SmallIcon[CurrentYear][day][Mount]) Then
SmallIcon[CurrentYear][day][Mount] := TfcImageBtn.Create(self);
with SmallIcon[CurrentYear][day][Mount] do
Begin
Caption := '' ;
Parent := MyBtn[CurrentYear][day][Mount].Parent ;
Height := 16 ;
Width := 16 ;
SmallIcon[CurrentYear][day][Mount].Top := MainForm.MyBtn[CurrentYear][day][Mount].Top ;
SmallIcon[CurrentYear][day][Mount].Left := MainForm.MyBtn[CurrentYear][day][Mount].Left ;
Image.LoadFromFile('C:\button\many.bmp');
ImageDown := Image ;
With DTM.Query_Reminder Do
Begin
First ;
Hint := DTM.Query_Reminder.FieldValues['RemindeType']+ ' : ' + DTM.Query_Reminder.FieldValues

['RemindeMessage'] + #13 ;
Next ;
While Not Eof Do
Begin
Hint := Hint + DTM.Query_Reminder.FieldValues['RemindeType']+' : ' + DTM.Query_Reminder.FieldValues

['RemindeMessage'] + #13 ;
Next;
End ;
End ;
SmallIcon[CurrentYear][day][Mount].Repaint ;
End ;
End;
// IF DTM.Query_Reminder.RecordCount = 0 Then SmallIcon[CurrentYear][day][Mount].Free ;
End ;

/// ********************* /// قسمت خاص برنامه اینجاست
Procedure TMainForm.CreateButton ; // �&#209;&#230;&#211;&#229; &#211;&#199;&#206;&#202; &#207;˜&#227;&#229; &#229;&#199;
var
counter : integer ;
//mybtn : TfcImageBtn ;
ButtonDate,ButtonAllYearDate : string ;
Begin
try
counter := 0 ;
for I := 1 to 5 do
Begin
//Application.BiDiMode := bdRightToLeft ;
for L := 7 downto 1 do
Begin
mybtn[CurrentYear][strtoint(ReturnValidMountNumber(PageCount))][ReturnVildLPosistion(I*L)] :=

TfcImageBtn.Create(MountPage.Pages[pagecount]);
//-----------
with mybtn[CurrentYear][strtoint(ReturnValidMountNumber(PageCount))][ReturnVildLPosistion(I*L)] do
Begin
Parent := MountPage.Pages[pagecount] ;
OnClick := butclick;
//OnClick := butDBLclick;
OnMouseDown := butRightClick;
Caption := IntToStr(counter + 1) ;
Height := 32 ;
Width := 32 ;
Font.Size := 10 ;
BiDiMode := bdRightToLeft ;
Font.Name := 'Tahoma' ;
Font.Style := [fsBold] ;
Font.Color := clBlack ; // &#209;&#230;&#210;&#229;&#199;&#237; &#219;&#237;&#209; &#202;&#218;&#216;&#237;&#225;
// Effects
TextOptions.Style := fclsOutline ;
TextOptions.OutlineColor := clWhite ;
//==
Image.LoadFromFile('C:\button\testn.bmp');
ImageDown.LoadFromFile('C:\button\testn2.bmp');
// &#204;&#227;&#218;&#229; &#229;&#199;
IF LeftCounter = 30 Then
Begin
Font.Color := clRed ;
Image.LoadFromFile('C:\button\testtatiil.bmp');
End ;
//---
Left := SetLeftPos ;
Top := TopCounter * 28 ;
ButtonPosition[PageCount][ReturnVildLPosistion(i*L)] := Left ;
//==============
Name := 'b_' +inttostr(CurrentYear)+ '_' + ReturnValidMountNumber(PageCount) + '_' +

ReturnValidDayNumber(counter + 1) ;
//ShowMessage(Name);
Repaint ;
//====== �&#209;&#221;&#202;&#228; &#202;&#199;&#209;&#237;&#206; &#199;&#227;&#209;&#230;&#210; &#230; &#227;&#212;&#206;&#213; &#211;&#199;&#210;&#237; ========
ButtonDate := SetTrueDate(PageCount, counter + 1) ; // &#202;&#199;&#209;&#237;&#206; &#199;&#237;&#228; &#207;˜&#227;&#229;
ButtonAllYearDate := 'Year/' + copy(ButtonDate,6,5); // &#202;&#199;&#209;&#237;&#206; &#199;&#237;&#228; &#207;˜&#227;&#229; &#207;&#209; &#221;&#237;&#225;&#207;&#229;&#199;&#237; &#229;&#227;&#229; &#211;&#199;&#225;&#229;
//---
WhatsThisButtonImage(ButtonDate) ; // &#202;&#218;&#237;&#237;&#228; &#212;˜&#225;˜&#229;&#199;
//====== �&#199;&#237;&#199;&#228; ========
// �&#209;&#221;&#202;&#228; &#209;&#230;&#237;&#207;&#199;&#207; &#209;&#230;&#210;
IF IsYearHaveEvent = True Then
begin
DTM.DBQuery.SQL.Clear ;
DTM.DBQuery.SQL.Add('select * from eventtable where date = ' + QuotedStr(ButtonDate));
DTM.DBQuery.ExecSQL ;
end ;
//-------------

IF DTM.DBQuery.RecordCount > 0 Then Hint := DTM.DBQuery.FieldValues['eventtitle'] ;

IF ButtonDate = CalenderForm.FarsiCalendar1.Today Then
Begin
//ButtonNameOFToday := Name ;
//ButtonProperyOFToday.Name := Name ;
//ButtonProperyOFToday.Date := ButtonDate ;
//Flat := False ;
Font.Color := clBlue ; // &#227;&#212;&#206;&#213; &#211;&#199;&#210;&#237; &#207;˜&#227;&#229; &#199;&#227;&#209;&#230;&#210;

IF FirstYearCreating = True Then // &#202;&#218;&#237;&#237;&#228; &#209;&#230;&#210; &#230; &#227;&#199;&#229; &#221;&#218;&#225;&#237; &#207;&#209; &#199;&#230;&#225;&#237;&#228; &#199;&#204;&#209;&#199;
MountPage.ActivePageIndex := PageCount ;

Image.LoadFromFile('C:\button\testntoday.bmp');
// &#211;&#199;&#206;&#202; &#227;&#212;&#206;&#213;&#199;&#202; &#209;&#230;&#237;&#207;&#199;&#207; &#199;&#227;&#209;&#230;&#210; &#211;&#199;&#225;
IF DTM.DBQuery.RecordCount > 0 Then
Begin
ButtonProperyOFToday.TodayName :=(ReturnPersianDate(LeftCounter,counter+1));
ButtonProperyOFToday.TodayTitle:= DTM.DBQuery.FieldValues['eventtitle'] ;
End;
// &#211;&#199;&#206;&#202; &#205;&#199;&#225;&#202; ˜&#230;�˜
TodayOFSamallMode := ReturnPersianDate(LeftCounter,counter+1);
//---
End ;
//====== �&#199;&#237;&#199;&#228; ========
//****************************
counter:= counter + 1 ;
//Top := TopCounter * 28 ;
IF counter = NumberOfMountDays Then Break ;
// &#209;&#230;&#228;&#207; &#199;&#204;&#209;&#199;&#237; &#200;&#209;&#228;&#199;&#227;&#229; &#207;&#209; &#212;&#209;&#230;&#218; &#200;&#209;&#228;&#199;&#227;&#229;
try
IF FirstYearCreating = True Then
Begin
SplashForm.ProgressBar_Loading.Position := SplashForm.ProgressBar_Loading.Position + 1 ;
SplashForm.Image1.Repaint ;
IF SplashForm.ProgressBar_Loading.Position > 340 Then
begin
SplashForm.ProgressBar_Loading.Position := 364 ;
Sleep(300);
SplashForm.free ;
end ;
End ;
except
end ;
//--
IF IsRunTimeCreating Then
begin
DynamicProgressBar.Position := DynamicProgressBar.Position + 1 ;
{ Case Counter Of
1..10 : Label_Loading.Visible := not Label_Loading.Visible ;
11..20 : Label_Loading.Visible := not Label_Loading.Visible ;
21..29 : Label_Loading.Visible := not Label_Loading.Visible ;
end ; }
Label_Loading.Repaint ;
end;
End ;
End;
End ;

except
end ; // end try
//Label_Loading.Visible := False ;
End;

دوستی که در مورد ترد تایمر میپرسید :

procedure TMainForm.ThreadedTimerTimer(Sender: TObject);
var hourdb,mindb,hournow,minnow : integer ;
LHour,LMinute,L1,L2: Word;
NHour,NMinute,N1,N2: Word;
timedb,timenow : string ;
IsWindowOnShowing : Boolean ;
begin
SetDataBaseState ;
//--
//try
IF Assigned(ReminderWindow) Then
begin
IsWindowOnShowing := True;
//ShowMessage('This Is Assigned !');
end
//except
else
begin
IsWindowOnShowing := False ;
//ShowMessage('Its Not Assigned !!!!');
end ;
//end ;
//--
IF IsWindowOnShowing = False Then
Begin

with DTM.Query_Reminder Do
Begin
First ;
while not DTM.Query_Reminder.Eof Do
Begin
IF (FieldValues['RemindeWarning'] = True) And (FieldValues['LastRemindedDate'] <> TodayDate) Then
Begin
DecodeTime(FieldValues['RemindeTime'],LHour,LMinute,L1,L2);
DecodeTime(Time,NHour,NMinute,n1,n2);
hourdb := LHour ; mindb := LMinute ;
hournow := NHour ; minnow := NMinute ;
//---
IF (NHour = LHour) And (NMinute = LMinute) Then
Begin
// ShowMessage('i reminding now !');
ReminderWindow := TReminderWindow.Create(self);
ReminderWindow.Lbl_Title.Caption := FieldValues['RemindeType'];
ReminderWindow.Lbl_Message.Caption := FieldValues['RemindeMessage'];
ReminderWindow.show ;
//---
CurrentID := FieldValues['id'];
dtm.Table_Reminder.Filtered := False ;
DTM.Table_Reminder.Filter:='IDStr = ' + QuotedStr(inttostr((FieldValues['id'])));
dtm.Table_Reminder.Filtered := True ; ;
DTM.Table_Reminder.Edit ;
DTM.Table_Reminder.FieldValues['LastRemindedDate'] := TodayDate ;
DTM.Table_Reminder.Filtered := False ;
DTM.Table_Reminder.Refresh ;
End;
End;
Next ;
End ;
End;
End;
end;

//===

Procedure TMainForm.CreateYear ;
Begin
//=== &#211;&#199;&#206;&#202; &#207;˜&#227;&#229; &#229;&#199;&#237; &#221;&#209;&#230;&#207;&#237;&#228;
For PageCount := 11 downto 6 do
Begin
TopCounter := 1 ;
FirstLine := True ;
TheFirstLine := True ;
NumberOfMountDays := 31 ;
CreateButton ;
End ;
//===
// &#211;&#199;&#206;&#202; &#207;˜&#227;&#229; &#229;&#199;&#237; &#227;&#229;&#209; &#202;&#199; &#200;&#229;&#227;&#228;
For PageCount := 5 downto 1 do
Begin
TopCounter := 1 ;
FirstLine := True ;
TheFirstLine := True ;
NumberOfMountDays := 30 ;
CreateButton ;
End ;
//=== &#211;&#199;&#206;&#202; &#207;˜&#229; &#229;&#199;&#237; &#199;&#211;&#221;&#228;&#207;
TopCounter := 1 ;
FirstLine := True ;
TheFirstLine := True ;
IF IsKabiseYear = True Then
NumberOfMountDays := 30 Else
NumberOfMountDays := 29 ;
CreateButton ;
End;
vcldeveloper
جمعه 14 بهمن 1384, 10:37 صبح
1- وقتی که یک Query یک Recordset را بر می گرداونه، از Open بجای ExecSQL استفاده کنید.
2- برای اینکه یک Component در داخل یک Component دیگه نمایش داده بشه، فقط تنظیم خصوصیت Parent کافی هست و بهتره Owner کامپوننت TForm باشه.
3- استفاده از بلوک های try...except بدون نوشتن کدی در قسمت except باعث میشه که خطاها های احتمالی بدون اینکه توسط برنامه نویس کنترل بشند یا به اطلاع کاربر برسند، در برنامه مخفی باقی بمانند.
4- اگر بخش IF FirstYearCreating = True Then در TMainForm.CreateButton بیش از یکبار اجرا بشه، بدلیل Free شدن SplashForm در اجرای اول، با پیغام Access Violation مواجه می شید.
اگر کد و کدهای مشابهه آن بیش از یکبار اجرا بشه، Memoy Leak بوجود میاد:


IF DTM.Query_Reminder.RecordCount = 1 Then // C?? ??? ?? ???C? ????I E?I
Begin
// IF Not Assigned(SmallIcon[CurrentYear][day][Mount]) Then
SmallIcon[CurrentYear][day][Mount] := TfcImageBtn.Create(self);

باید کد IF Not Assigned از حالت Comment خارج بشه.
آیدا رضایی
شنبه 15 بهمن 1384, 11:00 صبح
دوستان و جناب آقای کشاورز .
خیلی ممنون از کمکهای بسیار مفید و عالی تون.
فقط یه نکته رو میخواستم در موردی که عنوان کردید رو بیشتر توضیح بدید .
ممنون میشم.
نکته :

- وقتی که یک Query یک Recordset را بر می گرداونه، از Open بجای ExecSQL استفاده کنید
mehranFX
شنبه 15 بهمن 1384, 11:16 صبح
فقط یه نکته رو میخواستم در موردی که عنوان کردید رو بیشتر توضیح بدید .
ممنون میشم.
نکته :
نقل قول:
- وقتی که یک Query یک Recordset را بر می گرداونه، از Open بجای ExecSQL استفاده کنید

یعنی زمانی که قصد دارید اطلاعاتی را از سرویس دهنده بانک اطلاعاتی واکشی کنی به جای اینکه از ExecSQL استفاده نمایید از متد Open استفاده کنی و برعکس وقتی می خوای با استفاده از دستورات SQL تغییری روی داده ها مثل اعمالی Insert,Update,Delete انجام بدی از ExecSQL استفاده کنید!!!
آیدا رضایی
شنبه 15 بهمن 1384, 16:26 عصر
یعنی زمانی که قصد دارید اطلاعاتی را از سرویس دهنده بانک اطلاعاتی واکشی کنی به جای اینکه از ExecSQL استفاده نمایید از متد Open استفاده کنی و برعکس وقتی می خوای با استفاده از دستورات SQL تغییری روی داده ها مثل اعمالی Insert,Update,Delete انجام بدی از ExecSQL استفاده کنید!!!
خیلی ممنون از توضیحاتتون جناب mehranfx .
اما اگه میشه لطف کنید معایب استفاده از execsql و محاسن استفاده از open در اینجور موارد رو بیشتر توضیح بدید .
mehranFX
شنبه 15 بهمن 1384, 18:55 عصر
خیلی ممنون از توضیحاتتون جناب mehranfx .
اما اگه میشه لطف کنید معایب استفاده از execsql و محاسن استفاده از open در اینجور موارد رو بیشتر توضیح بدید .

و در جواب شما آیدا خانوم بورلند فرموده که :



Call ExecSQL to execute the SQL statement currently assigned to the SQL property. Use ExecSQL to execute queries that do not return a cursor to data (such as INSERT, UPDATE, DELETE, and CREATE TABLE).

Note: For SELECT statements, call Open instead of ExecSQL.
ExecSQL prepares the statement in SQL property for execution if it has not already been prepared. To speed performance, an application should ordinarily call Prepare before calling ExecSQL for the first time.
vcldeveloper
یک شنبه 16 بهمن 1384, 07:00 صبح
اما اگه میشه لطف کنید معایب استفاده از execsql و محاسن استفاده از open در اینجور موارد رو بیشتر توضیح بدید .
الان دقیقا یادم نیست ولی فکر کنم استفاده از Open باعث میشه یک Cursor برای شما ایجاد بشه.
آیدا رضایی
یک شنبه 16 بهمن 1384, 14:31 عصر
از همه دوستان که این همه با حوصله و کامل جواب منو دادند ممنونم.
مشکل برنامه کاملا رفع شده و کلا مشکل از همون استفاده های نابجا از کنترل های create نشده یا create کردن دوباره یک کنترل create شده بود .
ممنون دوستان.
از همگی ممنونم .
Developer Programmer
دوشنبه 17 بهمن 1384, 09:51 صبح
علی جان
می دونستی جوابهات و طرز فکرت کم کم داره اینپرایزی (!) میشه !؟ خیلی خوشم اومد اطلاعات کافی و مفیدی داری و خوب هم میتونی انتقال بدی... خوش باشی
vcldeveloper
سه شنبه 18 بهمن 1384, 01:47 صبح
می دونستی جوابهات و طرز فکرت کم کم داره اینپرایزی
افشین جان، شما به بنده لطف دارید، اما این قیاس، قیاس درستی نبود و بنده راهی بسیار طولانی در پیش دارم تا شاید کمی از نظر فنی به آقای اینپرایز عزیز یا سایر اساتید این سایت نزدیک بشم. انشاء الله خدا به همه شان توفیق عنایت کند.