1 unit Unit1; 2 3 {$mode objfpc}{$H+} 4 5 interface 6 7 uses 8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Spin, 9 ExtCtrls, BGRABitmapTypes, BGRABitmap, BGRACanvas2D; 10 11 type 12 13 { TForm1 } 14 15 TForm1 = class(TForm) 16 FloatSpinEdit1: TFloatSpinEdit; 17 FloatSpinEdit2: TFloatSpinEdit; 18 Label1: TLabel; 19 Label2: TLabel; 20 Label3: TLabel; 21 Label4: TLabel; 22 Panel1: TPanel; 23 procedure FloatSpinEdit1Change(Sender: TObject); 24 procedure FloatSpinEdit2Change(Sender: TObject); 25 procedure FormCreate(Sender: TObject); 26 procedure FormDestroy(Sender: TObject); 27 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 28 Shift: TShiftState; X, Y: Integer); 29 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 30 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 31 Shift: TShiftState; X, Y: Integer); 32 procedure FormPaint(Sender: TObject); 33 private 34 Center: TPoint; 35 B, B2: TRationalQuadraticBezierCurve; 36 CurPoint: integer; 37 PrevMouse: TPoint; 38 Img : TBGRABitmap; 39 procedure UpdateLength; 40 public 41 42 end; 43 44 var 45 Form1: TForm1; 46 47 implementation 48 49 {$R *.lfm} 50 51 { TForm1 } 52 53 procedure TForm1.FormCreate(Sender: TObject); 54 begin 55 B:=BezierCurve(PointF(-150,80), PointF(0,0), PointF(150,80), FloatSpinEdit1.Value); 56 B2:=BezierCurve(PointF(-150,80), PointF(0,0), PointF(150,80), -FloatSpinEdit1.Value); 57 UpdateLength; 58 Img := TBGRABitmap.Create; 59 CurPoint := -1; 60 end; 61 62 procedure TForm1.FloatSpinEdit1Change(Sender: TObject); 63 begin 64 B.weight := FloatSpinEdit1.Value; 65 B2.weight := -FloatSpinEdit1.Value; 66 UpdateLength; 67 invalidate; 68 end; 69 70 procedure TForm1.FloatSpinEdit2Change(Sender: TObject); 71 begin 72 Invalidate; 73 end; 74 75 procedure TForm1.FormDestroy(Sender: TObject); 76 begin 77 Img.free 78 end; 79 80 procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; 81 Shift: TShiftState; X, Y: Integer); 82 var 83 MinDist: single; 84 TryPointnull85 function TryPoint(APoint: TPointF): boolean; 86 var 87 dist: single; 88 begin 89 dist:= sqr(APoint.x-x)+sqr(APoint.y-y); 90 if dist < MinDist then 91 begin 92 MinDist := dist; 93 exit(true) 94 end 95 else exit(false); 96 end; 97 98 begin 99 dec(y, Center.Y); 100 dec(x, Center.X); 101 if Button = mbLeft then 102 begin 103 CurPoint:= -1; 104 MinDist := sqr(15); 105 if TryPoint(B.p1) then CurPoint := 0; 106 if TryPoint(B.c) then CurPoint := 1; 107 if TryPoint(B.p2) then CurPoint := 2; 108 PrevMouse := Point(X,Y); 109 end; 110 end; 111 112 procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 113 Y: Integer); 114 var 115 d: TPointF; 116 begin 117 dec(y, Center.Y); 118 dec(x, Center.X); 119 if CurPoint <> -1 then 120 begin 121 d := PointF(X-PrevMouse.x,Y-PrevMouse.y); 122 case CurPoint of 123 0: begin B.p1.Offset(d); B2.p1.Offset(d); end; 124 1: begin B.c.Offset(d); B2.c.Offset(d); end; 125 2: begin B.p2.Offset(d); B2.p2.Offset(d); end; 126 end; 127 PrevMouse := Point(X,Y); 128 UpdateLength; 129 Invalidate; 130 end; 131 end; 132 133 procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 134 Shift: TShiftState; X, Y: Integer); 135 begin 136 if Button = mbLeft then CurPoint := -1; 137 end; 138 139 procedure TForm1.FormPaint(Sender: TObject); 140 var 141 f: TBGRACanvas2D; 142 R, boundsF: TrectF; 143 Aleft, Aright : TRationalQuadraticBezierCurve; 144 precision: single; 145 begin 146 precision := FloatSpinEdit2.Value; 147 Img.SetSize(ClientWidth,ClientHeight-Panel1.Height); 148 Img.Fill(clWhite); 149 f := Img.Canvas2D; 150 Center := Point(ClientWidth div 2, (ClientHeight - Panel1.Height) div 2 + Panel1.Height); 151 boundsF := RectF(0,0, Img.Width,Img.Height); 152 boundsF.Offset(-Center.X, -Center.Y + Panel1.Height); 153 f.resetTransform; 154 f.translate(Center.X,Center.Y - Panel1.Height); 155 f.lineJoinLCL:= pjsBevel; 156 // arc d'ellipse en rouge, poids 0.4 (petit arc) 157 f.beginPath; 158 f.moveto(B.p1); 159 f.lineTo(B.c); 160 f.lineTo(B.p2); 161 f.moveto(B2.p1); 162 f.lineTo(B2.c); 163 f.lineTo(B2.p2); 164 f.moveto(B.p1.x+5,B.p1.y); 165 f.circle(B.p1.x,B.p1.y,5); 166 f.moveto(B.c.x+5,B.c.y); 167 f.circle(B.c.x,B.c.y,5); 168 f.moveto(B.p2.x+5,B.p2.y); 169 f.circle(B.p2.x,B.p2.y,5); 170 f.strokeStyle(clblack); 171 f.linewidth := 1; 172 f.stroke(); 173 f.beginPath; 174 f.lineWidth := 4; 175 f.strokeStyle(BGRA(255,0,96,255)); 176 f.moveTo(B.p1); 177 f.polylineTo(B.ToPoints(boundsF,precision)); 178 f.stroke(); 179 // arc d'ellipse en vert, poids -0.4 (grand arc, complétant le précédent) 180 f.beginPath; 181 f.strokeStyle(BGRA(96,160,0,255)); 182 f.polylineTo(B2.ToPoints(boundsF,precision)); 183 f.stroke(); 184 if not B2.IsInfinite then 185 begin 186 // arc en bleu, c'est la deuxième moitié de l'arc en vert 187 B2.Split(Aleft, Aright); 188 f.strokeStyle(BGRA(0,96,255,255)); 189 f.beginPath; 190 f.moveTo(Aright.p1); 191 f.polylineTo(Aright.ToPoints(boundsF,precision*2)); 192 f.stroke; 193 194 // bounding box de l'arc en vert 195 R:=B2.GetBounds(); 196 f.beginPath; 197 f.rect(round(R.Left)-1, round(R.Top)-1, round(R.Width)+2, round(R.Height)+2); 198 f.strokeStyle(BGRABlack); 199 f.lineWidth := 1; 200 f.stroke(); 201 end; 202 Img.draw(Canvas,0,Panel1.Height) 203 end; 204 205 procedure TForm1.UpdateLength; 206 var 207 len: Single; 208 begin 209 len := B2.ComputeLength; 210 if len = EmptySingle then 211 Label1.caption:='Green arc length = infinity' 212 else 213 Label1.caption:='Green arc length = '+FloatToStrF(len, ffFixed, 7,1); 214 len := B.ComputeLength; 215 if len = EmptySingle then 216 Label2.caption:='Red arc length = infinity' 217 else 218 Label2.caption:='Red arc length = '+FloatToStrF(len, ffFixed, 7,1); 219 end; 220 221 end. 222 223