PDA

View Full Version : کد را پیدا کردم(تبدیل شمسی به میلادی و میلادی به شمسی) راجع بهش سوال دارم



oghab
سه شنبه 03 آبان 1384, 21:30 عصر
نقل قول:
نوشته شده توسط (امید)
از آقای بابک یعقوبی ( برداشت شده از barnamenevis.com )

ـــــــــــــــــــــــــ ـــــــــــــــــــــــــ ـــــــــــــــــــــــــ ـــــــــــــــــــــــــ ـــــــــــــــــــــــــ ــــــــــــــــــ



کد:


unit UDate;

interface

type

t_date = record
y, m, d : word;
end;

procedure ShToM(var sh, m : t_date);
procedure MToSh(var m, sh : t_date);

implementation

uses sysUtils;

type
tt_date = record
y, m, d : longint;
end;

Const
MKMONTH = 2;
SHKMONTH = 12;

SHRYEAR = 1358;
SHRMONTH = 10;
SHRDAY = 11;

MRYEAR = 1980;
MRMONTH = 1;
MRDAY = 1;

_SHRYEAR = 1358;
_SHRMONTH = 1;
_SHRDAY = 1;

_MRYEAR = 1979;
_MRMONTH = 3;
_MRDAY = 21;

sh_month : array [1..12] of integer =
(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
sh_k_month : array [1..12] of integer =
(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30);
m_month : array [1..12] of integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
m_k_month : array [1..12] of integer =
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

MaxKYears = 63;
sh_k_years : array [1.. MaxKYears] of integer =
(1197, 1201, 1205, 1210, 1214, 1218, 1222, 1226,
1230, 1234, 1238, 1243, 1247, 1251, 1255, 1259,
1263, 1267, 1271, 1276, 1280, 1284, 1288, 1292,
1296, 1300, 1304, 1309, 1313, 1317, 1321, 1325,
1329, 1333, 1337, 1342, 1346, 1350, 1354, 1358,
1362, 1366, 1370, 1375, 1379, 1383, 1387, 1391,
1395, 1399, 1403, 1408, 1412, 1416, 1420, 1424,
1428, 1432, 1436, 1441, 1445, 1449, 1453);

function sh_is_k(y : integer) : boolean;
var
i : integer;
begin
if y < 100 then y := y + 1300;
sh_is_k := false;
for i := 1 to MaxKYears do
if sh_k_years[i] = y then begin
sh_is_k := true;
exit;
end;
end;

function m_elapsed(m : t_date) : longint;
var
mt, rt : TDateTime;
el : real;
begin
rt := EncodeDate(MRYEAR, MRMONTH, MRDAY);
mt := EncodeDate(m.y, m.m, m.d);
el := mt - rt;
m_elapsed := trunc(el);
end;

function sh_elapsed(sh : t_date) : longint;
var
el, i : longint;
sh_k : boolean;
begin
el := 0;
sh_k := sh_is_k(sh.y);

// sh_elapsed := 0;

if sh.y < 100 then sh.y := sh.y + 1300;
if sh.y < _SHRYEAR then begin
el := (longint(sh.y+1) - _SHRYEAR) * 365;
for i := _SHRYEAR downto sh.y+1 do
if sh_is_k(i) then dec(el);
for i := 12 downto sh.m+1 do
if sh_k then
el := el - sh_k_month[i]
else
el := el - sh_month[i];
if sh_k then el := el - (sh_k_month[sh.m] - sh.d)
else el := el - (sh_month[sh.m] - sh.d);
end else begin
if sh.y > _SHRYEAR then
el := el + (sh.y - _SHRYEAR) * 365;
for i := _SHRYEAR to sh.y-1 do
if sh_is_k(i) then inc(el);
for i := 1 to sh.m-1 do
if sh_k then
el := el + sh_k_month[i]
else
el := el + sh_month[i];
el := el + sh.d - _SHRDAY;
end;
sh_elapsed := el;
end;

procedure sh_add(var sht : t_date; el : longint);
var
mt, yt : longint;
sh : tt_date;
begin
if el = 0 then exit;
sh.y := sht.y;
sh.m := sht.m;
sh.d := sht.d;
if el < 0 then begin
while abs(el) >= 366 do begin
if (sh_is_k(sh.y) and (sh.m >= SHKMONTH)) or
(sh_is_k(sh.y-1) and (sh.m < SHKMONTH))
then
el := el + 366
else
el := el + 365;
dec(sh.y);
end;
yt := sh.y;
mt := sh.m - 1;
if mt < 1 then begin
mt := 12;
dec(yt);
end;
while (sh_is_k(yt) and (abs(el) > sh_k_month[mt])) or
(not sh_is_k(yt) and (abs(el) > sh_month[mt])) do
begin
if(sh_is_k(yt)) then
el := el + sh_k_month[mt]
else
el := el + sh_month[mt];
dec(sh.m);
while sh.m < 1 do begin
sh.m := sh.m + 12;
dec(sh.y);
end;
yt := sh.y;
mt := sh.m - 1;
if mt < 1 then begin
mt := 12;
dec(yt);
end;
end;
sh.d := sh.d + el;
while (sh.d <= 0) do
begin
yt := sh.y;
mt := sh.m - 1;
if mt < 1 then begin
mt := 12;
dec(yt);
end;
if(sh_is_k(yt)) then
sh.d := sh.d + sh_k_month[mt]
else
sh.d := sh.d + sh_month[mt];
dec(sh.m);
while sh.m < 1 do begin
sh.m := sh.m + 12;
dec(sh.y);
end;
end;
end else begin
while el >= 366 do begin
if (sh_is_k(sh.y) and (sh.m <= SHKMONTH)) or
(sh_is_k(sh.y+1) and (sh.m > SHKMONTH))
then
el := el - 366
else
el := el - 365;
inc(sh.y);
end;
while (sh_is_k(sh.y) and (el > sh_k_month[sh.m])) or
(not sh_is_k(sh.y) and (el > sh_month[sh.m])) do
begin
if(sh_is_k(sh.y)) then
el := el - sh_k_month[sh.m]
else
el := el - sh_month[sh.m];
inc(sh.m);
while sh.m > 12 do begin
sh.m := sh.m - 12;
inc(sh.y);
end;
end;
sh.d := sh.d + el;
while (sh_is_k(sh.y) and (sh.d > sh_k_month[sh.m])) or
(not sh_is_k(sh.y) and (sh.d > sh_month[sh.m])) do
begin
if(sh_is_k(sh.y)) then
sh.d := sh.d - sh_k_month[sh.m]
else
sh.d := sh.d - sh_month[sh.m];
inc(sh.m);
while sh.m > 12 do begin
sh.m := sh.m - 12;
inc(sh.y);
end;
end;
end;
sht.y := sh.y;
sht.m := sh.m;
sht.d := sh.d;
end;

procedure m_add(var m : t_date; el : longint);
var
mt : TDateTime;
begin
mt := EncodeDate(m.y, m.m, m.d);
mt := mt + el;
DecodeDate(mt, m.y, m.m, m.d);
end;

procedure MToSh(var m, sh : t_date);
var
el : longint;
begin
{ 1358/10/11 = 1980/1/1 }
el := m_elapsed(m);
sh.y := SHRYEAR;
sh.m := SHRMONTH;
sh.d := SHRDAY;
sh_add(sh, el);
end;

procedure ShToM(var sh, m : t_date);
var
el : longint;
begin
{ 1358/1/1 = 1979/3/21 }
el := sh_elapsed(sh);
m.y := _MRYEAR;
m.m := _MRMONTH;
m.d := _MRDAY;
m_add(m, el);
end;
end.


بابک یعقوبی



------------------------------------------------

دست شما درد نکنه واسه قرار دادن همچین کد خوبی
حالا من تو برنامه ام یه unit اضافه کردم و چون نتونستم اسمشو به udate تغییر بدم. خط اول برنامه را تغییر دادم.
حالا وقتی F9 میزنم به کاراکتر & گیر میده و خطاهای زیر را میده!
چیکار کنم؟

کد:



[Error] Unit6.pas(67): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(97): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(98): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(133): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(136): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(145): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(157): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(163): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(169): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(173): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(182): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(187): 'END' expected but 'ELSE' found
[Error] Unit6.pas(189): Illegal character in input file: '&' ($26)
[Error] Unit6.pas(230): Statement expected but 'PROCEDURE' found
[Fatal Error] Project1.dpr(10): Could not compile used unit 'D:\Program Files\Borland\Delphi7\Projects\Unit6.pas'

Touska
چهارشنبه 04 آبان 1384, 10:23 صبح
می تونی از dll که من تو سایت گذاشتم استفاده کنید و bug هم نداره و تاریخ 4/31 و 6/31 رو هم ساپورت میده.

oghab
چهارشنبه 04 آبان 1384, 14:14 عصر
سلام
فایل dll شما را پیدا کردم و کاربردشم دیدم. دستتون درد نکنه. خوب بود. واقعا باید از تمام کسانی که وقتی یه کد سخت و به درد بخور مینویسند و به این راحتی در اختیار دیگران قرار میدن تشکر کرد
یه یونیت هم اینجا پیدا کردم. که البته این لینک هک تو همین برنامه نویس پیدا کردم
http://www.salarsoft.somee.com/magaleh/m_farsi_date_help.htm
اینم خوب بود.
حالا یکی از دو مشکلم حل شد- تبدیل تاریخ میلادی به شمسی
ولی من می خواهم تاریخ شمسی را هم به میلادی تبدیل کنم. که جز کد اول که پیدا کردم و اون بالا هست بقیه این کارو نکردند و اون هم error داد.
مثلا تاریخ تولد توی یه edit وارد میشه. خب این تاریخ شمسی است و من می خواهم این تاریخ را تبدیل به میلادی کنم تا بتونم توی sql ذخیره کنم. برا همین به تابعی برای تبدیل شمسی به میلادی هم نیاز دارم.
ممنونم.

Dolphin
پنج شنبه 05 آبان 1384, 12:51 عصر
دوست من حال تبدیل تاریخ شمسی به میلادی رو پیدا کردی چیه ؟

oghab
پنج شنبه 05 آبان 1384, 14:31 عصر
سلام
من هنوز تابع تبدیل شمسی به میلادی جدیدی را پیدا نکردم. ظاهرا کدی که اول برنامه نقل قول کرد با استفاده از procedure ShToM(var sh, m : t_date);
اینکارو انجام میده ولی تو اجرای اون به error برخوردم که کسی تا به حال در این مورد راهنمایی نکرده.
تبدیل میلادی به شمسی. جز اون کد
با استفاده از dll آقایTouska و unit دیگری که تو link ذکر شده نوشتم قرار داره بخوبی جواب میده. ولی امان از این شمسی به میلادی!
http://www.salarsoft.somee.com/maga...i_date_help.htm میادی به شمسی

اگه جایی پیدا کردم تو سایت می ذارم.

JavanSoft
پنج شنبه 05 آبان 1384, 16:16 عصر
کامپوننت تقویم و سورس و مثال آنرا می توانید از سایت ModiranGroup..com بگیرید

Naficy
جمعه 06 آبان 1384, 05:23 صبح
در مورد کدی که اول بحث نوشتین،...
پسوند فایل رو به html تغییر بدین و با Internet Explorer بازش کنین. سپس از درون صفحه ی اینترنت اکسپلورر، اونو به داخل دلفی کپی کنید. مشکلتون حل می شه!! (جالبه نه؟)

disappear
جمعه 06 آبان 1384, 08:24 صبح
آقای جوان سافت ، خیلی به دردم خورد . بازهم ممنون .

oghab
جمعه 06 آبان 1384, 09:35 صبح
سلام
ممنون از همه
جناب نفیسی من کاری که شما گفتید کردم و تبدیل به html کردم و تو internet expelorer باز کردم. که کلی کد عجیب شده بود
از اونجا کپیش کردم و خواستم در unit جدید در دلفی paste کنم. که error زیر را داد و نشد ببینم.
ولی ظاهرا که راه خیلی جالبیه!
نظرتون راجع به error چیه؟ چطور حلش کنم؟

Naficy
یک شنبه 08 آبان 1384, 06:00 صبح
به کمک Notepad:
در سطر اول فایل (قبل از همه متنها) بنویسید:
<pre>
و در سطر آخر (بعد از تمام متنها) نیز بنویسید:
</pre>
سپس فایل را با فرمت html ذخیره کنید و با IE باز کنید.

oghab
یک شنبه 08 آبان 1384, 11:55 صبح
سلام
ممنونم
درست شد
خیلی جالب بود
بازم ممنون!
___________ا
لتماس دعا