今更、「使ってみると言われても～」って、感じでしょうか(笑)
以前コテコテに描画していたものをシンプルなものに作り変えてみました。
工程表などを作るときのベースには使えるんじゃないかと思います。
実行したところです。
ZOOMもできます。
まずは、カレンダーのクラスです。わざわざ作らなくてもよさそうな気もしますけど。
unit JobClass;
interface
uses
Windows, Messages, SysUtils, Classes, DateUtils;
type
{* TDay *}
TDay = class(TObject)
private
FDay : TDateTime; // 日時
function GetDay: Integer; // 日取得
function GetMonth: Integer; // 月取得
function GetYear: Integer; // 年取得
function GetWeek: String; // 曜日取得
function GetIsToday: Boolean; // 今日かどうか
public
constructor Create(Day: TDateTime);
published
property DT : TDateTime read FDay; // 日時
property Day : Integer read GetDay; // 日
property Month : Integer read GetMonth; // 月
property Year : Integer read GetYear; // 年
property Week : String read GetWeek; // 曜日
property IsToday: Boolean read GetIsToday; // 今日かどうか
end;
{* TCalendar *}
TCalendar = class(TObject)
private
FList: TList; { リスト }
function GetBaseDate: TDateTime; // カレンダーの開始日
function GetEndDate: TDateTime; // カレンダーの終了日
function GetData(Index: Integer): TDay; // データの読み込み
procedure SetData(Index: Integer; Day: TDay); // データの書き込み
function GetCount: Integer; // データ数
protected
procedure Error; // Errorの表示
public
constructor Create; // 生成
destructor Destroy; override; // 破棄
procedure Clear; // 消去
function Add(Day: TDay): Integer; // 追加
procedure Insert(Index: Integer; Day: TDay); // 挿入
procedure Delete(Index: Integer); // 削除
procedure MakeCalendar(FromDay, UntilDay: TDateTime); // カレンダーを作成
property Items[Index: Integer]: TDay read GetData write SetData; default;
published
property BaseDate: TDateTime read GetBaseDate; // カレンダーの開始日
property EndDate: TDateTime read GetEndDate; // カレンダーの終了日
property Count: Integer read GetCount; // データ数の取得
end;
implementation
{ TDay }
constructor TDay.Create(Day: TDateTime);
begin
inherited Create;
FDay := Day;
end;
function TDay.GetDay: Integer;
begin
Result := DayOf(FDay);
end;
function TDay.GetMonth: Integer;
begin
Result := MonthOf (FDay);
end;
function TDay.GetYear: Integer;
begin
Result := YearOf(FDay);
end;
function TDay.GetWeek: String;
var
I: Integer;
begin
I := DayOfTheWeek(FDay);
case I of
1 : Result := '月';
2 : Result := '火';
3 : Result := '水';
4 : Result := '木';
5 : Result := '金';
6 : Result := '土';
7 : Result := '日';
else
Result := '';
end;
end;
function TDay.GetIsToday: Boolean;
begin
Result := (FDay = TODAY); // TODAYがNOWではダメ
end;
{ TCalendar }
constructor TCalendar.Create;
begin
inherited;
FList := TList.Create;
end;
destructor TCalendar.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
procedure TCalendar.Clear;
var
I: Integer;
begin
for I := 0 to FList.Count -1 do
TDay(FList[I]).Free;
FList.Clear;
end;
function TCalendar.Add(Day: TDay): Integer;
begin
Result := FList.Add(Day);
end;
procedure TCalendar.Insert(Index: Integer; Day: TDay);
begin
FList.Insert(Index, Day);
end;
procedure TCalendar.Delete(Index: Integer);
begin
TDay(FList[Index]).Free;
FList.Delete(Index);
end;
procedure TCalendar.Error;
begin
raise Exception.Create('インデックスがリストの範囲を超えています');
end;
function TCalendar.GetData(Index: Integer): TDay;
begin
if (Index < 0) or (Index >= FList.Count) then Error;
Result := TDay(FList[Index]);
end;
procedure TCalendar.SetData(Index: Integer; Day: TDay);
begin
if (Index < 0) or (Index >= FList.Count) then Error;
FList[Index] := Day;
end;
function TCalendar.GetCount: Integer;
begin
Result := FList.Count;
end;
function TCalendar.GetBaseDate: TDateTime;
begin
if FList.Count = 0 then
Result := -1
else
Result := TDay(FList[0]).DT;
end;
function TCalendar.GetEndDate: TDateTime;
begin
if FList.Count = 0 then
Result := -1
else
Result := TDay(FList[FList.Count-1]).DT;
end;
procedure TCalendar.MakeCalendar(FromDay, UntilDay: TDateTime);
var
DT: TDateTime;
Day: TDay;
begin
Self.Clear;
DT := FromDay;
while (DT <= UntilDay) do
begin
Day := TDay.Create(DT);
Self.Add(Day);
DT := DT + 1;
end;
end;
end.
デザイン時です。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, Grids, StdCtrls, DateUtils, JobClass;
const
BeforeDay = 14; // 本日より何日前からGridに表示するのか。
HowDays = 730; // 本日より何日後までをGridに表示するのか。
DayStart = 1; // Gridでのカレンダーの開始列
RowStart = 3; // Gridでの作業データの開始行
JobWidth = 120; // 作業名表示
type
TForm1 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
StatusBar1: TStatusBar;
UpDown1: TUpDown;
Label1: TLabel;
DateTimePicker1: TDateTimePicker;
DrawGrid1: TDrawGrid;
procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DrawGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure DrawGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DateTimePicker1Change(Sender: TObject);
procedure DrawGrid1MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure DrawGrid1MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
private
{ Private 宣言 }
BarOffset1, BarOffset2: Integer; // オフセット
JobList: TStringList; // 作業リスト
Calendar: TCalendar; // カレンダーリスト
function GetDateCell(ACol, ARow: Integer): String; // マウス位置の日付
function GetStartDateCol(ARow: Integer): Integer; // 開始日のセル列
function GetEndDateCol(ARow: Integer): Integer; // 終了日のセル列
procedure Zoom(Value: Integer);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// カンマ区切り文字列からIndexで指定された文字列を返します。
function GetItem(Index: Integer; S: String): String;
var
SL: TStringList;
begin
Result := '';
SL := TStringList.Create;
try
SL.CommaText := S;
if Index < SL.Count then
Result := SL[Index];
finally
SL.Free;
end;
end;
// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
var
StartDay: TDateTime;
begin
// JobList
JobList := TStringList.Create;
// サンプルデータの作成
JobList.Add('現地調査,2007/09/20,2007/09/30,True');
JobList.Add('基本設計,2007/09/25,2007/10/15,False');
JobList.Add('実施設計,2007/10/10,2007/11/15,False');
// DrawGrid1の設定
DrawGrid1.DefaultDrawing := False;
DrawGrid1.Options := DrawGrid1.Options -
[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect];
DrawGrid1.ColCount := HowDays; // 列数の設定
DrawGrid1.RowCount := JobList.Count + RowStart; // 行数の設定
DrawGrid1.FixedCols := DayStart; // 固定列の設定
DrawGrid1.FixedRows := 2;
// StatusBar1の設定
StatusBar1.SimplePanel := True;
// 固定行の設定
if (JobList.Count = 0) then
DrawGrid1.FixedRows := RowStart -1
else
DrawGrid1.FixedRows := RowStart;
// 表示倍率の設定
UpDown1.Min := 25;
UpDown1.Max := 150;
UpDown1.Increment := 25;
UpDown1.Position := 100;
Zoom(100);
// TCalendar - カレンダーリストの作成
Calendar := TCalendar.Create;
DateTimePicker1.DateTime := Now;
StartDay := Date-BeforeDay;
Calendar.MakeCalendar(StartDay, StartDay+HowDays);
end;
// 終了処理
procedure TForm1.FormDestroy(Sender: TObject);
begin
Calendar.Free;
JobList.Free;
end;
// 開始日のセルの列番号を返します。
function TForm1.GetStartDateCol(ARow: Integer): Integer;
var
NowRow: Integer;
StartDate: TDateTime;
begin
NowRow := ARow - RowStart;
StartDate := StrToDateTime(GetItem(1, JobList[NowRow]));
if StartDate <= Calendar.BaseDate then
Result := DayStart
else
Result := DaysBetween(StartDate, Calendar.BaseDate) + DayStart;
end;
// 終了日のセルの列番号を返します。
function TForm1.GetEndDateCol(ARow: Integer): Integer;
var
NowRow: Integer;
EndDate: TDateTime;
begin
NowRow := ARow - RowStart;
EndDate := StrToDateTime(GetItem(2, JobList[NowRow]));
if EndDate >= Calendar.EndDate then
Result := DaysBetween(Calendar.EndDate, Calendar.BaseDate) + DayStart
else
Result := DaysBetween(EndDate, Calendar.BaseDate) + DayStart;
end;
// Zoom
procedure TForm1.Zoom(Value: Integer);
begin
with DrawGrid1 do
begin
Canvas.Font.Size := Round( 8 * (Value/100)); // フォントサイズ
DefaultColWidth := Round( 16 * (Value/100)); // 列のデフォルトサイズ
DefaultRowHeight := Round( 18 * (Value/100)); // 行のデフォルトサイズ
RowHeights[0] := Round( 14 * (Value/100)); // 年月表示行の高さ
RowHeights[1] := Round( 14 * (Value/100)); // 日表示行の高さ
ColWidths[0] := Round(JobWidth * (Value/100)); // 作業名の幅
end;
BarOffset1 := Round( 3 * (Value/100)); // 工程バーと枠とのオフセット
BarOffset2 := Round( 9 * (Value/100)); // 工程バーと枠とのオフセット
DrawGrid1.Refresh;
end;
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
// 年月の描画
procedure MonthDraw;
var
S: String;
I: Integer;
Y,M: Integer;
begin
I := Calendar[ACol-DayStart].Day; // 日
Y := Calendar[ACol-DayStart].Year; // 年
M := Calendar[ACol-DayStart].Month; // 月
// 枠の描画
DrawGrid1.Canvas.Pen.Color := clSilver;
DrawGrid1.Canvas.Pen.Width := 1;
DrawGrid1.Canvas.MoveTo(Rect.Left , Rect.Bottom-1);
DrawGrid1.Canvas.LineTo(Rect.Right, Rect.Bottom-1);
// 文字の描画
DrawGrid1.Canvas.Font.Color := clWhite;
S := IntToStr(M);
// 3日分のセルに年月日を描画させます。
if (I > 3) then Exit;
case I of
1 : begin
// 西暦の上2桁を描画します。2000年を示す20を描画します。
if (Y > 2000) then
S := '20'
else
S := '19';
DrawText(DrawGrid1.Canvas.Handle, PChar(S), -1, Rect,
DT_SINGLELINE or DT_RIGHT);
// 枠の描画 - １日のみ左側に罫線を描画します。
DrawGrid1.Canvas.Pen.Color := clSilver;
DrawGrid1.Canvas.Pen.Width := 1;
DrawGrid1.Canvas.MoveTo(Rect.Left, Rect.Top);
DrawGrid1.Canvas.LineTo(Rect.Left, Rect.Bottom);
end;
2 : begin
// 西暦の下2桁＋/を描画します。
S := Copy(IntToStr(Y),3,2)+'/';
DrawText(DrawGrid1.Canvas.Handle, PChar(S), -1, Rect,
DT_SINGLELINE or DT_LEFT);
end;
3 : begin
// 月を描画します。
S := IntToStr(M);
DrawText(DrawGrid1.Canvas.Handle, PChar(S), -1, Rect,
DT_SINGLELINE or DT_LEFT);
end;
end;
end;
// 日の描画
procedure DayDraw;
var
S: String;
I: Integer;
begin
I := Calendar[ACol-DayStart].Day;
S := IntToStr(I);
DrawGrid1.Canvas.Font.Color := clBlack;
DrawText(DrawGrid1.Canvas.Handle, PChar(S), -1, Rect,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);
// １日のみ左側に罫線を描画します。
if (I = 1) then
begin
DrawGrid1.Canvas.Pen.Color := clSilver;
DrawGrid1.Canvas.Pen.Width := 1;
DrawGrid1.Canvas.MoveTo(Rect.Left, Rect.Top);
DrawGrid1.Canvas.LineTo(Rect.Left, Rect.Bottom);
end;
end;
// 曜日の描画
procedure WeekDraw;
var
I,D: Integer;
begin
D := Calendar[ACol-DayStart].Day;
I := DayOfTheWeek(Calendar[ACol-1].DT);
case I of
6 : DrawGrid1.Canvas.Font.Color := clBlue; // 土
7 : DrawGrid1.Canvas.Font.Color := clRed; // 日
else
DrawGrid1.Canvas.Font.Color := clBlack; // その他
end;
// 曜日を描画します。
DrawText(DrawGrid1.Canvas.Handle, PChar(Calendar[ACol-DayStart].Week),-1,Rect,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);
// 枠を描画します。
DrawGrid1.Canvas.Pen.Color := clSilver;
DrawGrid1.Canvas.Pen.Width := 1;
DrawGrid1.Canvas.MoveTo(Rect.Left, Rect.Bottom-1);
DrawGrid1.Canvas.LineTo(Rect.Right, Rect.Bottom-1);
// １日のみ左側に罫線を描画します。
if (D = 1) then
begin
DrawGrid1.Canvas.MoveTo(Rect.Left, Rect.Top);
DrawGrid1.Canvas.LineTo(Rect.Left, Rect.Bottom-1);
DrawGrid1.Canvas.LineTo(Rect.Right, Rect.Bottom-1);
end;
end;
var
S: String;
NowRow: Integer;
SI,EI: Integer;
ARect: TRect;
EndDate: TDateTime;
Finished: Boolean;
begin
// タイトルの描画
if (ACol = 0) and (ARow < 3) then
begin
//位置の設定
ARect := Rect;
ARect.Top := 0;
ARect.Left := ARect.Left;
ARect.Bottom := (DrawGrid1.RowHeights[0]+2) * 3{行};
ARect.Right := ARect.Right + 1;
//色の設定
DrawGrid1.Canvas.Brush.Color := clGray;// clBtnFace;
DrawGrid1.Canvas.FillRect(ARect);
DrawGrid1.Canvas.Font.Color := clWhite;
// 文字の描画
S := '作業管理';
DrawText(DrawGrid1.Canvas.Handle, PChar(S), -1, ARect,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);
Exit;
end;
// カレンダーの表示
if (ACol <> 0) and (ACol >= DayStart) and (ARow < RowStart) then
begin
//位置の設定
//色の設定
DrawGrid1.Canvas.Brush.Color := RGB(0,221,111);
DrawGrid1.Canvas.FillRect(Rect);
//描画
case ARow of
0: MonthDraw; // 月
1: DayDraw; // 日付
2: WeekDraw; // 曜日
end;
Exit;
end;
{ 作業名の描画 }
if (ACol = 0) and (ARow >= RowStart) then
begin
// セルの行番号
NowRow := ARow - RowStart;
// 背景の描画
DrawGrid1.Canvas.Brush.Color := clBtnFace;
DrawGrid1.Canvas.FillRect(Rect);
// 線の描画
DrawGrid1.Canvas.Pen.Color := clSilver;
DrawGrid1.Canvas.Pen.Width := 2;
DrawGrid1.Canvas.MoveTo(Rect.Left-1, Rect.Bottom);
DrawGrid1.Canvas.LineTo(Rect.Right,Rect.Bottom);
// 文字の描画
Rect.Left := Rect.Left + 10;
DrawGrid1.Canvas.Font.Color := clBlack;
DrawGrid1.Canvas.Font.Style := [];
S := GetItem(0,JobList[NowRow]);
DrawText(DrawGrid1.Canvas.Handle, PChar(S), Length(S), Rect,
DT_LEFT or DT_SINGLELINE or DT_VCENTER);
Exit;
end;
{ バーの描画 }
if (ACol >= DayStart) and (ARow >= RowStart) then
begin
// セルの行番号
NowRow := ARow-RowStart;
// 背景の描画
if Calendar[ACol-1].IsToday then
DrawGrid1.Canvas.Brush.Color := clAqua // 今日
else
DrawGrid1.Canvas.Brush.Color := RGB(255,244,250);
DrawGrid1.Canvas.FillRect(Rect);
// Grid枠線の描画
DrawGrid1.Canvas.Pen.Color := clSilver;
DrawGrid1.Canvas.Pen.Width := 1;
DrawGrid1.Canvas.MoveTo(Rect.Left, Rect.Top);
DrawGrid1.Canvas.LineTo(Rect.Left, Rect.Bottom-1);
DrawGrid1.Canvas.LineTo(Rect.Right, Rect.Bottom-1);
// 描画すべきデータかどうかをチェックします。
// 終了日が開始日以前のデータは処理させません。
EndDate := StrToDateTime(GetItem(2,JobList[NowRow]));
if EndDate < Calendar.BaseDate then Exit;
// 開始日のセル位置を計算します。
SI := GetStartDateCol(ARow);
// 終了日のセル位置を計算します。
EI := GetEndDateCol(ARow);
if (ACol >= SI) and (ACol <= EI) then
begin
// バー用にRectサイズを調整する。
ARect := Rect;
ARect.Top := Rect.Top + BarOffset1 -2; //-2は微調整
ARect.Bottom := Rect.Bottom - BarOffset1;
Finished := StrToBool(GetItem(3, JobList[NowRow]));
if Finished then
DrawGrid1.Canvas.Brush.Color := clSilver
else
DrawGrid1.Canvas.Brush.Color := clBlue;
DrawGrid1.Canvas.FillRect(ARect);
DrawGrid1.Canvas.Brush.Style := bsSolid;
end;
end;
end;
procedure TForm1.DrawGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
ACol, ARow: Integer;
S: String;
begin
// StatusBar1に日付を表示させます。
DrawGrid1.MouseToCell(X, Y, ACol, ARow);
S := GetDateCell(ACol, ARow);
StatusBar1.SimpleText := S;
end;
// マウス位置の日付データを取得します。
function TForm1.GetDateCell(ACol, ARow: Integer): String;
var
Y,M,D: Integer;
W: String;
begin
if (ACol >= DayStart) and (ARow >= RowStart) then
begin
Y := Calendar[ACol-DayStart].Year; // 年
M := Calendar[ACol-DayStart].Month; // 月
D := Calendar[ACol-DayStart].Day; // 日
W := Calendar[ACol-DayStart].Week; // 曜日
Result := Format(' %4d年%02d月%2d日 %S曜日',[Y,M,D,W]);
end
else
Result := '';
end;
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
Zoom(UpDown1.Position);
end;
procedure TForm1.DrawGrid1KeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
var
StartDay: TDateTime;
Value: Integer;
begin
{ ←→キーで日付を移動させます。 }
if (Shift = []) and ((Key = VK_LEFT) or (Key = VK_RIGHT)) then
begin
if (Key = VK_LEFT) then
Value := -7
else
Value := 7;
{ 表示開始日を設定します。 }
StartDay := IncDay(Calendar.BaseDate, Value);
{ カレンダーデータを作成します。 }
Calendar.MakeCalendar(StartDay, StartDay + HowDays);
{ 表示を更新します。 }
DrawGrid1.Refresh;
end;
end;
procedure TForm1.DrawGrid1MouseWheelDown(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
var
Key: Word;
begin
key := VK_RIGHT;
DrawGrid1KeyDown(Sender, key, []);
end;
procedure TForm1.DrawGrid1MouseWheelUp(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
var
Key: Word;
begin
key := VK_LEFT;
DrawGrid1KeyDown(Sender, key, []);
end;
procedure TForm1.DateTimePicker1Change(Sender: TObject);
var
StartDay: TDateTime;
begin
//カレンダー作成
StartDay := DateTimePicker1.DateTime;
Calendar.MakeCalendar(StartDay-BeforeDay, StartDay+HowDays);
DrawGrid1.Refresh;
end;
end.
