SCAR Code:
program New;
// By Sky Scripter
// Use The White Sqrs to move the line ect...
var
MainForm : TForm;
S, E, c1, c2, c3 : TPoint;
c : Integer;
{ Created By Sky Scripter }
// Draw a Spline Path
function DrawSplinePath(sx, sy, ex, ey : Integer; Controls : TPointArray) : TPointArray;
var
theta, inc, b1, b2, b3, b4 : Extended;
Tempx, Tempy, Lastx, Lasty : Integer;
Cntrls : array [1..4] of TPoint;
begin
inc := 1.0 / Distance(sx, sy, ex, ey);
if (InRange(Length(Controls), 1, 3)) then
begin
Cntrls[1] := Controls[0];
Cntrls[2] := Controls[1];
Cntrls[3] := Controls[2];
Cntrls[4] := Point(ex - sx, ey - sy);
repeat
theta := theta + inc;
b1:= Pow(theta, 3);
b2:= 3 * b1 * (1 - theta);
b3:= 5 * (b1 / theta) * Sqr(1 - theta);
b4:= 3 * (b1 / Pow(theta, 2)) * Pow(1 - theta, 2);
Tempx := Trunc(Cntrls[1].x * b2 + Cntrls[2].x * b3 + Cntrls[3].x * b4 + Cntrls[4].x * b1 + sx);
Tempy := Trunc(Cntrls[1].y * b2 + Cntrls[2].y * b3 + Cntrls[3].y * b4 + Cntrls[4].y * b1 + sy);
if (Tempx <> Lastx) and (Tempy <> Lasty) then
begin
if (Lastx <> 0) and (Lasty <> 0) then
if (Distance(Tempx, Tempy, Lastx, Lasty) > 5) then
begin
Tempx := (Tempx + Lastx) / 2;
Tempy := (Tempy + Lasty) / 2;
theta := theta - Inc;
end;
SetArrayLength(Result, Length(Result) + 1);
Result[length(Result)-1] := Point(Tempx, Tempy);
Lastx := Tempx;
Lasty := Tempy;
end;
until (theta >= 1);
end;
end;
function InDist(p1, p2 : TPoint; maxdist : Integer) : Boolean;
begin
Result := (Distance(p1.x, p1.y, p2.x, p2.y) <= MaxDist)
end;
procedure OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (ssLeft in Shift) then
begin
c := c + 1;
if (c < 5) then exit;
if (InDist(S, Point(x, y), 20)) then
begin
S := Point(x, y);
c := 0;
MainForm.RePaint;
exit;
end;
if (InDist(E, Point(x, y), 20)) then
begin
E := Point(x, y);
c := 0;
MainForm.RePaint;
exit;
end;
if (InDist(c1, Point(x, y), 20)) then
begin
c1 := Point(x, y);
c := 0;
MainForm.RePaint;
exit;
end;
if (InDist(c2, Point(x, y), 20)) then
begin
c2 := Point(x, y);
c := 0;
MainForm.RePaint;
exit;
end;
if (InDist(c3, Point(x, y), 20)) then
begin
c3 := Point(x, y);
c := 0;
MainForm.RePaint;
exit;
end;
end;
end;
procedure OnPaint(Sender : TObject);
var
P, Controls : TPointArray;
i : Integer;
begin
SetArrayLength(Controls, 3);
Controls[0] := c1;
Controls[1] := c2;
Controls[2] := c3;
for i := 0 to 2 do
MainForm.Canvas.Rectangle(Controls[i].x - 2, Controls[i].y - 2, Controls[i].x + 2, Controls[i].y + 2);
P := DrawSplinePath(s.x, s.y, e.x, e.y, Controls);
for i := 0 to GetArrayLength(P)-1 do
MainForm.Canvas.Pixels[P[i].x, P[i].y] := 255 * i;
MainForm.Canvas.Rectangle(s.x - 2, s.y - 2, s.x + 2, s.y + 2);
MainForm.Canvas.Rectangle(e.x - 2, e.y - 2, e.x + 2, e.y + 2);
end;
procedure OnTimer(Sender : TObject);
begin
MainForm.Repaint;
end;
procedure InitForm;
begin
s := Point(10, 10);
e := Point(200, 300);
C1 := Point(100, 100);
C2 := Point(200, 50);
C3 := Point(100, 50);
MainForm := CreateForm;
MainForm.SetBounds(0, 0, 500, 500);
MainForm.POSITION:= poDesktopCenter;
MainForm.BORDERICONS:= [biMinimize, biSystemMenu];
MainForm.BORDERSTYLE:= bsSingle;
MainForm.Color := 0;
MainForm.Caption := 'Sky Spline';
MainForm.Canvas.Brush.Style := bsSolid;
MainForm.Canvas.Brush.Color := clWhite;
MainForm.OnPaint := @OnPaint;
MainForm.OnMouseMove := @OnMouseMove;
MainForm.ShowModal;
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
setarraylength(V, 0);
ThreadSafeCall('InitForm', v);
end;
{var
P, Controls : TPointArray;
i : Integer;}
begin
try
SafeInitForm;
{
SetArrayLength(Controls, 3);
Controls[0] := Point(900, 400);
Controls[1] := Point(5, 500);
Controls[2] := Point(5, 500);
P := DrawSplinePath(10, 10, 600, 600, Controls);
for i := 0 to GetArrayLength(P)-1 do
begin
MoveMouse(P[i].x, P[i].y);
Wait(10);
end; }
finally
FreeForm(MainForm);
except
Writeln('ERROR');
end;
end.
Draw Spline
Reply With Quote
'. 
Originally Posted by jhildy
