SRL Archive - Other Scripts

A program that I made to test out arrays of forms, and having multiple forms showing at once.

Errors are common. I've come to the conclusion that it's SCAR, not the script.

program Spawner;
var
  Form : Array [0..25] of TForm;
  Button1 : Array [0..25] of TButton;
  i, x, y : Integer;

procedure InitForm; forward;

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

procedure ShowFormModal;
begin
  Form[i].SHOW;
end;

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

procedure Make;
begin
  SafeInitForm;
  SafeShowFormModal;
end;

procedure Spawn(Sender : TObject);
var
  x : integer;
begin
if(i >= 25)then
begin
  for x := 0 to 25 do
  begin
    FreeForm(Form[x]);
    writeln('Form ' + inttostr(x) + ' freed');
  end;
  TerminateScript;
end;
i := i + 1;
//Form[i-1].HIDE;
//FreeForm(Form[i-1]);
Make;
Form[i].Caption := 'Form ' + inttostr(i) + '/25';
if(i = 25)then
  for x := 0 to 25 do
    Button1[x].Caption := 'Close all forms';
end;

Procedure InitForm;
begin
Form[i] := CreateForm;
GetClientDimensions(x, y);
Form[i].Left := random(x - 125);
Form[i].Top := RandomRange(25, y);
Form[i].BorderIcons := [biMinimize, biMaximize];
Form[i].BorderStyle := bsToolWindow;
Form[i].Caption := 'Form';
Form[i].ClientHeight := 25;
Form[i].ClientWidth := 125;
Form[i].Color := clBtnFace;
Form[i].Font.Color := clWindowText;
Form[i].Font.Height := -11;
Form[i].Font.Name := 'MS Sans Serif';
Form[i].Font.Style := [];
Form[i].Visible := True;
Form[i].PixelsPerInch := 96;
Button1[i] := TButton.Create(Form[i]);
Button1[i].Parent := Form[i];
Button1[i].Left := 0;
Button1[i].Top := 0;
Button1[i].Width := 125;
Button1[i].Height := 25;
Button1[i].Caption := 'Spawn new form';
Button1[i].TabOrder := 8;
Button1[i].Onclick := @Spawn
end;

begin
Make;
repeat
  wait(10000);
until(isfkeydown(12))
end.

V2: (because of the large amount of forms, this script may cause considerable lag)

program Spawner;
var
  Form : Array [0..2500] of TForm;
  Button1 : Array [0..2500] of TButton;
  Tmr : Array [0..2500] of TTimer;
  i, x, y : Integer;

procedure InitForm; forward;

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

procedure ShowFormModal;
begin
  Form[i].SHOW;
end;

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

procedure Make;
begin
  SafeInitForm;
  MakeWindowTransparent(Form[i].Handle, random(200));
  wait(5);
  SafeShowFormModal;
end;

procedure Free(Sender : TObject);
var
  x : integer;
begin
  for x := 0 to 2500 do
  begin
    wait(2);
    Form[x].HIDE;
    FreeForm(Form[x]);
    writeln('Form ' + inttostr(x) + ' freed');
  end;
  TerminateScript;
end;

procedure Spawn(Sender : TObject);
var
  x : integer;
begin
if(i >= 2500)then
begin
  if(Tmr[5].Enabled)then
    for x := 0 to 2500 do
      Tmr[x].Enabled := false;
  Exit;
end;
i := i + 1;
//Form[i-1].HIDE;
//FreeForm(Form[i-1]);
Make;
Form[i].Caption := 'Form ' + inttostr(i) + '/2500';
Tmr[i].Interval := 25000 - (i * 10);
if(i = 2500)then
  for x := 0 to 2500 do
  begin
    Button1[x].Caption := 'Close all forms';
    Button1[x].OnClick := @Free;
  end;
end;

Procedure InitForm;
begin
Form[i] := CreateForm;
GetClientDimensions(x, y);
Form[i].Left := random(x - 125);
Form[i].Top := RandomRange(25, y);
Form[i].BorderIcons := [biMinimize, biMaximize];
Form[i].BorderStyle := bsToolWindow;
Form[i].Caption := 'Form';
Form[i].ClientHeight := 25;
Form[i].ClientWidth := 125;
Form[i].Color := clBtnFace;
Form[i].Font.Color := clWindowText;
Form[i].Font.Height := -11;
Form[i].Font.Name := 'MS Sans Serif';
Form[i].Font.Style := [];
Form[i].Visible := True;
Form[i].PixelsPerInch := 96;
Button1[i] := TButton.Create(Form[i]);
Button1[i].Parent := Form[i];
Button1[i].Left := 0;
Button1[i].Top := 0;
Button1[i].Width := 125;
Button1[i].Height := 25;
Button1[i].Caption := 'Spawn new form';
Button1[i].TabOrder := 8;
Button1[i].Onclick := @Spawn;
Tmr[i] := TTimer.Create(Form[i]);
Tmr[i].Interval := 5000;
Tmr[i].Ontimer := @Spawn;
end;

begin
ClearDebug;
Make;
repeat
  wait(500000);
until(isfkeydown(12))
end.

Wow pretty interesting! I have never thought about arrays of forms.

:p Probably because they're pretty useless…

lol maybe… but im sure someone can find a use for them… hopefully :)

*gasp*

Fun!

I like the idea of a form spawner…

You should make it spawn a new form, but with a different set up each time :p