1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
Grid :TStringGrid;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
const
ActivityColor : array [1..3] of TColor = (clGreen, clYellow, clRed);
//Simulation base de données
type
TTimeTable = record
Name :string;
StartDay :integer; //1 à 6 (Lundi à samedi)
StartTime :integer; //0 à 23 (24 heures)
EndDay :integer; //1 à 6 (Lundi à samedi)
EndTime :integer; //0 à 23 (24 heures)
Activity :integer; //Vacances, absence, etc.
end;
const
//Ajoute plus de ligne pour le test d'un scroll vertical
TimeTable : array [0..2] of TTimeTable = (
(Name :'User 1'; StartDay :2; StartTime :0; EndDay :5; EndTime :23; Activity:1),
(Name :'User 2'; StartDay :3; StartTime :10; EndDay :3; EndTime :12; Activity:2),
(Name :'User 3'; StartDay :2; StartTime :8; EndDay :2; EndTime :19; Activity:3)
);
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
//Création dynamique du grid
Grid := TStringGrid.Create(Self);
with Grid do
begin
Parent := Self;
Align := alClient;
ColCount := 6 *24 +FixedCols; //6 jours * 24h +1 titre
RowCount := High(TimeTable) +FixedRows +1;
DefaultColWidth := 3;
DefaultRowHeight := 20;
ColWidths[0] := 60;
Options := Options -[goVertLine];
OnDrawCell := DrawCell;
OnMouseMove := MouseMove;
OnMouseUp := MouseUp;
//Entête de ligne
for i := 0 to High(TimeTable) do
Cells[0, i +FixedRows] := TimeTable[i].Name;
end;
end;
//Dessin de la cellule *********************************************************
procedure TForm1.DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Index :integer;
StartCol :integer;
EndCol :integer;
begin
if aRow > Grid.FixedRows -1 then
begin
Index := aRow -Grid.FixedRows;
if aCol > Grid.FixedCols-1 then
with TimeTable[Index] do
begin
//Colonne jour/heure de début
StartCol := (StartDay-1) *24 +StartTime;
//Colonne jour/heure de fin
EndCol := (EndDay-1) *24 +EndTime;
if aCol in [StartCol..EndCol] then
begin
Grid.Canvas.Brush.Color := ActivityColor[Activity];
Grid.Canvas.Pen.Color := Grid.Canvas.Brush.Color;
Inc(Rect.Right);
Grid.Canvas.Rectangle(Rect);
end;
end;
end;
end;
//Mise à jour du Caption (pour info) *******************************************
procedure TForm1.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
aCol :integer;
aRow :integer;
Index :integer;
begin
Grid.MouseToCell(X, Y, aCol, aRow);
Index := aRow -Grid.FixedRows;
if aRow > Grid.FixedRows -1
then Caption := Format('[%s] %d/%d', [TimeTable[Index].Name, aCol, aRow])
else Caption := 'Pas de sélection';
end;
//Sélection ********************************************************************
procedure TForm1.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
aCol :integer;
aRow :integer;
Index :integer;
begin
//Sélection Jour/heure
Grid.MouseToCell(X, Y, aCol, aRow);
Index := aRow -Grid.FixedRows;
if aRow > Grid.FixedRows -1 then
ShowMessage(format('Utilisateur : %s'#13'Jour : %d'#13'Heure : %dh', [TimeTable[Index].Name, aCol div 24 +1, aCol mod 24]));
end;
end. |
Partager