ロケールを和暦に変更するには？ (ID：46865)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

色々苦労されているようですが、こういう場合は自作した方が
結局は速かったりします。
私も昔、色々あって作ったことがあります。
かなり昔のコード(D3で作成？)ですが、一応全ソース載せてみます。
和暦表示はしていませんが（＾＾；

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, Grids;

type
  TForm1 = class(TForm)
    SeYear: TSpinEdit;
    SeMonth: TSpinEdit;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure SeMonthChange(Sender: TObject);
    procedure SeYearChange(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure pSetCalender(saYear, saMonth: AnsiString);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.RowCount := 7;
  StringGrid1.ColCount := 7;
  StringGrid1.FixedCols := 0;
  StringGrid1.FixedRows := 1;
  StringGrid1.Cells[0, 0] := '日';
  StringGrid1.Cells[1, 0] := '月';
  StringGrid1.Cells[2, 0] := '火';
  StringGrid1.Cells[3, 0] := '水';
  StringGrid1.Cells[4, 0] := '木';
  StringGrid1.Cells[5, 0] := '金';
  StringGrid1.Cells[6, 0] := '土';
  SeYear.Value := StrToInt(FormatDateTime('yyyy', Now));
  SeMonth.Value := StrToInt(FormatDateTime('m', Now));
  pSetCalender(IntToStr(SeYear.Value), IntToStr(SeMonth.Value));
end;

procedure TForm1.pSetCalender(saYear, saMonth: AnsiString);
  function f_ibGetLastDayOfMonth(Year, Month : integer) : Byte;
  const
    DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  begin
    if (IsLeapYear(Year) = True) and (Month = 2) then
      Result := 29
    else
      Result := DaysInMonth[Month];
  end;
var
  saDay: AnsiString;
	x, y: Byte;
  ibTuitatiYobi: Byte;
  ibDate: Byte;
  ibLastDayOfMonth: Byte;
begin
  ibTuitatiYobi := DayOfWeek(StrToDate(saYear + '/' + saMonth + '/1')) - 1;
  ibLastDayOfMonth := f_ibGetLastDayOfMonth(StrToInt(saYear), StrToInt(saMonth));

ibDate := 0;
  for y := 1 to 6 do begin
    for x := 0 to 6 do begin
      if (y = 6) and (x = 2) then Break;

if (y = 1) and (x < ibTuitatiYobi) then begin
        saDay := '';
      end else

if ibDate = ibLastDayOfMonth then begin
        saDay := '';
      end else

begin
        inc(ibDate);
        saDay := IntToStr(ibDate);
      end;

StringGrid1.Cells[x, y] := saDay;
    end;
  end;
end;

procedure TForm1.SeMonthChange(Sender: TObject);
begin
  pSetCalender(IntToStr(SeYear.Value), IntToStr(SeMonth.Value));
end;

procedure TForm1.SeYearChange(Sender: TObject);
begin
  pSetCalender(IntToStr(SeYear.Value), IntToStr(SeMonth.Value));
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
var
  saYear, saMonth, saDay: AnsiString;
  dt: TDateTime;
begin
  saDay := Trim(StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row]);
  if saDay <> '' then begin
    saYear := IntToStr(SeYear.Value);
    saMonth := IntToStr(SeMonth.Value);
    showmessage(saYear + '/' + saMonth + '/' + saDay);

dt := StrToDate(saYear + '/' + saMonth + '/' + saDay);
    showmessage(FormatDateTime('gge"年"m"月"d"日"', dt));
  end;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る