Subversion Repositories spacemission

Rev

Blame | Last modification | View Log | RSS feed

  1. unit DXPathEdit;
  2. //(c)2007 Jaro Benes
  3. //All Rights Reserved
  4.  
  5. {
  6. Complex application for users of unDelphiX as component editor:
  7.  
  8. Supported:
  9.  a) create path for default shape.
  10.  b) allow do change like move or rotate path layout.
  11.  c) create new trace by free-hand.
  12.  
  13. }
  14. interface
  15.                              
  16. {$INCLUDE DelphiXcfg.inc}
  17.  
  18. uses
  19.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  20.   Dialogs, StdCtrls, ExtCtrls, Menus, Buttons, Math, ComCtrls,        
  21.   DXClass, DXDraws, DIB;
  22.  
  23. type
  24.   {  TEdit  }
  25.   TEdit = class(StdCtrls.TEdit) {injected class}
  26.   private
  27.     function GetAsInteger: Integer;
  28.     procedure SetAsInteger(const Value: Integer);
  29.   published
  30.   public
  31.     property AsInteger: Integer read GetAsInteger write SetAsInteger;
  32.   end;
  33.   {  TShape  }
  34.   TShape = class(ExtCtrls.TShape)
  35.     procedure CMMouseEnter(var Msg: TMessage); message CM_MouseEnter;
  36.     procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave;
  37.   end;
  38.   {  TDelphiXTracesEditForm  }
  39.   TDPoint = record
  40.     X, Y: Double;
  41.     StayOn: Double;
  42.   end;
  43.   TDPointArr = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TDPoint;
  44. {$IFNDEF VER4UP}
  45.   PDPointArr = ^TDPointArr;
  46. {$ENDIF}
  47.   TDelphiXPathsEditForm = class(TForm)
  48.     ScrollBox1: TScrollBox;
  49.     Pane: TPanel;
  50.     Shape1: TShape;
  51.     Panel2: TPanel;
  52.     Panel1: TPanel;
  53.     Label1: TLabel;
  54.     LAmount: TLabel;
  55.     cbListOfTraces: TComboBox;
  56.     eAmount: TEdit;
  57.     btnNewTrace: TButton;
  58.     PopupMenu1: TPopupMenu;
  59.     Activate1: TMenuItem;
  60.     Label2: TLabel;
  61.     eShowOn: TEdit;
  62.     Panel12: TPanel;
  63.     btnSetTimming: TSpeedButton;
  64.     btnLine: TSpeedButton;
  65.     btnCircle: TSpeedButton;
  66.     btnSelectionArea: TSpeedButton;
  67.     btnSelectAll: TSpeedButton;
  68.     btnGrid: TSpeedButton;
  69.     brnSelectAsOne: TSpeedButton;
  70.     btnBringToFront: TSpeedButton;
  71.     btnMoveDown: TSpeedButton;
  72.     btnSendToBack: TSpeedButton;
  73.     btnMoveUp: TSpeedButton;
  74.     btnMoveLeft: TSpeedButton;
  75.     btnMoveRight: TSpeedButton;
  76.     Panel3: TPanel;
  77.     OKButton: TButton;
  78.     CancelButton: TButton;
  79.     btnCurve: TSpeedButton;
  80.     btnProperties: TSpeedButton;
  81.     btnRect: TSpeedButton;
  82.     Image1: TImage;
  83.     btnRefresh: TBitBtn;
  84.     Label3: TLabel;
  85.     StatusBar1: TStatusBar;
  86.     Button1: TBitBtn;
  87.     eDist: TEdit;
  88.     LDist: TLabel;
  89.     btnRotateLeft: TSpeedButton;
  90.     btnRotateRight: TSpeedButton;
  91.     procedure btnRotateLeftClick(Sender: TObject);
  92.     procedure btnRotateRightClick(Sender: TObject);
  93.     procedure btnMoveRightClick(Sender: TObject);
  94.     procedure btnMoveLeftClick(Sender: TObject);
  95.     procedure btnMoveDownClick(Sender: TObject);
  96.     procedure btnMoveUpClick(Sender: TObject);
  97.     procedure Button1Click(Sender: TObject);
  98.     procedure btnLineClick(Sender: TObject);
  99.     procedure btnGridClick(Sender: TObject);
  100.     procedure btnSelectionAreaClick(Sender: TObject);
  101.     procedure btnRefreshClick(Sender: TObject);
  102.     procedure PaneResize(Sender: TObject);
  103.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  104.       Shift: TShiftState; X, Y: Integer);
  105.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  106.       Y: Integer);
  107.     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  108.       Shift: TShiftState; X, Y: Integer);
  109.     procedure OKButtonClick(Sender: TObject);
  110.     procedure cbListOfTracesChange(Sender: TObject);
  111.     procedure rgShapeClick(Sender: TObject);
  112.     procedure btnNewTraceClick(Sender: TObject);
  113.     procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  114.     procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton;
  115.       Shift: TShiftState; X, Y: Integer);
  116.     procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  117.       Shift: TShiftState; X, Y: Integer);
  118.     procedure FormDestroy(Sender: TObject);
  119.     procedure FormCreate(Sender: TObject);
  120.     procedure btnSendToBackClick(Sender: TObject);
  121.     procedure btnBringToFrontClick(Sender: TObject);
  122.     procedure btnSetTimmingClick(Sender: TObject);
  123.   private
  124.     { Private declarations }
  125.     FCapture, FClicked: Boolean;
  126.     MouseDownSpot: TPoint;
  127.     LastShape: TShape;
  128.     FTracesList: TTraces;
  129.     tmpRect: TRect;
  130. {$IFNDEF VER4UP}
  131.     tmpPointArrSize: Integer;
  132. {$ENDIF}
  133.     tmpPointArr: {$IFNDEF VER4UP}PDPointArr{$ELSE}TDPointArr{$ENDIF};
  134.     X0, Y0, LX, LY: Integer;
  135.     IsDownNow: Boolean;
  136.     procedure btnCreateNewTrace(Sender: TObject);
  137.     procedure DoMakePoints;
  138.     procedure CreatePathFromActiveTrace(index: Integer);
  139.     function GetSizesOfTrace(out x, y, oWidth, oHeight: Integer): Boolean;
  140.     procedure RotatePathForAngle(Angle: Integer);
  141.    
  142.   public
  143.     { Public declarations }
  144.     property PrivateTraces: TTraces read FTracesList write FTracesList;
  145.     procedure ShowTracesOnPane_;
  146.     procedure RewriteTracesFromPane;
  147.     procedure ShowTracesOnPane;
  148.     procedure RefreshShowTracesOnPaneOnly;
  149.   end;
  150.  
  151. var
  152.   DelphiXPathsEditForm: TDelphiXPathsEditForm;
  153.  
  154. implementation
  155.  
  156. {$R *.dfm}
  157.  
  158. { TEdit }
  159.  
  160. procedure TEdit.SetAsInteger(const Value: Integer);
  161. begin
  162.   Self.Text := IntToStr(Value)
  163. end;
  164.  
  165. function TEdit.GetAsInteger: Integer;
  166. begin
  167.   try
  168.     Result := StrToInt(Self.Text);
  169.   except
  170.     Result := 0;
  171.   end;
  172. end;
  173.  
  174. { TShape }
  175.  
  176. procedure TShape.CMMouseLeave(var Msg: TMessage);
  177. begin
  178.   Shape := stRectangle;
  179. end;
  180.  
  181. procedure TShape.CMMouseEnter(var Msg: TMessage);
  182. begin
  183.   Shape := stCircle;
  184. end;
  185.  
  186. {  TDelphiXTracesEditForm  }
  187.  
  188. procedure TDelphiXPathsEditForm.FormCreate(Sender: TObject);
  189. begin
  190.   FTracesList := TTraces.Create(Self);
  191. {$IFNDEF VER4UP}
  192.   tmpPointArrSize := 0;
  193.   tmpPointArr := nil;
  194. {$ENDIF}
  195.   Image1.Picture.Bitmap.Width := Pane.Width;
  196.   Image1.Picture.Bitmap.Height := Pane.Height;
  197.   btnGrid.Click;
  198. end;
  199.  
  200. procedure TDelphiXPathsEditForm.FormDestroy(Sender: TObject);
  201. begin
  202. {$IFNDEF VER4UP}
  203.   if tmpPointArrSize > 0 then
  204.     System.ReallocMem(tmpPointArr, 0);
  205. {$ENDIF}
  206.   FTracesList.Free;
  207.   FTracesList := nil;
  208. end;
  209.  
  210. procedure SetActiveColor(Active: Boolean; S: TShape);
  211. begin
  212.   if Active then S.Pen.Color := clRed
  213.   else S.Pen.Color := $008080FF;
  214.   if Active then
  215.     if Active then S.Brush.Color := clYellow
  216.     else S.Brush.Color := $0095FFFF
  217.   else
  218.     if Active then S.Brush.Color := clGray
  219.     else S.Brush.Color := $00C4C4C4;
  220. end;
  221.  
  222. procedure TDelphiXPathsEditForm.ShowTracesOnPane_;
  223. var
  224.   I, J: Integer;
  225.   S: TShape;
  226.   B: Boolean;
  227. begin
  228.   Screen.Cursor := crHourGlass;
  229.   {uvolni predchozi}
  230.   for I := ComponentCount - 1 downto 0 do
  231.     if Components[I] is TShape then with Components[I] as TShape do begin
  232.         if Parent = Pane then
  233.           Free;
  234.       end;
  235.   {projdi seznam}
  236.   for I := 0 to FTracesList.Count - 1 do begin
  237.     {slozky-udelej pomocne pole}
  238.     CreatePathFromActiveTrace(I);
  239.     B := cbListOfTraces.ItemIndex = I; {aktivni radek}
  240.     {vlastni stopy}
  241. {$IFNDEF VER4UP}
  242.     for J := 0 to tmpPointArrSize - 1 do
  243. {$ELSE}
  244.     for J := Low(tmpPointArr) to High(tmpPointArr) do
  245. {$ENDIF}
  246.     begin
  247.       S := TShape.Create(Self);
  248.       //----------
  249.       S.Parent := Pane;
  250.       S.Width := 16;
  251.       S.Height := 16;
  252.       SetActiveColor(B, S);
  253.       //----------
  254.       S.Left := Round(tmpPointArr[J].X) - 8; {na stred}
  255.       S.Top := Round(tmpPointArr[J].Y) - 8; {na stred}
  256.       S.ShowHint := True;
  257.       S.Hint := FTracesList.Items[I].Name;
  258.       if Trim(S.Hint) = '' then S.Hint := Format('(unnamed[%d])', [I]);
  259.       S.ShowHint := True;
  260.       //Upravovat ale lze pouze jen tu cestu, ktera je aktivni v combobox
  261.       if cbListOfTraces.ItemIndex = I then begin
  262.         S.OnMouseDown := ShapeMouseDown;
  263.         S.OnMouseMove := ShapeMouseMove;
  264.         S.OnMouseUp := ShapeMouseUp;
  265.       end;
  266.       S.Tag := Integer(J);
  267.  
  268.     end;
  269.   end;
  270.   btnGrid.Click;
  271.   Screen.Cursor := crDefault;
  272. end;
  273.  
  274. procedure TDelphiXPathsEditForm.ShowTracesOnPane;
  275. var
  276.   I, J, index: Integer;
  277.   S: TShape;
  278.   P: TPath;
  279. begin
  280.   Screen.Cursor := crHourGlass;
  281.   {uvolni predchozi}
  282.   for I := ComponentCount - 1 downto 0 do
  283.     if Components[I] is TShape then with Components[I] as TShape do begin
  284.         if Parent = Pane then
  285.           Free;
  286.       end;
  287.   {projdi seznam}
  288.   for I := 0 to FTracesList.Count - 1 do begin
  289.     {slozky-udelej pomocne pole}
  290.     index := i;
  291.     if index = -1 then Exit;
  292.     {vlastni stopy}
  293.     with FTracesList.Items[index].Blit do
  294.       if GetPathCount > 0 then begin
  295.         for J := 0 to GetPathCount - 1 do
  296.         begin
  297.           S := TShape.Create(Self);
  298.           //----------
  299.           S.Parent := Pane;
  300.           S.Width := 16;
  301.           S.Height := 16;
  302.           SetActiveColor(cbListOfTraces.ItemIndex = I, S);
  303.           //----------
  304.           S.Left := Round(Path[J].X) - 8; {na stred}
  305.           S.Top := Round(Path[J].Y) - 8; {na stred}
  306.           S.ShowHint := True;
  307.           S.Hint := FTracesList.Items[I].Name;
  308.           if Trim(S.Hint) = '' then S.Hint := Format('(unnamed[%d])', [I]);
  309.           S.ShowHint := True;
  310.           //Upravovat ale lze pouze jen tu cestu, ktera je aktivni v combobox
  311.           if cbListOfTraces.ItemIndex = I then begin
  312.             S.OnMouseDown := ShapeMouseDown;
  313.             S.OnMouseMove := ShapeMouseMove;
  314.             S.OnMouseUp := ShapeMouseUp;
  315.           end;
  316.           S.Tag := Integer(J);
  317.           P := Path[J];
  318.           P.Tag := Integer(S);
  319.           Path[J] := P;
  320.         end;
  321.       end;
  322.   end;
  323.   btnGrid.Click;
  324.   Screen.Cursor := crDefault;
  325. end;
  326.  
  327. procedure TDelphiXPathsEditForm.RefreshShowTracesOnPaneOnly;
  328. var
  329.   I, J, index: Integer;
  330.   S: TShape;
  331. //  P: TPath;
  332. begin
  333.   Screen.Cursor := crHourGlass;
  334.   {projdi seznam}
  335.   for I := 0 to FTracesList.Count - 1 do begin
  336.     {slozky-udelej pomocne pole}
  337.     index := i;
  338.     if index = -1 then Exit;
  339.     {vlastni stopy}
  340.     with FTracesList.Items[index].Blit do
  341.       if GetPathCount > 0 then begin
  342.         for J := 0 to GetPathCount - 1 do
  343.         begin
  344.           S := TShape(Path[J].Tag);
  345.           if Assigned(S) then begin
  346.             S.Left := Round(Path[J].X) - 8;
  347.             S.Top := Round(Path[J].Y) - 8;
  348.             SetActiveColor(cbListOfTraces.ItemIndex = I, S);
  349.             //----------
  350.             //Upravovat ale lze pouze jen tu cestu, ktera je aktivni v combobox
  351.             if cbListOfTraces.ItemIndex = I then begin
  352.               S.OnMouseDown := ShapeMouseDown;
  353.               S.OnMouseMove := ShapeMouseMove;
  354.               S.OnMouseUp := ShapeMouseUp;
  355.             end
  356.             else
  357.             begin
  358.               S.OnMouseDown := nil;
  359.               S.OnMouseMove := nil;
  360.               S.OnMouseUp := nil;
  361.             end;
  362.           end;
  363.         end;
  364.       end;
  365.   end;
  366.   btnGrid.Click;
  367.   Screen.Cursor := crDefault;
  368. end;
  369.  
  370. procedure TDelphiXPathsEditForm.ShapeMouseMove(Sender: TObject;
  371.   Shift: TShiftState; X, Y: Integer);
  372. var
  373.   M: TPoint;
  374. begin
  375.   if FCapture and (ssLeft in Shift) then begin
  376.     TShape(Sender).Left := TShape(Sender).Left - (MouseDownSpot.x - x);
  377.     TShape(Sender).Top := TShape(Sender).Top - (MouseDownSpot.y - y);
  378.   end;
  379.   //pro zmenu velikosti
  380.   if FClicked and (ssRight in Shift) and Assigned(LastShape) then begin
  381.     M := Pane.ScreenToClient({$IFNDEF VER4UP}Point(X, Y){$ELSE}Mouse.CursorPos{$ENDIF});
  382.     LastShape.Width := M.X - LastShape.Left;
  383.     LastShape.Height := M.Y - LastShape.Top;
  384.   end;
  385. end;
  386.  
  387. procedure TDelphiXPathsEditForm.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
  388.   Shift: TShiftState; X, Y: Integer);
  389. begin
  390.   if FCapture then
  391.   begin
  392.     ReleaseCapture;
  393.     FCapture := False;
  394.     TShape(Sender).Left := TShape(Sender).Left - (MouseDownSpot.x - x);
  395.     TShape(Sender).Top := TShape(Sender).Top - (MouseDownSpot.y - y);
  396.   end;
  397.   LastShape := nil;
  398.   FClicked := False;
  399.   RewriteTracesFromPane;
  400.   ShowTracesOnPane;
  401.   Cursor := crDefault;
  402. end;
  403.  
  404. procedure TDelphiXPathsEditForm.ShapeMouseDown(Sender: TObject; Button: TMouseButton;
  405.   Shift: TShiftState; X, Y: Integer);
  406. var
  407.   P: TPoint;
  408. begin
  409.   FCapture := ssLeft in Shift;
  410.   MouseDownSpot.X := X;
  411.   MouseDownSpot.Y := Y;
  412.   FClicked := ssRight in Shift;
  413.   if FClicked and (Sender is TShape) then begin
  414.     P := TShape(Sender).ClientToScreen(Point(X, Y));
  415.     PopupMenu1.Popup(P.X, P.Y);
  416.     Exit;
  417.   end;
  418.   ShapeMouseMove(Sender, Shift, X, Y);
  419.   if (Sender is TShape) then
  420.     LastShape := TShape(Sender);
  421.   Cursor := {$IFNDEF VER4UP}crSIZE{$ELSE}crSizeAll{$ENDIF};
  422. end;
  423.  
  424. procedure TDelphiXPathsEditForm.RewriteTracesFromPane;
  425. var
  426.   I: Integer;
  427.   S: TShape;
  428.   //TT: TTracePoint;
  429.   T: TPath;
  430. begin
  431.   for I := ComponentCount - 1 downto 0 do
  432.     if Components[I] is TShape then begin
  433.       S := Components[I] as TShape;
  434.       if S.Parent = Pane then
  435.         if S.Hint = cbListOfTraces.Text then //active item only
  436.         begin
  437.           T := PrivateTraces.Items[cbListOfTraces.ItemIndex].Blit.Path[S.Tag];
  438.           T.X := S.Left + 8;
  439.           T.Y := S.Top + 8;
  440.           {tady lze prepsat jine atributy treba Rychlost...}
  441.           PrivateTraces.Items[cbListOfTraces.ItemIndex].Blit.Path[S.Tag] := T;
  442.         end;
  443.     end;
  444. end;
  445.  
  446. procedure TDelphiXPathsEditForm.btnBringToFrontClick(Sender: TObject);
  447. var
  448.   T: TTrace;
  449. begin
  450.   if cbListOfTraces.ItemIndex <> -1 then begin
  451.     T := FTracesList.Add;
  452.     T.Assign(FTracesList.Items[cbListOfTraces.ItemIndex]);
  453.     {$IFDEF VER5UP}
  454.     FTracesList.Delete(cbListOfTraces.ItemIndex);
  455.     {$ELSE}
  456.     FTracesList.Items[cbListOfTraces.ItemIndex].Free;
  457.     {$ENDIF}
  458.     cbListOfTraces.Items.Move(cbListOfTraces.ItemIndex, cbListOfTraces.Items.Count - 1);
  459.     cbListOfTraces.ItemIndex := cbListOfTraces.Items.Count - 1;
  460.     ShowTracesOnPane
  461.   end;
  462. end;
  463.  
  464. procedure TDelphiXPathsEditForm.btnCreateNewTrace(Sender: TObject);
  465. var
  466.   S: string;
  467.   T: TTrace;
  468. begin
  469.   if InputQuery('Name of new Trace:', 'Trace name', S) then begin
  470.     if Trim(S) = '' then begin
  471.       ShowMessage('Name for new trace mustn''t be empty.');
  472.       Exit;
  473.     end;
  474.     if cbListOfTraces.Items.IndexOf(S) <> -1 then begin
  475.       ShowMessage('Name for new trace has to be unique.');
  476.       Exit;
  477.     end;
  478.     T := FTracesList.Add;
  479.     T.Name := S;
  480.     cbListOfTraces.Items.AddObject(S, Pointer(PrivateTraces.Count - 1));
  481.     cbListOfTraces.ItemIndex := cbListOfTraces.Items.IndexOf(S);
  482.     cbListOfTracesChange(cbListOfTraces);
  483.   end;
  484. end;
  485.  
  486. procedure TDelphiXPathsEditForm.btnNewTraceClick(Sender: TObject);
  487. begin
  488.   btnCreateNewTrace(Sender);
  489. end;
  490.  
  491. procedure TDelphiXPathsEditForm.rgShapeClick(Sender: TObject);
  492. begin
  493.   btnNewTrace.Enabled := btnLine.Down or btnCircle.Down or btnCurve.Down;
  494. end;
  495.  
  496. procedure TDelphiXPathsEditForm.cbListOfTracesChange(Sender: TObject);
  497. begin
  498.   RewriteTracesFromPane;
  499.   RefreshShowTracesOnPaneOnly
  500. end;
  501.  
  502. procedure TDelphiXPathsEditForm.OKButtonClick(Sender: TObject);
  503. begin
  504.   RewriteTracesFromPane;
  505.   Tag := 1;
  506. end;
  507.  
  508. procedure TDelphiXPathsEditForm.Image1MouseDown(Sender: TObject;
  509.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  510.   {zapnou se funkce pro sber}
  511. begin
  512.   if ssleft in Shift then begin
  513.     X0 := X; LX := X;
  514.     Y0 := Y; LY := Y;
  515.     Image1.Picture.Bitmap.Canvas.Pen.Mode := pmNotXor;
  516.     Image1.Picture.Bitmap.Canvas.Pen.Color := clRed;
  517.     Image1.Picture.Bitmap.Canvas.Brush.Style := bsClear;
  518.     IsDownNow := True;
  519.     if btnCurve.Down then begin
  520. {$IFNDEF VER4UP}
  521.       tmpPointArrSize := 1;
  522.       System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  523.       tmpPointArr[tmpPointArrSize - 1].X := X;
  524.       tmpPointArr[tmpPointArrSize - 1].Y := Y;
  525. {$ELSE}
  526.       SetLength(tmpPointArr, 1);
  527.       tmpPointArr[High(tmpPointArr)].X := X;
  528.       tmpPointArr[High(tmpPointArr)].Y := Y;
  529. {$ENDIF}
  530.     end;
  531.   end;
  532. end;
  533.  
  534. procedure TDelphiXPathsEditForm.Image1MouseMove(Sender: TObject;
  535.   Shift: TShiftState; X, Y: Integer);
  536.   {zabira ze plocha}
  537. begin
  538.   if IsDownNow then with Image1.Picture.Bitmap.Canvas do begin
  539.       if btnSelectionArea.Down then begin
  540.         Rectangle(X0, Y0, LX, LY);
  541.         Rectangle(X0, Y0, X, Y);
  542.       end;
  543.       if btnLine.Down then begin
  544.         MoveTo(x0, y0);
  545.         LineTo(lx, ly);
  546.         MoveTo(x0, y0);
  547.         LineTo(x, y);
  548.       end;
  549.       if btnCircle.Down or btnRect.Down then begin
  550.         Rectangle(X0, Y0, LX, LY);
  551.         Rectangle(X0, Y0, X, Y);
  552.       end;
  553.       if btnCurve.Down then begin
  554.         if (X <> LX) or (Y <> LY) then begin
  555. {$IFNDEF VER4UP}
  556.           Inc(tmpPointArrSize);
  557.           System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  558.           tmpPointArr[tmpPointArrSize - 1].X := X;
  559.           tmpPointArr[tmpPointArrSize - 1].Y := Y;
  560. {$ELSE}
  561.           SetLength(tmpPointArr, Length(tmpPointArr) + 1);
  562.           tmpPointArr[High(tmpPointArr)].X := X;
  563.           tmpPointArr[High(tmpPointArr)].Y := Y;
  564. {$ENDIF}
  565.  
  566.           MoveTo(LX, LY);
  567.           LineTo(x, y);
  568.         end;
  569.       end;
  570.       LX := X;
  571.       LY := Y;
  572.     end;
  573.   StatusBar1.Panels[1].Text := Format('(x,y)=(%d,%d)', [X, Y]);
  574. end;
  575.  
  576. {$IFNDEF VER4UP}
  577. function Min(i1, i2: integer): integer;
  578. begin
  579.   if i1 < i2 then Result := i1 else Result := i2;
  580. end;
  581.  
  582. function Max(i1, i2: integer): integer;
  583. begin
  584.   if i1 > i2 then Result := i1 else Result := i2;
  585. end;
  586. {$ENDIF}
  587.  
  588. procedure TDelphiXPathsEditForm.Image1MouseUp(Sender: TObject;
  589.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  590. {koncovy bod}
  591. var
  592.   i, v, a, b, c: Integer;
  593.   beta, sinbeta, cosbeta, angle, step, ii, vx, vy, alpha, sinalpha, cosalpha, p, vv, a1, b1: Double;
  594. begin
  595.   if IsDownNow then with Image1.Picture.Bitmap.Canvas do begin
  596.       if btnCurve.Down then begin
  597.         DoMakePoints;
  598.         Label3.Caption := '';
  599.         Image1.OnMouseDown := nil;
  600.         Image1.OnMouseMove := nil;
  601.         Image1.OnMouseUp := nil;
  602.         btnCurve.Down := False;
  603.       end;
  604.       if btnSelectionArea.Down then begin
  605.         if ssShift in Shift then begin
  606.           Rectangle(X0, Y0, LX, LY); //smazat
  607.           Pen.Mode := pmCopy; //napevno
  608.           v := Max(Abs(X0 - x), Abs(X0 - y));
  609.           Rectangle(X0, y0, X0 + v, Y0 + v); //vykreslit
  610.         end
  611.         else begin
  612.           Pen.Mode := pmCopy; //napevno
  613.           Rectangle(x0, y0, x, y);
  614.         end;
  615.         tmpRect := Rect(x0, y0, x, y);
  616.         Label3.Caption := Format('R:((%d,%d),(%d,%d))', [x0, y0, x, y]);
  617.         Image1.OnMouseDown := nil;
  618.         Image1.OnMouseMove := nil;
  619.         Image1.OnMouseUp := nil;
  620.         btnSelectionArea.Down := False;
  621.       end;
  622.       if btnLine.Down then begin
  623.         MoveTo(x0, y0);
  624.         LineTo(x, y);
  625. {$IFNDEF VER4UP}
  626.         tmpPointArrSize := 2;
  627.         System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  628. {$ELSE}
  629.         SetLength(tmpPointArr, 2);
  630. {$ENDIF}
  631.         C := 0;
  632.         tmpPointArr[C].X := X0;
  633.         tmpPointArr[C].Y := Y0;
  634.         Inc(C);
  635.         tmpPointArr[C].X := X;
  636.         tmpPointArr[C].Y := Y;
  637.         DoMakePoints;
  638.         Label3.Caption := '';
  639.         Image1.OnMouseDown := nil;
  640.         Image1.OnMouseMove := nil;
  641.         Image1.OnMouseUp := nil;
  642.         btnLine.Down := False;
  643.       end;
  644.       if btnCircle.Down then begin
  645.         Rectangle(X0, Y0, LX, LY); //smazat
  646. {$IFNDEF VER4UP}
  647.         tmpPointArrSize := eAmount.AsInteger;
  648.         System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  649. {$ELSE}
  650.         SetLength(tmpPointArr, eAmount.AsInteger);
  651. {$ENDIF}
  652.         {neni pootocena}
  653.         angle := 0;
  654.         beta := -angle / 180 * PI;
  655.  
  656.         sinbeta := Sin(beta);
  657.         cosbeta := Cos(beta);
  658.         step := 360 / eAmount.AsInteger;
  659.         ii := 0; v := {$IFNDEF VER4UP}0{$ELSE}Low(tmpPointArr){$ENDIF};
  660.         a := Abs(LX - X0) div 2; //mayor
  661.         b := Abs(LY - Y0) div 2; //minor
  662.         vx := X0 + a; //center x
  663.         vy := Y0 + b; //center y
  664.         while ii < 360 do begin
  665.           alpha := ii / 180 * PI;
  666.           sinalpha := Sin(alpha);
  667.           cosalpha := Cos(alpha);
  668.           tmpPointArr[v].X := vx + (a * cosalpha * cosbeta - b * sinalpha * sinbeta);
  669.           tmpPointArr[v].Y := vy + (a * cosalpha * sinbeta + b * sinalpha * cosbeta);
  670.           inc(v);
  671.           ii := ii + step;
  672.         end;
  673.         DoMakePoints;
  674.         Label3.Caption := '';
  675.         Image1.OnMouseDown := nil;
  676.         Image1.OnMouseMove := nil;
  677.         Image1.OnMouseUp := nil;
  678.         btnCircle.Down := False;
  679.       end;
  680.       if btnRect.Down then begin
  681.         Rectangle(X0, Y0, LX, LY); //smazat
  682. {$IFNDEF VER4UP}
  683.         tmpPointArrSize := eAmount.AsInteger;
  684.         System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  685. {$ELSE}
  686.         SetLength(tmpPointArr, eAmount.AsInteger);
  687. {$ENDIF}
  688.         a1 := LX - X0;
  689.         b1 := LY - Y0;
  690.         //c := 2 * (LX - X0) + 2 * (LY - Y0); //delka
  691.         ii := (2 * a1 + 2 * b1) / eAmount.AsInteger; //delka useku
  692.         //first point is here
  693.         vv := 0;
  694.         tmpPointArr[0].X := X0; p := X0;
  695.         tmpPointArr[0].Y := Y0;
  696.         {rozhodit body po obdelniku}
  697.         for I := 1 to eAmount.AsInteger - 1 do begin
  698.           p := p + ii;
  699.           vv := vv + ii;
  700.           if vv < a1 then begin
  701.             tmpPointArr[I].X := p;
  702.             tmpPointArr[I].Y := Y0;
  703.           end
  704.           else
  705.             if vv < (a1 + b1) then begin
  706.               tmpPointArr[I].X := LX;
  707.               tmpPointArr[I].Y := Y0 + (vv - a1);
  708.             end
  709.             else
  710.               if vv < (2 * a1 + b1) then begin
  711.                 tmpPointArr[I].X := LX - (vv - (a1 + b1));
  712.                 tmpPointArr[I].Y := LY;
  713.               end
  714.               else
  715.                 if vv < (2 * a1 + 2 * b1) then begin
  716.                   tmpPointArr[I].X := X0;
  717.                   tmpPointArr[I].Y := LY - (vv - (2 * a1 + b1));
  718.                 end;
  719.         end;
  720.         DoMakePoints;
  721.         Label3.Caption := '';
  722.         Image1.OnMouseDown := nil;
  723.         Image1.OnMouseMove := nil;
  724.         Image1.OnMouseUp := nil;
  725.         btnRect.Down := False;
  726.       end;
  727.     end;
  728.   IsDownNow := False;
  729. end;
  730.  
  731. procedure TDelphiXPathsEditForm.PaneResize(Sender: TObject);
  732. begin
  733.   Image1.Picture.Bitmap.Width := Pane.Width;
  734.   Image1.Picture.Bitmap.Height := Pane.Height;
  735. end;
  736.  
  737. procedure TDelphiXPathsEditForm.DoMakePoints;
  738.   function distance2d(x1, z1, x2, z2: single): single;
  739.   var
  740.     diffx, diffz: single;
  741.   begin
  742.     diffX := x1 - x2;
  743.     diffZ := z1 - z2;
  744.     result := system.Sqrt(diffX * diffX + diffZ * diffZ);
  745.   end;
  746. var
  747.   T: TTrace;
  748.   Q: TPath;
  749.   I, D, C: Integer;
  750.   DX, DY, TX, TY: Single;
  751. begin
  752.   if btnLine.Down then begin
  753.     C := 0;
  754.     if {$IFNDEF VER4UP}tmpPointArrSize{$ELSE}Length(tmpPointArr){$ENDIF} = 2 then begin
  755.       D := Round(distance2d(tmpPointArr[C].X, tmpPointArr[C].Y, tmpPointArr[C + 1].X, tmpPointArr[C + 1].Y));
  756.       if cbListOfTraces.ItemIndex <> -1 then begin
  757.         {ziskej aktivni stopu}
  758.         T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  759.         T.Blit.SetPathLen(0); //smaz
  760.         {vytvoreni slozek}
  761.         {korekce, je-li bodu vic nez delka cary}
  762.         if eAmount.AsInteger > D then
  763.           eAmount.AsInteger := D;
  764.         {nastaveni velikosti cesty}
  765.         T.Blit.SetPathLen(eAmount.AsInteger);
  766.         {rozhozeni bodu na caru}
  767.         DX := (tmpPointArr[C + 1].X - tmpPointArr[C].X) / eAmount.AsInteger;
  768.         DY := (tmpPointArr[C + 1].Y - tmpPointArr[C].Y) / eAmount.AsInteger;
  769.         TX := tmpPointArr[C].X;
  770.         TY := tmpPointArr[C].Y;
  771.         for I := 1 to eAmount.AsInteger do begin
  772.           FillChar(Q, SizeOf(Q), 0);
  773.           Q.X := Round(TX + (I - 1) * DX);
  774.           Q.Y := Round(TY + (I - 1) * DY);
  775.           Q.StayOn := eShowOn.AsInteger;
  776.           T.Blit.Path[I - 1] := Q;
  777.         end;
  778.         T.Active := True;
  779.         ShowTracesOnPane;
  780.       end;
  781.     end;
  782.   end;
  783.   if btnCircle.Down or btnRect.Down or btnCurve.Down then begin
  784.     if cbListOfTraces.ItemIndex <> -1 then begin
  785.       {ziskej aktivni stopu}
  786.       T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  787.       T.Blit.SetPathLen(0); //smaz
  788.       {vytvoreni slozek}
  789. {$IFNDEF VER4UP}
  790.       T.Blit.SetPathLen(tmpPointArrSize);
  791.       for I := 0 to tmpPointArrSize - 1 do
  792. {$ELSE}
  793.       T.Blit.SetPathLen(Length(tmpPointArr));
  794.       for I := Low(tmpPointArr) to High(tmpPointArr) do
  795. {$ENDIF}
  796.       begin
  797.         FillChar(Q, SizeOf(Q), 0);
  798.         Q.X := Round(tmpPointArr[I].X);
  799.         Q.Y := Round(tmpPointArr[I].Y);
  800.         Q.StayOn := eShowOn.AsInteger;
  801.         T.Blit.Path[I] := Q;
  802.       end;
  803.       T.Active := True;
  804.       ShowTracesOnPane;
  805.     end;
  806.   end;
  807. end;
  808.  
  809. procedure TDelphiXPathsEditForm.btnRefreshClick(Sender: TObject);
  810. begin
  811.   DoMakePoints;
  812. end;
  813.  
  814. procedure TDelphiXPathsEditForm.btnSelectionAreaClick(Sender: TObject);
  815. begin
  816.   Image1.OnMouseDown := Image1MouseDown;
  817.   Image1.OnMouseMove := Image1MouseMove;
  818.   Image1.OnMouseUp := Image1MouseUp;
  819. end;
  820.  
  821. procedure TDelphiXPathsEditForm.btnSendToBackClick(Sender: TObject);
  822. var
  823.   T: TTrace;
  824.   I: Integer;
  825. begin
  826.   if cbListOfTraces.ItemIndex <> -1 then begin
  827.     T := FTracesList.Items[cbListOfTraces.ItemIndex];   //saved
  828.     //from selected to first
  829.     for I := cbListOfTraces.ItemIndex-1 downto 0 do begin
  830.       FTracesList.Items[I] := FTracesList.Items[I + 1];
  831.     end;
  832.     FTracesList.Items[0] := T;
  833.     cbListOfTraces.Items.Move(cbListOfTraces.ItemIndex, 0);
  834.     cbListOfTraces.ItemIndex := 0; {it is first now}
  835.     ShowTracesOnPane
  836.   end;
  837. end;
  838.  
  839. procedure TDelphiXPathsEditForm.btnSetTimmingClick(Sender: TObject);
  840. var
  841.   T: TTrace;
  842.   I: Integer;
  843.   P: TPath;
  844. begin
  845.   if MessageDlg(Format('Do you want change show time to %d ms for each point ?', [eShowOn.AsInteger]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  846.   begin
  847.     {move selected path to down}
  848.     if cbListOfTraces.ItemIndex <> -1 then begin
  849.       {ziskej aktivni stopu}
  850.       T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  851.       for I := 0 to T.Blit.GetPathCount - 1 do
  852.       begin
  853.         P := T.Blit.Path[I];
  854.         P.StayOn := eShowOn.AsInteger;
  855.         T.Blit.Path[I] := P;
  856.       end;
  857.     end;
  858.     ShowTracesOnPane;
  859.   end;
  860. end;
  861.  
  862. procedure TDelphiXPathsEditForm.btnGridClick(Sender: TObject);
  863. const
  864.   ccGrid = 32;
  865.   ccShift = 16;
  866. var I: Integer;
  867. {$IFNDEF VER4UP}
  868. //  pp: Pointer;
  869. {$ELSE}
  870.   pp: array of TPoint;
  871. {$ENDIF}
  872. begin
  873.   if btnGrid.Down then
  874.     with Image1.Picture.Bitmap.Canvas do begin
  875.       Brush.Color := clBlack;
  876.       FillRect(Bounds(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Width));
  877.       Pen.Color := clDkGray;
  878.       Pen.Style := psDot;
  879.       Pen.Mode := pmCopy;
  880.       Pen.Width := 1;
  881.       for I := 0 to Image1.Picture.Bitmap.Width div ccGrid do begin
  882.         MoveTo(I * ccGrid + ccShift, 0);
  883.         LineTo(I * ccGrid + ccShift, Image1.Picture.Bitmap.Height);
  884.       end;
  885.       for I := 0 to Image1.Picture.Bitmap.Width div ccGrid do begin
  886.         MoveTo(0, I * ccGrid + ccShift);
  887.         LineTo(Image1.Picture.Bitmap.Width, I * ccGrid + ccShift);
  888.       end;
  889.       Pen.Color := clLtGray;
  890.       Pen.Style := psSolid;
  891.       Pen.Width := 1;
  892.       for I := 0 to Image1.Picture.Bitmap.Width div 32 do begin
  893.         MoveTo(I * 32, 0);
  894.         LineTo(I * 32, Image1.Picture.Bitmap.Height);
  895.       end;
  896.       for I := 0 to Image1.Picture.Bitmap.Width div 32 do begin
  897.         MoveTo(0, I * 32);
  898.         LineTo(Image1.Picture.Bitmap.Width, I * 32);
  899.       end;
  900.     end
  901.   else
  902.     with Image1.Picture.Bitmap.Canvas do begin
  903.       Brush.Color := clBlack;
  904.       FillRect(Bounds(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Width));
  905.     end;
  906.   if (tmpRect.Right > 0) and (tmpRect.Bottom > 0) then
  907.     with Image1.Picture.Bitmap.Canvas do begin
  908.       Pen.Color := clGreen;
  909.       Pen.Width := 1;
  910.       Pen.Mode := pmCopy;
  911.       Brush.Style := bsClear;
  912. {$IFDEF VER5UP}
  913.       Rectangle(tmpRect);
  914. {$ELSE}
  915.       Rectangle(tmpRect.Left, tmpRect.Top, tmpRect.Right, tmpRect.Bottom);
  916. {$ENDIF}
  917.     end;
  918.   with Image1.Picture.Bitmap.Canvas do begin
  919.     CreatePathFromActiveTrace(cbListOfTraces.ItemIndex);
  920. {$IFNDEF VER4UP}
  921.     if tmpPointArrSize <= 0 then Exit;
  922.     MoveTo(Round(tmpPointArr[0].X), Round(tmpPointArr[0].Y));
  923.     for I := 1 to tmpPointArrSize - 1 do
  924.       LineTo(Round(tmpPointArr[I].X), Round(tmpPointArr[I].Y));
  925. {$ELSE}
  926.     if Length(tmpPointArr) = 0 then Exit;
  927.     SetLength(pp, Length(tmpPointArr));
  928.     for I := Low(tmpPointArr) to High(tmpPointArr) do
  929.       pp[I] := Point(Round(tmpPointArr[I].X), Round(tmpPointArr[I].Y));
  930.     Pen.Color := clWhite;
  931.     Pen.Width := 1;
  932.     Pen.Mode := pmCopy;
  933.     Brush.Style := bsClear;
  934.     Polyline(pp);
  935. {$ENDIF}
  936.   end;
  937. end;
  938.  
  939. procedure TDelphiXPathsEditForm.btnLineClick(Sender: TObject);
  940. begin
  941.   Image1.OnMouseDown := Image1MouseDown;
  942.   Image1.OnMouseMove := Image1MouseMove;
  943.   Image1.OnMouseUp := Image1MouseUp;
  944. end;
  945.  
  946. procedure TDelphiXPathsEditForm.Button1Click(Sender: TObject);
  947. begin
  948.   tmpRect := Rect(0, 0, 0, 0);
  949.   Label3.Caption := 'R:<none>';
  950. end;
  951.  
  952. procedure TDelphiXPathsEditForm.CreatePathFromActiveTrace(index: Integer);
  953. var
  954.   J: Integer;
  955. begin
  956. {$IFNDEF VER4UP}
  957.   tmpPointArrSize := 0;
  958.   System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  959. {$ELSE}
  960.   SetLength(tmpPointArr, 0);
  961. {$ENDIF}
  962.   if index = -1 then Exit;
  963.   {vlastni stopy}
  964.   with FTracesList.Items[index].Blit do
  965.     if GetPathCount > 0 then begin
  966. {$IFNDEF VER4UP}
  967.       tmpPointArrSize := GetPathCount;
  968.       System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
  969. {$ELSE}
  970.       SetLength(tmpPointArr, GetPathCount);
  971. {$ENDIF}
  972.       for J := 0 to GetPathCount - 1 do
  973.       begin
  974.         tmpPointArr[J].X := Path[J].X;
  975.         tmpPointArr[J].Y := Path[J].Y;
  976.         tmpPointArr[J].StayOn := Path[J].StayOn;
  977.       end;
  978.     end;
  979. end;
  980.  
  981. procedure TDelphiXPathsEditForm.btnMoveUpClick(Sender: TObject);
  982. var
  983.   T: TTrace;
  984.   I: Integer;
  985.   P: TPath;
  986. begin
  987.   {move selected path to up}
  988.   if cbListOfTraces.ItemIndex <> -1 then begin
  989.     {ziskej aktivni stopu}
  990.     T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  991.     for I := 0 to T.Blit.GetPathCount - 1 do
  992.     begin
  993.       P := T.Blit.Path[I];
  994.       P.Y := P.Y - eDist.AsInteger;
  995.       T.Blit.Path[I] := P;
  996.     end;
  997.   end;
  998.   ShowTracesOnPane;
  999. end;
  1000.  
  1001. procedure TDelphiXPathsEditForm.btnMoveDownClick(Sender: TObject);
  1002. var
  1003.   T: TTrace;
  1004.   I: Integer;
  1005.   P: TPath;
  1006. begin
  1007.   {move selected path to down}
  1008.   if cbListOfTraces.ItemIndex <> -1 then begin
  1009.     {ziskej aktivni stopu}
  1010.     T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  1011.     for I := 0 to T.Blit.GetPathCount - 1 do
  1012.     begin
  1013.       P := T.Blit.Path[I];
  1014.       P.Y := P.Y + eDist.AsInteger;
  1015.       T.Blit.Path[I] := P;
  1016.     end;
  1017.   end;
  1018.   ShowTracesOnPane;
  1019. end;
  1020.  
  1021. procedure TDelphiXPathsEditForm.btnMoveLeftClick(Sender: TObject);
  1022. var
  1023.   T: TTrace;
  1024.   I: Integer;
  1025.   P: TPath;
  1026. begin
  1027.   {move selected path to left}
  1028.   if cbListOfTraces.ItemIndex <> -1 then begin
  1029.     {ziskej aktivni stopu}
  1030.     T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  1031.     for I := 0 to T.Blit.GetPathCount - 1 do
  1032.     begin
  1033.       P := T.Blit.Path[I];
  1034.       P.X := P.X - eDist.AsInteger;
  1035.       T.Blit.Path[I] := P;
  1036.     end;
  1037.   end;
  1038.   ShowTracesOnPane;
  1039. end;
  1040.  
  1041. procedure TDelphiXPathsEditForm.btnMoveRightClick(Sender: TObject);
  1042. var
  1043.   T: TTrace;
  1044.   I: Integer;
  1045.   P: TPath;
  1046. begin
  1047.   {move selected path to right}
  1048.   if cbListOfTraces.ItemIndex <> -1 then begin
  1049.     {ziskej aktivni stopu}
  1050.     T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  1051.     for I := 0 to T.Blit.GetPathCount - 1 do
  1052.     begin
  1053.       P := T.Blit.Path[I];
  1054.       P.X := P.X + eDist.AsInteger;
  1055.       T.Blit.Path[I] := P;
  1056.     end;
  1057.   end;
  1058.   ShowTracesOnPane;
  1059. end;
  1060.  
  1061. procedure Rotate(iRotAng: Single; x, y: Double; var Nx, Ny: Double);
  1062.   procedure SinCosS(const Theta: Single; var Sin, Cos: Single); register;
  1063.   // EAX contains address of Sin
  1064.   // EDX contains address of Cos
  1065.   // Theta is passed over the stack
  1066.   asm
  1067.     FLD  Theta
  1068.     FSINCOS
  1069.     FSTP DWORD PTR [EDX]    // cosine
  1070.     FSTP DWORD PTR [EAX]    // sine
  1071.   end;
  1072. const PI256 = 2 * PI / 256;
  1073. var
  1074.   SinVal, CosVal, RotAng: Single;
  1075. begin
  1076.   RotAng := iRotAng * PI256;
  1077.   SinCosS(RotAng, SinVal, CosVal);
  1078.   Nx := x * CosVal - y * SinVal;
  1079.   Ny := y * CosVal + x * SinVal;
  1080. end;
  1081.  
  1082. procedure RotateO(RotAng: Double; x, y, ox, oy: Double; var Nx, Ny: Double);
  1083. begin
  1084.   Rotate(RotAng, x - ox, y - oy, Nx, Ny);
  1085.   Nx := Nx + ox;
  1086.   Ny := Ny + oy;
  1087. end;
  1088.  
  1089. function TDelphiXPathsEditForm.GetSizesOfTrace(out x, y, oWidth, oHeight: Integer): Boolean;
  1090. var
  1091.   T: TTrace;
  1092.   I: Integer;
  1093.   P: TPath;
  1094.   maxX, minX, maxY, minY: Single;
  1095. begin
  1096.   Result := False;
  1097.   oWidth := 0;
  1098.   oHeight := 0;
  1099.   maxX := 0;
  1100.   minX := MaxInt;
  1101.   maxY := 0;
  1102.   minY := MaxInt;
  1103.   if cbListOfTraces.ItemIndex <> -1 then begin
  1104.     {ziskej aktivni stopu}
  1105.     T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  1106.     for I := 0 to T.Blit.GetPathCount - 1 do
  1107.     begin
  1108.       P := T.Blit.Path[I];
  1109.       if P.X > maxX then maxX := P.X;
  1110.       if P.Y > maxY then maxY := P.Y;
  1111.       if P.X < minX then minX := P.X;
  1112.       if P.Y < minY then minY := P.Y;
  1113.     end;
  1114.     x := Round(minX);
  1115.     y := Round(minY);
  1116.     oWidth := Abs(Round(maxX) - Round(minX));
  1117.     oHeight := Abs(Round(maxY) - Round(minY));
  1118.     Result := True;
  1119.   end;
  1120. end;
  1121.  
  1122. procedure TDelphiXPathsEditForm.RotatePathForAngle(Angle: Integer);
  1123. var
  1124.   T: TTrace;
  1125.   I, x, y, width, height: Integer;
  1126.   P: TPath;
  1127.   nX, nY, dX, dY: Double;
  1128. begin
  1129.   if GetSizesOfTrace(x, y, Width, Height) then
  1130.   begin
  1131.     dX := (x + width / 2);
  1132.     dY := (y + height / 2);
  1133.     T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
  1134.     for I := 0 to T.Blit.GetPathCount - 1 do
  1135.     begin
  1136.       P := T.Blit.Path[I];
  1137.       RotateO(Angle, P.X, P.Y, dX, dY, nX, nY);
  1138.       P.X := nX;
  1139.       P.Y := nY;
  1140.       T.Blit.Path[I] := P;
  1141.     end;
  1142.   end;
  1143. end;
  1144.  
  1145. procedure TDelphiXPathsEditForm.btnRotateLeftClick(Sender: TObject);
  1146. begin
  1147.   RotatePathForAngle(-1 * eDist.AsInteger);
  1148.   RefreshShowTracesOnPaneOnly
  1149. end;
  1150.  
  1151. procedure TDelphiXPathsEditForm.btnRotateRightClick(Sender: TObject);
  1152. begin
  1153.   RotatePathForAngle(eDist.AsInteger);
  1154.   RefreshShowTracesOnPaneOnly
  1155. end;
  1156.  
  1157. end.
  1158.