☆TDrawGridを使ってみる。
以前コテコテに描画していたものをシンプルなものに作り変えてみました。
工程表などを作るときのベースには使えるんじゃないかと思います。
実行したところです。
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); // 枠の描画 - 1日のみ左側に罫線を描画します。 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); // 1日のみ左側に罫線を描画します。 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); // 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.
| 固定リンク