home *** CD-ROM | disk | FTP | other *** search
- {*********************************************}
- { TeeChart Gantt Editor example }
- { Copyright (c) 1995-1997 by David Berneda }
- { All rights reserved }
- {*********************************************}
- unit GanttEd;
-
- interface
-
- { This example shows how to allow dragging and resizing of
- Gantt bars at runtime.
- }
- uses
- Wintypes,WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- TeEngine, Series, GanttCh, ExtCtrls, TeeProcs, Chart, StdCtrls, Spin,
- Buttons, TeeComma;
-
- type
- TFormGanttEditor = class(TForm)
- Chart1: TChart;
- Series1: TGanttSeries;
- Panel1: TPanel;
- CheckBox1: TCheckBox;
- AutoStretch: TCheckBox;
- SpinEdit1: TSpinEdit;
- Label1: TLabel;
- AutoScroll: TCheckBox;
- GroupBox1: TGroupBox;
- Label2: TLabel;
- LabelStart: TLabel;
- Label5: TLabel;
- LabelEnd: TLabel;
- BitBtn1: TBitBtn;
- BitBtn2: TBitBtn;
- Button3: TButton;
- TeeCommander1: TTeeCommander;
- procedure FormCreate(Sender: TObject);
- procedure Chart1AfterDraw(Sender: TObject);
- procedure Chart1ClickBackground(Sender: TCustomChart;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure CheckBox1Click(Sender: TObject);
- procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure Chart1MouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure AutoStretchClick(Sender: TObject);
- procedure SpinEdit1Change(Sender: TObject);
- procedure BitBtn1Click(Sender: TObject);
- procedure BitBtn2Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- Selected:Integer;
- ResizeLeft,
- ResizeRight,
- Dragging:Boolean;
- StartX,
- OldStartX,
- OldEndX:Double;
- Procedure RepaintSelected;
- Procedure DrawSelection;
- end;
-
- implementation
-
- {$R *.DFM}
- Uses EditChar,EditPro;
-
- procedure TFormGanttEditor.FormCreate(Sender: TObject);
- begin
- Selected:=-1;
- Dragging:=False;
- Series1.Cursor:=crTeeHand;
-
- { random data. replace with Series1.AddGantt calls }
- Series1.FillSampleValues(10);
-
- { axis labelling }
- With Chart1.BottomAxis do
- begin
- Increment:=DateTimeStep[dtOneDay];
- ExactDateTime:=True;
- end;
- end;
-
- Procedure TFormGanttEditor.DrawSelection;
- var R,H,L,T:Integer;
- begin
- With Chart1.Canvas do { draw selected gantt bar... }
- begin
- { set pen and brush }
- Pen.Style:=psDot;
- Pen.Width:=1;
- Pen.Color:=clWhite;
- Brush.Style:=bsBDiagonal;
- Brush.Color:=clSilver;
- { calculate rectangle position }
- With Series1 do
- begin
- R:=CalcXPosValue(EndValues[Selected]);
- H:=Pointer.VertSize;
- L:=CalcXPos(Selected);
- T:=CalcYPos(Selected);
- end;
- { draw rectangle at selected gantt bar }
- {$IFDEF GL}
- RectangleWithZ(Rect(L,T-H,R,T+H),0);
- {$ELSE}
- Rectangle(L,T-H,R,T+H);
- {$ENDIF}
- end;
- end;
-
- procedure TFormGanttEditor.Chart1AfterDraw(Sender: TObject);
- begin
- if Selected<>-1 then
- begin
- DrawSelection;
- { Custom code, change label captions: }
- With Series1 do
- begin
- LabelStart.Caption:=XValueToText(StartValues[Selected]);
- LabelEnd.Caption:=XValueToText(EndValues[Selected]);
- end;
- end;
- end;
-
- Procedure TFormGanttEditor.RepaintSelected;
- begin
- Chart1.Repaint;
- end;
-
- procedure TFormGanttEditor.Chart1ClickBackground(Sender: TCustomChart;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- { deselect clicked gantt bar... }
- if Selected<>-1 then
- begin
- Selected:=-1;
- Dragging:=False;
- RepaintSelected;
- end;
- Chart1.CancelMouse:=False; { <-- allow normal scroll }
- end;
-
- procedure TFormGanttEditor.CheckBox1Click(Sender: TObject);
- begin
- Chart1.View3D:=CheckBox1.Checked;
- end;
-
- procedure TFormGanttEditor.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- if Button=mbRight then Chart1.CancelMouse:=False
- else
- begin
- { we'll drag if mouse button is left and is over a gantt bar }
- Dragging:=(Button=mbLeft) and (Selected<>-1);
- if Dragging then
- With Series1 do
- begin
- { remember values at start dragging ... }
- StartX:=XScreenToValue(X);
- OldStartX:=StartValues[Selected];
- OldEndX:=EndValues[Selected];
- Chart1.CancelMouse :=True; { <-- to disable Zoom }
- RepaintSelected;
- end;
- end;
- end;
-
- procedure TFormGanttEditor.Chart1MouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- Dragging:=False; { mouse released }
- end;
-
- procedure TFormGanttEditor.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- Var NewX,tmp:Double;
- NewSelected,
- tmpX0,tmpX1:Integer;
- begin
- if Dragging and (Selected<>-1) then { if mouse is pressed... }
- With Series1 do
- begin
- { we are dragging horizontally... }
- NewX:=StartX-XScreenToValue(X);
-
- { drag or resize left border }
- if ResizeLeft then
- if (OldStartX-NewX)<EndValues[Selected] then
- begin
- StartValues[Selected]:=OldStartX-NewX;
- if (not AutoStretch.Checked) and (AutoScroll.Checked) then
- With GetHorizAxis do
- begin
- tmp:=Minimum-StartValues[Selected];
- if tmp>0 then SetMinMax(StartValues[Selected],Maximum-tmp);
- end;
- end;
-
- { drag or resize right border }
- if ResizeRight then
- if (OldEndX-NewX)>StartValues[Selected] then
- begin
- EndValues[Selected]:=OldEndX-NewX;
- if (not AutoStretch.Checked) and (AutoScroll.Checked) then
- With GetHorizAxis do
- begin
- tmp:=EndValues[Selected]-Maximum;
- if tmp>0 then SetMinMax(Minimum+tmp,EndValues[Selected]);
- end;
- end;
-
- RepaintSelected;
- end
- else
- begin { check mouse is passing over a new gantt bar... }
- NewSelected:=Series1.Clicked(X,Y);
- if NewSelected<>Selected then
- begin
- Selected:=NewSelected;
- RepaintSelected;
- end
- else
- { check if mouse is passing over resizing left or right }
- if Selected<>-1 then
- With Series1 do
- begin
- tmpX0:=CalcXPosValue(StartValues[Selected]);
- tmpX1:=CalcXPosValue(EndValues[Selected]);
- ResizeLeft:=False;
- ResizeRight:=False;
- if (Abs(X-tmpX0)<4) then { left border }
- begin
- Cursor:=crSizeWE;
- ResizeLeft:=True;
- end
- else
- if (Abs(X-tmpX1)<4) then { right border }
- begin
- Cursor:=crSizeWE;
- ResizeRight:=True;
- end
- else
- begin { mouse is not in resizing borders }
- Cursor:=crTeeHand;
- ResizeLeft:=True;
- ResizeRight:=True;
- end;
- end;
- end;
- end;
-
- procedure TFormGanttEditor.AutoStretchClick(Sender: TObject);
- begin
- Series1.GetHorizAxis.Automatic:=AutoStretch.Checked;
- end;
-
- procedure TFormGanttEditor.SpinEdit1Change(Sender: TObject);
- begin
- Series1.Pointer.VertSize:=SpinEdit1.Value;
- end;
-
- procedure TFormGanttEditor.BitBtn1Click(Sender: TObject);
- begin
- AutoStretch.Checked:=False;
- Series1.GetHorizAxis.Scroll(5,False);
- end;
-
- procedure TFormGanttEditor.BitBtn2Click(Sender: TObject);
- begin
- AutoStretch.Checked:=False;
- Series1.GetHorizAxis.Scroll(-5,False);
- end;
-
- procedure TFormGanttEditor.Button3Click(Sender: TObject);
- begin
- Close;
- end;
-
- end.
-