SRL Archive - Other Scripts

i love Splines….
Drag the spline Points around…

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.

Its beautiful :D

sky i have a question about the onmousemove procedure because when i used it in a seperate script it gave me a type mysmatch where the begin was.

I never learned splines before. Your making me frown like ':confused: '.

;D

From: jhildy
sky i have a question about the onmousemove procedure because when i used it in a seperate script it gave me a type mysmatch where the begin was.

procedure might be typed wrong..
has to be…

procedure OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

other then that i would have to look at it :)

hey, Check this out :)

sorry for the double post….

program new;


const
   RibbonWidth = 10;
   RibbonHeight = 100;
   DegreeTurn = 360;





type
   TRibbon = record
   Control : TPoint;
   Width, Height : Integer;
end;

var
  MainForm : TForm;
  Ribbon : TRibbon;
  Timer : TTIMER;
  Degree : Integer;



function DrawSplinePath(sx, sy, ex, ey, MinStep : 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) / 0.5));
  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 * b4 + Cntrls[2].x * b3 + Cntrls[3].x * b2 + Cntrls[4].x * b1 + sx);
      Tempy := Trunc(Cntrls[1].y * b4 + Cntrls[2].y * b3 + Cntrls[3].y * b2 + Cntrls[4].y * b1 + sy);
       if (iAbs(Lastx - Tempx) >= MinStep) and
          (iAbs(Lasty - Tempy) >= MinStep) then
       begin
         SetArrayLength(Result, Length(Result) + 1);
         Result[length(Result)-1] := Point(Tempx, Tempy);
         Lastx := Tempx;
         Lasty := Tempy;
       end;
   until (theta >= 1);
  end;
end;

procedure DrawRibbon(Ribbon : TRibbon);
var
   i : Integer;
   P : TPointArray;
begin
try
   P := DrawSplinePath(255, 100, 255, 100 + Ribbon.Height, 0, [Ribbon.Control, Ribbon.Control, Ribbon.Control]);

 for i := 0 to GetArrayLength(P)-1 do
 begin
   MainForm.Canvas.MoveTo(P[i].x, P[i].y);
   MainForm.Canvas.LineTo(P[i].x + Ribbon.Width, P[i].y);
   if (i mod 2 = 0) then
   MainForm.Canvas.Pen.Color := 255 * i;
 end;
except
end;
end;




procedure OnPaint(Sender : TObject);
begin
 DrawRibbon(Ribbon);
end;


procedure OnTimer(Sender : TObject);
var
  x, y : Integer;
begin
    Degree := Degree + 30;
    x := trunc(100 * Sin((Pi/DegreeTurn) * Degree));
    y := trunc(120 * Cos((Pi/DegreeTurn) * Degree));
    Ribbon.Control := Point(x, y);
    MainForm.Repaint;
end;


procedure InitForm;
begin
  MainForm := CreateForm;
  MainForm.SetBounds(0, 0, 500, 400);
  MainForm.POSITION:= poDesktopCenter;
  MainForm.BORDERICONS:= [biMinimize, biSystemMenu];
  MainForm.BORDERSTYLE:= bsSingle;
  MainForm.Caption := 'Splines!';
  MainForm.Canvas.Pen.Color := 255;
  MainForm.Canvas.Pen.Width := 4;
  MainForm.Canvas.Brush.Style := bsClear;
  MainForm.OnPaint := @OnPaint;

  Timer := TTIMER.Create(MainForm);
  Timer.INTERVAL := 100;
  Timer.ONTIMER := @OnTimer;

  MainForm.ShowModal;
end;

procedure SafeInitForm;
var
  v: TVariantArray;
begin
  setarraylength(V, 0);
  ThreadSafeCall('InitForm', v);
end;


begin
  try
   Ribbon.Height := RibbonHeight;
   Ribbon.Width := RibbonWidth;

  SafeInitForm;

  finally
     FreeForm(MainForm)

  except
    Writeln('ERROR: With Loading');

  end;

end.

Nice… Are you better scripting non-rs than rs?

From: n3ss3s
Nice… Are you better scripting non-rs than rs?

Thats for you to decide but Id say i enjoy non-rs scripts more…
but i like making like object finders and ect… in RS… too. :p