نمایش نتایج 1 تا 3 از 3

نام تاپیک: یافتن تاریخهای بین دو تاریخ با دوره تناوب مشخص

  1. #1
    مهمان

    Tick یافتن تاریخهای بین دو تاریخ با دوره تناوب مشخص

    با عرض سلام و خسته نباشید :
    من یک تابع باید در برنامه ام بنویسم که سه تامتغیر داشته باشه اولی یک تاریخ (01/02/1379) start_dateو بعدی دومین تاریخ بنام end_date(01/04/1380) , سومین متغیر که حد فاصل 2تا تاریخ می باشد مثلا 15 و خروجی من باید یک آرایه ای باشد که شامل تاریخهایی است که 15 روز 15 روز باهم اختلاف دارند . :cry: لطفا در نوشتن این برنامه کمکم کنید چون تازه این قسمت کوچکی از برنامه ام می باشد از همه دوستان ممنون می باشم .
    با تشکر عسل

  2. #2
    کاربر دائمی
    تاریخ عضویت
    مرداد 1382
    محل زندگی
    تهران
    پست
    484
    یک تابع فقط یک مقدار رو می‌تونه برگردونه پس لازمه که از یک روتین (Procedure) استفاده کنیم نه تابع (Function).

    برای سادگی کار تاریخ رو به صورت نوع زیر نگه می‌داریم:

    TDate = record
    Year: Integer;
    Month: Integer;
    Day: Integer;
    end;

    و تاریخهای حاصل رو در آرایه‌ای به صورت قرار می‌دیم:

    TDateArray = array[1..MaxDateCount] of TDate;

    با دید از بالا به پایین (Top-Down) ابتدا الگوریتم به این صورت است که باید دوره زمانی را که بر حسب روز است به تاریخ شروع اضافه کنیم و تا وقتی که تاریخ حاصل کوچکتر یا مساوی تاریخ پایانی است به این عمل ادامه دهیم.

    procedure DatePriords(const StartDate, EndDate: TDate; Period: Integer;
    out Dates: TDateArray; out DateCount: Integer);
    var
    ThisDate: TDate;
    begin
    DateCount := 0;
    ThisDate := StartDate;
    AdvanceDate(ThisDay, Period);
    while CompareDate(ThisDate, EndDate) <= 0 do
    begin
    DateCount := DateCount + 1;
    Dates[DateCount] := ThisDate;
    AdvanceDate(ThisDay, Period);
    end;
    end;

    در کد بالا تابع CompareDate دو پارامتر از نوع تاریخ دریافت می‌کند و نتیجه مقایسه را بصورت زیر برمی‌گرداند:
    • اگر تاریخ اول کوچکتر از تاریخ دوم بود مقداری کوچکتر از صفر برمی‌گرداند
    • اگر دو تاریخ با هم برابر بودند مقدار صفر را برمی‌گرداند
    • اگر تاریخ اول بزرگتر از تاریخ دوم بود مقداری بزرگتر از صفر برمی‌گرداند

    function CompareDate(const Date1, Date2: TDate): Integer;
    begin
    if Date1.Year = Date2.Year then
    if Date1.Month = Date2.Month then
    CompareDate := Date1.Day - Date2.Day
    else
    CompareDate := Date1.Month - Date2.Month
    else
    CompareDate := Date1.Year - Date2.Year
    end;


    و همچنین روال AdvanceDate یک تاریخ و تعداد روز رو به صورت آرگومان گرفته و تعداد روز را به تاریخ اضافه می‌کند (در کد زیر اگر تعداد روز منفی باشد تاریخ حاصل نامعین است). روال کار به اینصورت است که تعداد روز را به روز تاریخ اضافه می‌کنیم و تا وقتی که روز حاصل از تعداد روزهای ماه بزرگتر بود تعداد روز ماه را از روز تاریخ کم کرده و به یک ماه به جلو می‌رویم. در این بین اگر ماه از 12 بیشتر شد٬ دوباره از ماه اول شروع کرده و یک سال به جلو می‌رویم.

    procedure AdvanceDate(var Date: TDate; Days: Integer);
    begin
    Date.Day := Date.Day + Days;
    while Date.Day > DaysOfMonth(Year, Month) do
    begin
    Date.Day := Date.Day - DaysOfMonth(Year, Month);
    Date.Month := Date.Month + 1;
    if Date.Month > 12 then
    begin
    Date.Month := 1;
    Date.Year := Date.Year + 1;
    end;
    end;
    end;

    تابع DaysOfMonth تعداد روزهای یک ماه را برمی‌گرداند. تعداد روزهای ماه در شش ماهه اول سال 31 و در شش ماهه دوم 30 روز است. البته اگر سال کبیسه نبود اسفندماه 29 روز خواهد داشت.

    function DaysOfMonth(Year, Month: Integer): Integer;
    begin
    if Month <= 6 then
    DaysOfMonth := 31
    else if (Month < 12) or IsLeapYear(Year) then
    DaysOfMonth := 30
    else
    DaysOfMonth := 29
    end;

    تابع IsLeapYear تعیین می‌کند که آیا سال مشخص شده توسط آرگومان تابع یک سال کبیسه است یا نه.

    function IsLeapYear(Year: Integer): Boolean;
    begin
    IsLeapYear := ((((Year + 38) * 31) mod 128) <= 30)
    end;


    لطفا" برای دفعات بعد عنوان مناسبی برای پستهای خود انتخاب کنید.

  3. #3

    Thumbs up

    متشکرم.به درد منم خورد.

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •