Yardımcı olursanız sevinirim. D7 kullanıyorum!
Kod: Tümünü seç
unit hicricalendar;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, dxCore, dxButton, math, DateUtils, ExtCtrls,
jpeg, ElXPThemedControl, ElDTPick, ElPanel, ElClock, RzLabel, ShellApi,
acClasses, acWin2kEffects, StrUtils;
type
TForm1 = class(TForm)
dxButton1: TdxButton;
ListBox1: TListBox;
Button1: TButton;
dxButton2: TdxButton;
dxButton3: TdxButton;
Image1: TImage;
Image2: TImage;
Image3: TImage;
ElDateTimePicker1: TElDateTimePicker;
Memo1: TMemo;
Button2: TButton;
ElClock1: TElClock;
RzLabel9: TRzLabel;
acWin2kEffects1: TacWin2kEffects;
function hesapla(gelentarih: TDate; ttcevap:String):String;
function haftaningunu(tgunu:TDate):String;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure dxButton2Click(Sender: TObject);
procedure dxButton3Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure dxButton1Click(Sender: TObject);
procedure ElDateTimePicker1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Function IntPart(FloatNum:Double):Double;
Begin
if FloatNum < -0.0000001 Then
Result:= Ceil(FloatNum -0.0000001)
Else
Result:= Floor(FloatNum +0.0000001);
End;
function TForm1.hesapla(gelentarih: TDate; ttcevap:String ): String;
var
Tarih:TDateTime;
JD, L,N, J:TDateTime;
Gun, Ay, Yil: Word;
AyStr, ekifade:String;
begin
Tarih := gelentarih;
DecodeDate(Tarih, Yil, Ay, Gun);
jd := IntPart((1461*(Yil + 4800 + IntPart((Ay-14)/ 12)))/ 4) + IntPart((367*(Ay-2-12*(IntPart((Ay-14)/ 12))))/ 12)-IntPart((3*(IntPart((Yil+4900+IntPart((Ay-14)/ 12))/ 100)))/ 4)+Gun-32075;
L := Jd - 1948440 + 10632;
N := IntPart((l-1)/10631);
L := L - 10631 * N + 354;
J := (IntPart((10985-L)/5316))*(IntPart((50*L)/17719))+(IntPart(L/5670))*(IntPart((43*L)/15238));
L := L-(IntPart((30-J)/15))*(IntPart((17719*J)/50))-(IntPart(J/16))*(IntPart((15238*J)/43))+29;
Ay := Ceil(((IntPart((24*L)/ 709))));
Gun := Ceil(L-IntPart((709*ay)/ 24));
Yil := Ceil(30* N + J -30);
Case (Ay) Of
1: AyStr:= 'Muharrem';
2: AyStr:= 'Safer';
3: AyStr:= 'Rebiü''l- Evvel';
4: AyStr:= 'Rebiü''l- Ahir';
5: AyStr:= 'Cemaziye''l- Evvel';
6: AyStr:= 'Cemaziye''l- Ahir';
7: AyStr:= 'Recep';
8: AyStr:= 'Saban';
9: AyStr:= 'Ramazan';
10: AyStr:= 'Sevval';
11: AyStr:= 'Zi''l-ka''de';
12: AyStr:= 'Zi''l-Hicce';
End;
If AyStr = 'Muharrem' Then begin
If gun = 1 Then ekifade := 'Hicri Yılbaşı'
End;
If AyStr = 'Muharrem' Then begin
If gun = 10 Then ekifade := 'Aşüre Günü'
End;
if AyStr = 'Sevval' Then //Örnek 14/11/2004 Tarihi Ramazan Bayramı
Begin
if (Gun >= 1) and (Gun <=3) then
ekifade:='Ramazan Bayramı Tatili !!!';
End
Else
if AyStr = 'Zi''l-Hicce' Then //Örnek 21/01/2005 Tarihi Kurban Bayramı
if (Gun >= 10) and (Gun <=13) then
ekifade := 'Kurban Bayramı Tatili !!!';
// kandiller
If AyStr = 'Recep' Then begin
If gun = 26 Then ekifade := 'Miraç Kandili';
If gun = 6 Then ekifade := 'Regaip Kandili'
End;
If AyStr = 'Saban' Then begin
If gun = 14 Then ekifade := 'Berat Kandili'
End;
If AyStr = 'Saban' Then begin
If gun = 29 Then ekifade := 'Bu günün gecesi ilk Sahura çıkılacak.'
End;
If ( MonthOf(ElDateTimePicker1.Date)=2 ) and (DayOf (ElDateTimePicker1.Date) = 20) Then begin
ekifade := 'I. cemrenin HAVAYA düşmesi.'
End;
If ( MonthOf(ElDateTimePicker1.Date)=2 ) and (DayOf (ElDateTimePicker1.Date) = 27) Then begin
ekifade := 'II. cemrenin SUYA düşmesi.'
End;
If ( MonthOf(ElDateTimePicker1.Date)=3 ) and (DayOf (ElDateTimePicker1.Date) = 6) Then begin
ekifade := 'III. cemrenin TOPRAĞA düşmesi.'
End;
If AyStr = 'Rebiü''l- Evvel' Then begin
If gun = 11 Then ekifade := 'Mevlid Kandili'
End;
If AyStr = 'Ramazan' Then begin
If gun = 26 Then ekifade := 'Kadir Gecesi'
End;
// kandiler bitis
if (ekifade <> '') then
begin
ekifade := ' > ' + ekifade;
Result := IntToStr(Gun) + ' - ' + AyStr+ ' - ' + IntToStr(Yil) + ekifade;
end
else
begin
Result := '';
end;
if (ttcevap = '') then
begin
result:= IntToStr(Gun) + ' - ' + AyStr+ ' - ' + IntToStr(Yil) + ' - ' + DateToStr(ElDateTimePicker1.Date) + ' - '+ haftaningunu(ElDateTimePicker1.Date) + #13#10 + ekifade ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sayi : Integer;
gecicitarih : TDate;
tarihstringi : String ;
begin
ListBox1.Clear;
gecicitarih := ElDateTimePicker1.Date;
for sayi:= 1 to 365 do
begin
ElDateTimePicker1.Date := (ElDateTimePicker1.Date)+1;
tarihstringi := hesapla(ElDateTimePicker1.Date,'yok');
if (tarihstringi = '' ) then
begin
end
else
begin
ListBox1.Items.Add(tarihstringi+' - ' + DateToStr(ElDateTimePicker1.Date) + ' - ' +haftaningunu(ElDateTimePicker1.Date));
end;
end;
ElDateTimePicker1.DateTime := gecicitarih;
end;
function TForm1.haftaningunu(tgunu: TDate): String;
var
gerid:integer;
tcevap : String;
begin
gerid := DayOfTheWeek(tgunu);
case gerid of
7: tcevap:= 'Pazar' ;
1: tcevap:= 'Pazartesi' ;
2: tcevap:= 'Salı' ;
3: tcevap:= 'Çarşamba' ;
4: tcevap:= 'Perşembe' ;
5: tcevap:= 'Cuma' ;
6: tcevap:= 'Cumartesi' ;
else
ShowMessage('yok');
end;
Result := tcevap;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ElDateTimePicker1.Date := now;
dxButton1Click(Sender);
Button1Click(Sender);
end;
procedure TForm1.dxButton2Click(Sender: TObject);
begin
ElDateTimePicker1.Date := ElDateTimePicker1.Date+1;
RzLabel9.Caption := hesapla( ElDateTimePicker1.Date, '');
Button1Click(Sender);
end;
procedure TForm1.dxButton3Click(Sender: TObject);
begin
ElDateTimePicker1.Date := ElDateTimePicker1.Date-1;
RzLabel9.Caption := hesapla( ElDateTimePicker1.Date, '');
Button1Click(Sender);
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
{if (Key=#13) Then //sol yön tuşu basıldıysa
begin
dxButton2.SetFocus;
form1.Caption := 'Yukarı';
end;
else if Key=VK_DOWN Then //sağ yön tuşu basıldıysa
begin
form1.Caption := 'aşağı';
end;
}
end;
procedure TForm1.dxButton1Click(Sender: TObject);
var
cevap:String;
begin
cevap := hesapla(ElDateTimePicker1.Date, '');
RzLabel9.Caption := cevap;
end;
procedure TForm1.ElDateTimePicker1Change(Sender: TObject);
begin
RzLabel9.Caption := hesapla( ElDateTimePicker1.Date, '');
Button1Click(Sender);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ElDateTimePicker1.Date := now;
dxButton1Click(Sender);
Button1Click(Sender);
end;
procedure TForm1.Image1Click(Sender: TObject);
var i :integer;
begin
if (Image1.Tag = 0) then
begin
Image3.Picture := Image1.Picture;
Image1.Picture := Image2.Picture;
Image1.Tag := 1;
ListBox1.Clear;
for i:=0 to Memo1.Lines.Count-1 do ListBox1.Items.Add(Memo1.Lines[i]);
end
else
begin
Image2.Picture := Image1.Picture;
Image1.Picture := Image3.Picture;
Image1.Tag := 0;
end;
// her halikarda aç
ShellExecute(Handle, 'open','www.botanikbahcesi.com',nil,nil,sw_ShowMaximized);
end;
end.