دخول

zaferms

السلام عليكم ورحمة الله وبركاته وكل عام وانتم بخير
لدي استفسار حول تعبئة جدول بمعطيات ماخوذة من تقويم صغير

قمت بتقويم صغير ب 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.

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة