PDA

View Full Version : یک سؤال فوری



vista
یک شنبه 18 اردیبهشت 1384, 00:55 صبح
با سلام.
لطفاً یک راه سریع برای دستیابی به کد تبدیل تاریخ میلادی به شمسی در دلفی 7 را به من معرفی کنید.
من به سایت آقای کامبیز خجسته مراجعه کردم اما کامپوننت مورد نظر را پیدا نکردم. :sorry:

Sepidar
یک شنبه 18 اردیبهشت 1384, 01:31 صبح
www.farsicomponents.com

babak_delphi
یک شنبه 18 اردیبهشت 1384, 02:02 صبح
من یه function واسه همین کار نوشتم
اگه خواستی بگو تا واست mail کنم

یک شنبه 18 اردیبهشت 1384, 02:31 صبح
www.javansoft.com

:موفق:

عشق دلفی
یک شنبه 18 اردیبهشت 1384, 10:17 صبح
سلام.

برای تبدیل:


function DateMiladi2Shamsi(D:TDateTime; YearDigit2:Boolean=True): string;
function Days2Shamsi(ShamsiDaysCount:integer): string;
var
Y,i: integer;
M,D,DivCount: Byte;
StrTempY: string;
begin
DivCount:= 1;
Y:= 0;
while ShamsiDaysCount > 366 do begin
if DivCount >= 4 then begin
ShamsiDaysCount:= ShamsiDaysCount - 366;
DivCount:= 0;
end else
ShamsiDaysCount:= ShamsiDaysCount - 365;
Inc(Y);
Inc(DivCount)
end;

M:=1;
while True do begin
if ShamsiDaysCount <= 31 then Break;
Dec(ShamsiDaysCount, 31);
Inc(M);
if ShamsiDaysCount <= 31 then Break;
Dec(ShamsiDaysCount, 31);
Inc(M);
if ShamsiDaysCount <= 31 then Break;
Dec(ShamsiDaysCount, 31);
Inc(M);
if ShamsiDaysCount <= 31 then Break;
Dec(ShamsiDaysCount, 31);
Inc(M);
if ShamsiDaysCount <= 31 then Break;
Dec(ShamsiDaysCount, 31);
Inc(M);
if ShamsiDaysCount <= 31 then Break;
Dec(ShamsiDaysCount, 31);
Inc(M);
if ShamsiDaysCount <= 30 then Break;
Dec(ShamsiDaysCount, 30);
Inc(M);
if ShamsiDaysCount <= 30 then Break;
Dec(ShamsiDaysCount, 30);
Inc(M);
if ShamsiDaysCount <= 30 then Break;
Dec(ShamsiDaysCount, 30);
Inc(M);
if ShamsiDaysCount <= 30 then Break;
Dec(ShamsiDaysCount, 30);
Inc(M);
if ShamsiDaysCount <= 30 then Break;
Dec(ShamsiDaysCount, 30);
Inc(M);
if ShamsiDaysCount <= 29 then Break;
Break;
end;
D:= ShamsiDaysCount;

if YearDigit2 then begin
StrTempY:= GetCompleteLength(IntToStr(Y), 4, '0', maLeft);
Y:= StrToInt(StrTempY[3] + StrTempY[4]);
end;

Result:= IntToStr(Y) + '/' + GetCompleteLength(IntToStr(M), 2, '0', maLeft) + '/' + GetCompleteLength(IntToStr(D), 2, '0', maLeft);
end;
var
MiladiDaysCount, ShamsiDaysCount: integer;
ShamsiDate: string;
begin
MiladiDaysCount:= DaysBetween(StrToDate('0001/01/01'), D);
ShamsiDaysCount:= MiladiDaysCount - 226518;//226899;//505139;
ShamsiDate:= Days2Shamsi(ShamsiDaysCount);

Result:= ShamsiDate;
end;




این تابع هم باید باشه تا تابع بالا کار کنه:


function GetCompleteLength(Str:String; L:Byte; DisChar:Char; Align:MyAlignSet) : String;
var
S : String[200];
i : Byte;
begin
if Length(Str) >= L then begin
Result := Str;
end;
SetLength(S, 200);
for i :=1 to 200 do S[i] := DisChar; // S por mishe az 20 ta karaktere por konande

SetLength( S, L-Length(Str) );
if Align = maRight then Str := Str+S;
if Align = maLeft then Str := S+Str;

Result := Str;
end
;



قبلشم تو unit باید اینو تعریف کنی.(چه طولانی شد خداییش :mrgreen: ):



type
MyAlignSet = (maLeft , maRight);



راستی قبل از همه این حرفها این یونیت رو هم تو uses اضافه کن.(خیلی طولانی شد خداییش. :mrgreen: :mrgreen: ):
DateUtils


برای صدا کردنش هم:


Edit1.Text:= DateMiladi2Shamsi(Now);