home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Delphi1_And_Delphi2 / EXAMPLES / EXTENDED / UMOVCUR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  7.0 KB  |  259 lines
  1. unit Umovcur;
  2.  
  3. interface
  4.  
  5. { TeeChart-Pro. Example of Chart Cursors. }
  6.  
  7. uses
  8.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  9.   Forms, Dialogs, TeEngine, Series, StdCtrls, ExtCtrls, TeeProcs, Chart;
  10.  
  11. type
  12.   TCursorStyle=(csHorizontal,csVertical);
  13.  
  14.   TMovableCursors = class(TForm)
  15.     Chart1: TChart;
  16.     RadioGroup1: TRadioGroup;
  17.     CheckBox1: TCheckBox;
  18.     Button1: TButton;
  19.     CheckBoxSnap: TCheckBox;
  20.     Series1: TLineSeries;
  21.     Label1: TLabel;
  22.     LabelPos: TLabel;
  23.     Button2: TButton;
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure Button1Click(Sender: TObject);
  26.     procedure RadioGroup1Click(Sender: TObject);
  27.     procedure CheckBox1Click(Sender: TObject);
  28.     procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
  29.       Y: Integer);
  30.     procedure Chart1AfterDraw(Sender: TObject);
  31.     procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
  32.       Shift: TShiftState; X, Y: Integer);
  33.     procedure Chart1MouseUp(Sender: TObject; Button: TMouseButton;
  34.       Shift: TShiftState; X, Y: Integer);
  35.     procedure CheckBoxSnapClick(Sender: TObject);
  36.     procedure Button2Click(Sender: TObject);
  37.   private
  38.     { Private declarations }
  39.   public
  40.     { Public declarations }
  41.     CursorStyle:TCursorStyle;
  42.     CursorX,CursorY:Integer;
  43.     DraggingCursor:Boolean;
  44.     CursorColor:TColor;
  45.     procedure SnapCursor;
  46.     procedure RedrawCursor;
  47.   end;
  48.  
  49. var
  50.   MovableCursors: TMovableCursors;
  51.  
  52. implementation
  53.  
  54. {$R *.DFM}
  55. Uses PenDlg;
  56.  
  57. procedure TMovableCursors.FormCreate(Sender: TObject);
  58. begin
  59.   { initialize private variables used in this demo }
  60.   DraggingCursor:=False;
  61.   CursorStyle:=csVertical;
  62.   CursorX:=Chart1.Width div 2;
  63.   CursorY:=Chart1.Height div 2;
  64.   CursorColor:=clGreen;
  65.  
  66.   { fill sample values }
  67.   Series1.FillSampleValues(20);
  68. end;
  69.  
  70. procedure TMovableCursors.SnapCursor;
  71.  
  72.  { search the Series point with the nearest Y coordinate to the cursor }
  73.   Procedure CalcNearestY;
  74.   var t,tmpPoint:Integer;
  75.       Difference, tmpDif:Double;
  76.   begin
  77.     Difference:=-1;
  78.     tmpPoint:=-1;
  79.     with Series1 do
  80.     for t:=FirstValueIndex to LastValueIndex do
  81.     begin
  82.       tmpDif:=Abs(CursorY-CalcYPos(t));
  83.       if (Difference=-1) or (tmpDif<Difference) then
  84.       begin
  85.         Difference:=tmpDif;
  86.         tmpPoint:=t;
  87.       end;
  88.     end;
  89.     if tmpPoint<>-1 then CursorY:=Series1.CalcYPos(tmpPoint);
  90.   end;
  91.  
  92.  { search the Series point with the nearest X coordinate to the cursor }
  93.   Procedure CalcNearestX;
  94.   var t,tmpPoint:Integer;
  95.       Difference, tmpDif:Double;
  96.   begin
  97.     Difference:=-1;
  98.     tmpPoint:=-1;
  99.     with Series1 do
  100.     for t:=FirstValueIndex to LastValueIndex do
  101.     begin
  102.       tmpDif:=Abs(CursorX-CalcXPos(t));
  103.       if (Difference=-1) or (tmpDif<Difference) then
  104.       begin
  105.         Difference:=tmpDif;
  106.         tmpPoint:=t;
  107.       end;
  108.     end;
  109.     if tmpPoint<>-1 then CursorX:=Series1.CalcXPos(tmpPoint);
  110.   end;
  111.  
  112. begin
  113.   { snap to nearest Y or X depending the Cursor orientation }
  114.   if CursorStyle=csHorizontal then CalcNearestY
  115.                               else CalcNearestX;
  116. end;
  117.  
  118. procedure TMovableCursors.RedrawCursor;
  119. var tmpPos:Double;
  120.     tmpColor:TColor;
  121. begin
  122.   With Chart1,Canvas do { use the Chart Canvas property to paint }
  123.   begin
  124.     Pen.Style:=psSolid;
  125.  
  126.     { set pen color }
  127.     tmpColor:=Chart1.BackColor;
  128.     if tmpColor=clTeeColor then tmpColor:=clBtnFace;
  129.     Pen.Color:=(CursorColor xor ColorToRGB(tmpColor));
  130.  
  131.     { set pen mode, useful to show /hide the cursor }
  132.     Pen.Mode:=pmXor;
  133.  
  134.     if CursorStyle=csHorizontal then
  135.     begin
  136.       { draw an horizontal line }
  137.       MoveTo( ChartRect.Left, CursorY );
  138.       LineTo( ChartRect.Right, CursorY );
  139.       tmpPos:=Series1.YScreenToValue(CursorY);
  140.     end
  141.     else
  142.     begin
  143.       { draw a vertical line }
  144.       MoveTo( CursorX, ChartRect.Top );
  145.       LineTo( CursorX, ChartRect.Bottom );
  146.       tmpPos:=Series1.XScreenToValue(CursorX);
  147.     end;
  148.  
  149.     { show in LabelPos the Cursor position in Axis scales }
  150.     LabelPos.Caption:=FormatFloat('#,###.0',tmpPos);
  151.   end;
  152. end;
  153.  
  154. procedure TMovableCursors.Button1Click(Sender: TObject);
  155. begin
  156.   Close;
  157. end;
  158.  
  159. procedure TMovableCursors.RadioGroup1Click(Sender: TObject);
  160. begin
  161.   { Change cursor orientation }
  162.  
  163.   RedrawCursor;  { hide the cursor }
  164.   if RadioGroup1.ItemIndex=0 then CursorStyle:=csHorizontal
  165.                              else CursorStyle:=csVertical;
  166.   Chart1.Repaint; { redraw again }
  167. end;
  168.  
  169. procedure TMovableCursors.CheckBox1Click(Sender: TObject);
  170. begin
  171.   { change the chart screen cursor }
  172.   if CheckBox1.Checked then Chart1.Cursor:=crCross
  173.                        else Chart1.Cursor:=crDefault;
  174.   Chart1.OriginalCursor:=Chart1.Cursor;
  175. end;
  176.  
  177. procedure TMovableCursors.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
  178.   Y: Integer);
  179. begin
  180.   { user is moving the mouse... }
  181.  
  182.   { if mouse button is pressed and dragging then... }
  183.   if DraggingCursor and PtInRect( Chart1.ChartRect,Point(X,Y) )then
  184.   begin
  185.     { hide the cursor }
  186.     RedrawCursor;
  187.     { set new cursor positions }
  188.     CursorX:=X;
  189.     CursorY:=Y;
  190.     { snap to the nearest point if snap is selected }
  191.     if CheckBoxSnap.Checked then SnapCursor;
  192.     { draw again the cursor at the new position }
  193.     RedrawCursor;
  194.   end
  195.   else
  196.   begin
  197.     { mouse button is not pressed, user is not dragging the cursor }
  198.  
  199.     { change the mouse cursor when passing over the Chart "Cursor" }
  200.     if (CursorStyle=csHorizontal) and (Abs(Y-CursorY)<3) then
  201.        Chart1.Cursor:=crVSplit
  202.     else
  203.     if (CursorStyle=csVertical) and (Abs(X-CursorX)<3) then
  204.        Chart1.Cursor:=crHSplit
  205.     else
  206.        CheckBox1Click(Self); { reset default cursor }
  207.  
  208.     Chart1.OriginalCursor:=Chart1.Cursor;
  209.   end;
  210. end;
  211.  
  212. procedure TMovableCursors.Chart1AfterDraw(Sender: TObject);
  213. begin
  214.   { When the Chart repaints (because zoom or scroll), the Cursor
  215.     should be redrawn again. }
  216.   RedrawCursor;
  217. end;
  218.  
  219. procedure TMovableCursors.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
  220.   Shift: TShiftState; X, Y: Integer);
  221. begin
  222.   { user has clicked the cursor? }
  223.   if (CursorStyle=csHorizontal) and (Abs(Y-CursorY)<3) then
  224.      DraggingCursor:=True
  225.   else
  226.   if (CursorStyle=csVertical) and (Abs(X-CursorX)<3) then
  227.      DraggingCursor:=True
  228.   else
  229.      DraggingCursor:=False;
  230.  
  231.   Chart1.CancelMouse:=DraggingCursor;
  232. end;
  233.  
  234. procedure TMovableCursors.Chart1MouseUp(Sender: TObject; Button: TMouseButton;
  235.   Shift: TShiftState; X, Y: Integer);
  236. begin
  237.   DraggingCursor:=False;  { user has released the mouse button }
  238. end;
  239.  
  240. procedure TMovableCursors.CheckBoxSnapClick(Sender: TObject);
  241. begin
  242.   { snap Cursor position to an existing point coordinates }
  243.   if CheckBoxSnap.Checked then
  244.   begin
  245.     RedrawCursor;  { hide the cursor }
  246.     SnapCursor;
  247.     RedrawCursor;  { show the cursor again }
  248.   end;
  249. end;
  250.  
  251. procedure TMovableCursors.Button2Click(Sender: TObject);
  252. begin
  253.   RedrawCursor; { hide }
  254.   CursorColor:=EditColor(Self,CursorColor);
  255.   RedrawCursor; { show }
  256. end;
  257.  
  258. end.
  259.