☆TDrawGridを使ってみる。

今更、「使ってみると言われても~」って、感じでしょうか(笑)
以前コテコテに描画していたものをシンプルなものに作り変えてみました。
工程表などを作るときのベースには使えるんじゃないかと思います。


実行したところです。

Dg2


ZOOMもできます。

Dg3


まずは、カレンダーのクラスです。わざわざ作らなくてもよさそうな気もしますけど。
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.


デザイン時です。

Dg1_2


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.

|