دوستان عزیز .
در ابتدا باید بگم این 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; // ÊÇÈÚ ÓÇÎÊ ÏÓÊæÑÇÊ ÇÓ ˜íæ Çá
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); // ÊÇÈÚ ÓÇÎÊ ÏÓÊæÑÇÊ ÇÓ ˜íæ Çá
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); // ÊÇÑíÎ Çíä Ϙãå ÏÑ ÝíáÏåÇí åãå ÓÇáå
day := strtoint(copy(Date,6,2));
Mount := strtoint(copy(Date,9,2)) ;
// ÊÚííä Ô˜á˜åÇí Ϙãå åÇí
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 // Ç�Ñ ÝÞØ í˜ ÚäæÇä ãæÌæÏ ÈæÏ
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 ; // �ÑæÓå ÓÇÎÊ Ï˜ãå åÇ
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 ; // ÑæÒåÇí ÛíÑ ÊÚØíá
// Effects
TextOptions.Style := fclsOutline ;
TextOptions.OutlineColor := clWhite ;
//==
Image.LoadFromFile('C:\button\testn.bmp');
ImageDown.LoadFromFile('C:\button\testn2.bmp');
// ÌãÚå åÇ
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 ;
//====== �ÑÝÊä ÊÇÑíÎ ÇãÑæÒ æ ãÔÎÕ ÓÇÒí ========
ButtonDate := SetTrueDate(PageCount, counter + 1) ; // ÊÇÑíÎ Çíä Ϙãå
ButtonAllYearDate := 'Year/' + copy(ButtonDate,6,5); // ÊÇÑíÎ Çíä Ϙãå ÏÑ ÝíáÏåÇí åãå ÓÇáå
//---
WhatsThisButtonImage(ButtonDate) ; // ÊÚííä Ô˜á˜åÇ
//====== �ÇíÇä ========
// �ÑÝÊä ÑæíÏÇÏ ÑæÒ
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 ; // ãÔÎÕ ÓÇÒí Ϙãå ÇãÑæÒ
IF FirstYearCreating = True Then // ÊÚííä ÑæÒ æ ãÇå ÝÚáí ÏÑ Çæáíä ÇÌÑÇ
MountPage.ActivePageIndex := PageCount ;
Image.LoadFromFile('C:\button\testntoday.bmp');
// ÓÇÎÊ ãÔÎÕÇÊ ÑæíÏÇÏ ÇãÑæÒ ÓÇá
IF DTM.DBQuery.RecordCount > 0 Then
Begin
ButtonProperyOFToday.TodayName :=(ReturnPersianDate(LeftCounter,counter+1));
ButtonProperyOFToday.TodayTitle:= DTM.DBQuery.FieldValues['eventtitle'] ;
End;
// ÓÇÎÊ ÍÇáÊ ˜æ�˜
TodayOFSamallMode := ReturnPersianDate(LeftCounter,counter+1);
//---
End ;
//====== �ÇíÇä ========
//****************************
counter:= counter + 1 ;
//Top := TopCounter * 28 ;
IF counter = NumberOfMountDays Then Break ;
// ÑæäÏ ÇÌÑÇí ÈÑäÇãå ÏÑ ÔÑæÚ ÈÑäÇãå
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
//=== ÓÇÎÊ Ï˜ãå åÇí ÝÑæÏíä
For PageCount := 11 downto 6 do
Begin
TopCounter := 1 ;
FirstLine := True ;
TheFirstLine := True ;
NumberOfMountDays := 31 ;
CreateButton ;
End ;
//===
// ÓÇÎÊ Ï˜ãå åÇí ãåÑ ÊÇ Èåãä
For PageCount := 5 downto 1 do
Begin
TopCounter := 1 ;
FirstLine := True ;
TheFirstLine := True ;
NumberOfMountDays := 30 ;
CreateButton ;
End ;
//=== ÓÇÎÊ Ï˜å åÇí ÇÓÝäÏ
TopCounter := 1 ;
FirstLine := True ;
TheFirstLine := True ;
IF IsKabiseYear = True Then
NumberOfMountDays := 30 Else
NumberOfMountDays := 29 ;
CreateButton ;
End;
مشکل واقعا عجیب با دلفی 7- Access Violation ...
پاسخ با نقل قول
نوشته شده توسط آیدا رضایی
