09-09-2010, 02:30 AM
السلام عليكم ورحمة الله وبركاته وكل عام وانتم بخير
لدي استفسار حول تعبئة جدول بمعطيات ماخوذة من تقويم صغير
قمت بتقويم صغير ب ImgArray
كما هو موضح بالمرفق استعمل ال StringGrid بدل من الimage
لدي استفسار حول تعبئة جدول بمعطيات ماخوذة من تقويم صغير
قمت بتقويم صغير ب ImgArray
كما هو موضح بالمرفق استعمل ال StringGrid بدل من الimage
كود :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ExtCtrls, ComCtrls, Buttons;
type
TForm1 = class(TForm)
MonthBtn: TButton;
Shape5: TShape;
StaticText9: TStaticText;
StaticText8: TStaticText;
StaticText7: TStaticText;
StaticText3: TStaticText;
StaticText5: TStaticText;
StaticText11: TStaticText;
StaticText4: TStaticText;
Shape1: TShape;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure MonthBtnClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
private
{ Private declarations }
ImgArray: Array[1..42] of Timage; // Array to hold the days images ...
x,y: Integer;
GD: Integer;
NrOfDays: Integer;
Pos:String;
Year,Month,day:word; // current year month and day ...
ADate:TDate;
Procedure FindToday;
Procedure DayClick(Sender: TObject);
Procedure FindFirstDayOfMonth;
Procedure CalculateDates;
Procedure CreateImages1;
public
{ Public declarations }
MonthNo:Integer;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$R Images3.Res}
//-----------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
Var
i:Integer;
Begin
DecodeDate(Date,year,month,Day);
CreateImages1;
END;
//-----------------------------------------------------------------------
Procedure TForm1.CreateImages1;
Var i: Byte;
Begin
DateSeparator:='.';
GD:=1;
x := 1;
y := 84;
for i := 1 to 42 do begin
ImgArray[i]:=TImage.Create(self);
with ImgArray[i] do begin
Name := 'Img'+IntToStr(i);
Parent := Self;
Height := 30; Width := 50;
Picture.Bitmap.LoadFromResourceName(hInstance,'DayOff');
Left := x+45;
Top := y;
OnClick := DayClick;
Tag := 0;
Hint:='';
ShowHint:=True;
End;
x := x + 41;
IF x>=280 then begin
x:=1;
y:=y+22;
End;
End;
FindToday;
End;
//-----------------------------------------------------------------------
Procedure TForm1.FindToday;
Var i:Byte;
Begin
if Pos=IntToStr(Day)+IntToStr(Month)+IntToStr(Year) then exit;
MonthBtnClick(self);
for i:=1 to 42 do
if ImgArray [i].Tag=Day then begin
DayClick(ImgArray[i]);
Break;
End;
End;
//-----------------------------------------------------------------------
procedure TForm1.MonthBtnClick(Sender: TObject);
begin
Case MonthNo of
0,2,4,6,7,9,11: NrOfDays:=31;
3,5,8,10: NrOfDays:=30;
1: begin
if (IsLeapYear(2010)) then NrOfDays:=29
else NrOfDays:=28;
end;
end;
CalculateDates;
End;
//-----------------------------------------------------------------------
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
FindToday;
end;
//-----------------------------------------------------------------------
Procedure TForm1.CalculateDates;
Var i, WeekDay: Byte;
Begin
Screen.Cursor:=crHourGlass;
Shape1.Visible:=False;
WeekDay:=1;
DateSeparator:='.';
GD:=1;
For i:=1 to 37 do begin
with ImgArray[i] do begin
Picture.Bitmap.Canvas.Brush.Style:=bsClear;
ADate:=StrToDate('1.'+'9'+'.'+'2010');
If (GD=1) then begin
If (DayOfWeek(ADate)=WeekDay) Then begin
Picture.Bitmap.Canvas.Font.Color:=clRed;
Picture.Bitmap.Canvas.Font.Size:=10;
Picture.Bitmap.Canvas.TextOut(15,1,IntToStr(GD));
Tag:=GD;
GD:=GD+1;
End else begin
Cursor:=crDefault;
Tag:=0;
WeekDay:=WeekDay+1;
Hint:='';
End;
End else if (GD<=NrOfDays) and (GD>1) then begin
Picture.Bitmap.Canvas.Font.Color:=clBlack;
Picture.Bitmap.Canvas.Font.Size:=10;
Picture.Bitmap.Canvas.TextOut(15,1,IntToStr(GD));
Tag:=GD;
GD:=GD+1;
End else begin
Tag:=0;
WeekDay:=WeekDay+1;
Hint:='';
End; // if
End; // with
End; //For
FindFirstDayOfMonth;
Screen.Cursor:=crDefault;
End;
//-----------------------------------------------------------------------
Procedure TForm1.FindFirstDayOfMonth;
var i: word;
begin
for i:=1 to 37 do
if ImgArray[i].Tag=1 then begin
DayClick(ImgArray[i]);
Break;
End;
End;
//-----------------------------------------------------------------------
Procedure TForm1.DayClick(sender: TObject);
VAR
Day_No,Month_No : Integer;
thweel : Tdate;
aDay_Name,Day_Name,aMonth_Name,Month_Name,Dook:String;
Begin
If (TImage(sender).Tag<>0) then Begin
pos:=IntToStr(TImage(sender).Tag)+'9'+'2010';
Shape1.Left:=TImage(sender).Left-1;
Shape1.top:=TImage(sender).Top-1;
Shape1.Cursor:=TImage(sender).Cursor;
Shape1.Hint:=TImage(sender).Hint;
Shape1.BringToFront;
Shape1.Visible:=True;
End;
End;
//-----------------------------------------------------------------------
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Close;
End;
//-----------------------------------------------------------------------
END.