Pascalのプログラムです

質問

その月が何日まであり、その月の１日が何曜日かを入力し、画面にカレンダーを表示するプログラムを作りたいのですがよくわかりません。どなたか解答、またはヒント・サンプルを教えてください。お願いします。

回答No.1

gyrocompas · ベストアンサー

私かＤｅｌｐｈｉで使っているルーチンを抜き出してみました
閏年の判定とか、通算日付の計算とか必要となります。
月が何日まであるかを知るルーチン
Get_LastDay_by_YYMMDD
曜日を判定するルーチン
Get_DAYNUMBER_by_4YMMDD
以上です、あとは、自分で以下を解析してみて下さい
尚、Ｗｉｎ３２等の機種依存のルーチンは使っていません

uses
　SysUtils,Math;

const
　　BASE4DYEAR　= 1973;　　　　　　　 //　　　　　　　　　　　　　　　　00000850
　　NEXTCENTURY = 2100;
　　MatuBi :array [0..1] of array [1..12] of integer =
　　　　　 ( (31, 28, 31,　30,　31,　30,　31,　31,　30,　31,　30,　31),
　　　　　　 (31, 29, 31,　30,　31,　30,　31,　31,　30,　31,　30,　31) );
　　RuisBi :array [0..1] of array [0..12] of integer =
　　　 ( ( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365),
　　　　 ( 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366) );

function Leap(iYYYY: integer) :integer;　　　　// 0 :平年 1 :閏年
var
　　i, ii　:integer;
begin
　　result := 0;
　　i := iYYYY mod 4;
　　if i <> 0 then exit;
　　i　:= iYYYY mod 100;
　　if (i = 0) then
　　begin
　　　　ii := iYYYY mod 400;
　　　　if (ii = 0) then
　　　　begin
　　　　　　result := 1;
　　　　　　exit;
　　　　end else
　　　　begin
　　　　　　result := 0;
　　　　end;
　　end else
　　begin
　　　　result := 1;
　　　　exit;
　　end;
end;

function Check_4YMMDD(iY, iM, iD :integer) :boolean;
var
　　iLastDD :integer;
begin
　　result := false;
　　if ((iY < 0) or (iM <= 0) or (iD <= 0)) then exit;
　　if (iM < 1) or (iM > 12) then exit;
　　iLastDD := MatuBi [Leap (iY), iM];
　　if (iD < 1) or (iD > iLastDD) then exit;
　　result := true;
end;

function Check_4YDDD(iY, iD :integer) :boolean;
var
　　ir :integer;
begin
　　result := false;
　　if ((iY <= 0) or (iD <= 0)) then exit;
　　ir := Leap (iY);
　　if (ir = 0) then
　　begin
　　　　if (iD > 365) then exit;
　　end else
　　begin
　　　　if (iD > 366) then exit;
　　end;
　　result := true;
end;

function Get_LastDay_by_4YMMDD(i4YMMDD :integer) :integer;
var
　　iYY, iMM :integer;
　　iLastDD :integer;
begin
　　result := -1;
　　iYY := i4YMMDD div 10000;
　　iMM　:= (i4YMMDD mod 10000) div 100;
　　if ((iYY < 0) or (iMM <= 0)) then exit;
　　if ((iMM < 1) or (iMM > 12)) then exit;
　　iLastDD := MatuBi [Leap (iYY), iMM];
　　result := (i4YMMDD div 100) * 100 + iLastDD;
end;

function Get_4YDDD_by_4YMMDD(i4YMMDD :integer) :integer;
var
　　br :boolean;
　　i, iYY, iMM, iDD :integer;
begin
　　result := -1;
　　iYY　:= (i4YMMDD div 10000);
　　iMM　:= (i4YMMDD mod 10000) div 100;
　　iDD := (i4YMMDD mod 100);
　　br := Check_4YMMDD (iYY, iMM, iDD);
　　if not br then exit;
　　i := RuisBi [Leap(iYY), (iMM - 1)] + iDD;
　　result := iYY * 1000 + i;
end;

function Get_ABS73_by_4YDDD(i4YDDD :integer) :integer;
var
　　br :boolean;
　　iYYYY, iDDD, iDays :integer;
　　rYYYY :Extended;
begin
　　Get_ABS73_by_4YDDD := -1;
　　iYYYY := i4YDDD div 1000;
　　iDDD　:= i4YDDD mod 1000;
　　br := Check_4YDDD (iYYYY, iDDD);
　　if not br then exit;
　　if (iYYYY < BASE4DYEAR) or (iYYYY >= NEXTCENTURY) then exit;
　　rYYYY := (iYYYY - BASE4DYEAR) * 365.25;　　　// Ok To 2099
　　iDays := Floor(rYYYY) + iDDD;
　　Get_ABS73_by_4YDDD := iDays;
end;

function Get_DAYNUMBER_by_4YDDD(i4YDDD :integer) :integer;
var
　　iABS73, iDayNum :integer;
begin
　　Get_DAYNUMBER_by_4YDDD := -1;
　　iABS73 := Get_ABS73_by_4YDDD(i4YDDD);
　　if (iABS73 = -1) then exit;
　　iDayNum := iABS73 mod 7;
　　Get_DAYNUMBER_by_4YDDD := iDayNum;
end;

function Get_DAYNUMBER_by_4YMMDD(i4YMMDD :integer) :integer;
var
　　i4YDDD, iDayNum :integer;
begin
　　Get_DAYNUMBER_by_4YMMDD := -1;
　　i4YDDD := Get_4YDDD_by_4YMMDD(i4YMMDD);
　　if (i4YDDD = -1) then exit;
　　iDayNum := Get_DAYNUMBER_by_4YDDD(i4YDDD);
　　Get_DAYNUMBER_by_4YMMDD := iDayNum;
end;

お礼

回答ありがとうございます。参考にしてやってみます。