meh im leaving for sweden in a few hours the boat leaves in 2,5hours.
I added another thing to the tool of urs..
procedure Minuspoint(reason: string; howmuch: integer);
begin
writeln(reason);
I := I - howmuch;
end;
thats what i added.
heres the whole thing…
program New;
var
frmDesign: TForm;
LabelTop: TLabel;
Label1: TLabel;
MarkingL: TLabel;
AnswerL: TLabel;
PercentL: TLabel;
ScriptAreaE: TEdit;
GenerateB: TButton;
EndMainForm: boolean;
Memo1: TMemo;
var
Scripttext: string;
I: integer;
// When the form is closed, this code will be executed.
procedure MainFormOnClose(Sender: TObject; var Action: TCloseAction);
begin
if (not (frmDesign.ModalResult = 1)) then
EndMainForm := True;
end;
function CountTextInString(S, T: string; Worth: integer; plusminus: boolean): Integer; //By Garret. Modded by me :)
var
N, tt: Integer;
begin
repeat
TT := TT + 1;
if PlusMinus then
begin
I := I + worth;
end else
I := I - worth;
N := Pos(LowerCase(T), LowerCase(S));
Delete(S, N, Length(T));
if TT = 3 then
begin
break;
end;
until (N = 0);
end;
function Information(Word: string): boolean;
begin
if Pos(lowercase(Word), LowerCase(ScriptText)) > 0 then
begin
Result := true;
end;
end;
procedure Minuspoint(reason: string; howmuch: integer);
begin
writeln(reason);
I := I - howmuch;
end;
procedure Generate;
begin
ScriptText := Memo1.Text;
if Information('exit;') then
begin
CountTextInString(LowerCase(ScriptText), 'exit;', 1, true);
end else Minuspoint('Add exit!', 5);
if Information('radial') then
begin
CountTextInString(LowerCase(ScriptText), 'radial', 7, true);
end else Minuspoint('Add radial!', 5);
if Information('linearwalk') then
begin
CountTextInString(LowerCase(ScriptText), 'linear', 6, true);
end else Minuspoint('Add linearwalk!', 5);
if Information('bitmapfromstring') then
begin
CountTextInString(LowerCase(ScriptText), 'bitmapfromstring', 5, true);
end else Minuspoint('Add bitmapfromstring!', 3);
if Information('dtmfromstring') then
begin
CountTextInString(LowerCase(ScriptText), 'dtmfromstring', 5, true);
end else Minuspoint('Add dtmfromstring!', 3);
if Information('dtmrotated') then
begin
CountTextInString(LowerCase(ScriptText), 'dtmrotated', 2, true);
end else Minuspoint('Add dtmrotated!', 3);
if Information('finddtm') then
begin
CountTextInString(LowerCase(ScriptText), 'finddtm', 1, true);
end else Minuspoint('Add finddtm!', 3);
if Information('tform') then
begin
CountTextInString(LowerCase(ScriptText), 'tform', 3, true);
end else Minuspoint('Add tform!', 2);
if Information('fflag(') then
begin
CountTextInString(LowerCase(ScriptText), 'fflag(', 2, true);
end else Minuspoint('Add fflag!', 5);
if Information('players') and Information('nextplayer(') then
begin
CountTextInString(LowerCase(ScriptText), 'players', 8, true);
end else Minuspoint('Add Players!', 10);
if not Information('players') and Information('nextplayer(') then
begin
CountTextInString(LowerCase(ScriptText), 'players', 8, false);
end else Minuspoint('Add Players!', 5);
if Information('findfastrandoms') then
begin
CountTextInString(LowerCase(ScriptText), 'findfastrandoms', 25, false);
Writeln('GET RID OF FINDFASTRANDOMS');
end;
if Information('{.include srl/srl.scar}') then
begin
CountTextInString(LowerCase(ScriptText), '{.include srl\srl.scar}', 5, true);
end else Minuspoint('Add SRL!', 10);
if Information('if(not loggedin)then')then
begin
CountTextInString(LowerCase(ScriptText), 'if(not loggedin)then', 5, true);
end else Minuspoint('Add if not loggedin then exit!', 5);
if Information('freedtm') then
begin
CountTextInString(LowerCase(ScriptText), 'freedtm', 5, true);
end else Minuspoint('Add freedtm!', 4);
if Information('freebitmap') then
begin
CountTextInString(LowerCase(ScriptText), 'freebitmap', 5, true);
end else Minuspoint('Add freebitmap!', 4);
if Information('freeform') then
begin
CountTextInString(LowerCase(ScriptText), 'freeform', 1, true);
end else Minuspoint('Add freeform!', 1);
if Information('clickmouse') then
begin
CountTextInString(LowerCase(ScriptText), 'clickmouse', 25, false);
Writeln('Remove clickmouse!');
end;
if Information('movemouse') and not Information('sleepandmovemouse') then
begin
CountTextInString(LowerCase(ScriptText), 'movemouse', 25, false);
Writeln('Remove movemouse!');
end;
if Information('tdtmpointdef') then
begin
CountTextInString(LowerCase(ScriptText), 'tdtmpointdef', 5, true);
end else Minuspoint('Add tdtmpointdef!', 2);
if Information('tpa') then
begin
CountTextInString(LowerCase(ScriptText), 'tpa', 5, true);
end else Minuspoint('Add tpa!', 5);
if Information('walkpath(') then
begin
CountTextInString(LowerCase(ScriptText), 'walkpath(', 9, true);
end else Minuspoint('Add walkpath!', 2);
if Information('tpointarray') then
begin
CountTextInString(LowerCase(ScriptText), 'tpointarray', 1, true);
end else Minuspoint('Add tpointarray!', 5);
if Information('reportvars') then
begin
CountTextInString(LowerCase(ScriptText), 'reportvars', 1, true);
end else Minuspoint('Add reportvars!', 1);
if Information('record') then //Bonus
begin
CountTextInString(LowerCase(ScriptText), 'record', 1, true);
end else Minuspoint('Add record!', 1);
if Information('tpoint') then
begin
CountTextInString(LowerCase(ScriptText), 'tpoint', 3, true);
end else Minuspoint('Add tpoint!', 5);
if Information('label') then
begin
CountTextInString(LowerCase(ScriptText), 'label', 1, true);
end else Minuspoint('Add labels!', 1);
if Information('goto') then
begin
CountTextInString(LowerCase(ScriptText), 'goto', 1, true);
end else Minuspoint('Add goto commands!', 1);
if Information('for') then
begin
CountTextInString(LowerCase(ScriptText), 'for', 1, true);
end else Minuspoint('Add for to do loops!', 5);
if Information('while') then
begin
CountTextInString(LowerCase(ScriptText), 'while', 1, true);
end else Minuspoint('Add while loops!', 5);
if Information('repeat') then
begin
CountTextInString(LowerCase(ScriptText), 'repeat', 1, true);
end else Minuspoint('Add repeat until loops!', 10);
if Information('case') then
begin
CountTextInString(LowerCase(ScriptText), 'case', 1, true);
end else Minuspoint('Add case of!', 5);
AnswerL.Caption := IntToStr(I);
Writeln('[===============================]');
Writeln('[ ~ Result = ' + IntToStr(I));
Writeln('[===============================]');
if I < 75 then
begin
writeln('Sorry, Your script isnt SRL-Members Worthy.');
end else
Writeln('Apply for members, unless you have cheated this');
end;
procedure HandleButtons(Sender: TObject);
begin
case Sender of
generateB: begin
Generate;
frmDesign.ModalResult := 1
end;
end;
end;
// This form was parsed using: DFM Form Parser v.25 by Ron.
procedure MainForm;
var
TimeMainForm: Integer;
begin
TimeMainForm := GetSystemTime;
frmDesign := CreateForm;
frmDesign.Left := 250;
frmDesign.Top := 114;
frmDesign.Width := 741;
frmDesign.Height := 480;
frmDesign.Caption := 'frmDesign';
frmDesign.Color := clBtnFace;
frmDesign.Font.Color := clWindowText;
frmDesign.Font.Height := -11;
frmDesign.Font.Name := 'MS Sans Serif';
frmDesign.Font.Style := [];
frmDesign.Visible := False;
frmDesign.PixelsPerInch := 96;
LabelTop := TLabel.Create(frmDesign);
LabelTop.Parent := frmDesign;
LabelTop.Left := 32;
LabelTop.Top := 32;
LabelTop.Width := 543;
LabelTop.Height := 37;
LabelTop.Caption := 'SRL-Forums SRL Member Application';
LabelTop.Font.Color := clWindowText;
LabelTop.Font.Height := -33;
LabelTop.Font.Name := 'MS Sans Serif';
LabelTop.Font.Style := [];
LabelTop.ParentFont := False;
MarkingL := TLabel.Create(frmDesign);
MarkingL.Parent := frmDesign;
MarkingL.Left := 424;
MarkingL.Top := 424;
MarkingL.Width := 73;
MarkingL.Height := 13;
MarkingL.Caption := 'Score:';
AnswerL := TLabel.Create(frmDesign);
AnswerL.Parent := frmDesign;
AnswerL.Left := 505;
AnswerL.Top := 424;
AnswerL.Width := 16;
AnswerL.Height := 13;
AnswerL.Caption := '0';
PercentL := TLabel.Create(frmDesign);
PercentL.Parent := frmDesign;
PercentL.Left := 520;
PercentL.Top := 424;
PercentL.Width := 8;
PercentL.Height := 13;
PercentL.Caption := '%';
Memo1 := TMemo.Create(frmDesign);
Memo1.Parent := frmDesign;
Memo1.Left := 32;
Memo1.Top := 128;
Memo1.Width := 657;
Memo1.Height := 273;
Memo1.Lines.Add('Script Here!');
Memo1.ScrollBars := ssVertical;
Memo1.TabOrder := 9;
GenerateB := TButton.Create(frmDesign);
GenerateB.Parent := frmDesign;
GenerateB.Left := 536;
GenerateB.Top := 80;
GenerateB.Width := 145;
GenerateB.Height := 41;
GenerateB.Caption := 'Generate Mark';
GenerateB.TabOrder := 9;
generateB.OnClick := @HandleButtons;
WriteLn('MainForm compiled in ' + IntToStr(GetSystemTime - TimeMainForm) + ' milliseconds!');
end;
procedure SafeMainForm;
var
V: TVariantArray;
begin
SetArrayLength(V, 0);
ThreadSafeCall('MainForm', V);
end;
procedure ShowMainFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowMainFormModal;
var
V: TVariantArray;
begin
SetArrayLength(V, 0);
ThreadSafeCall('ShowMainFormModal', V);
end;
procedure MainMainForm;
begin
try
SafeMainForm;
SafeShowMainFormModal;
finally
FreeForm(frmDesign);
except
WriteLn('An error seems to have occurred in: MainForm');
end;
end;
begin
ClearDebug;
MainMainForm;
if (EndMainForm) then
TerminateScript;
end.
bobbohobbo…
when im back from my vacation im going to expect a massive SRL Member Tool :P
