Results 1 to 17 of 17

Thread: SCAR Scripting Examples

  1. #1
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default SCAR Scripting Examples

    this is my new project, which is (hopefully) going to be a huge archive of examples of various scripting techniques, and uses for scipters from beginers to advanced.

    this is NOT meant to "teach" any one how to do stuff, its more for the person learning something new, forgets how or what to do with something, and needs a little example to push them in the right direction

    my goal is to help new scripters script, and maby the advanced

    all of my examples are organized into 3 menus. (beginner, intermediate, advanced)

    as of right now, i have the following examples:
    Beginner:
    -Procedures
    -Functions
    -Variables(integer, string, boolean)
    -while-do loops
    -for-to-do loops
    -SMART

    Intermediate
    -SRL Player Form
    -Radial Walking

    Advanced
    -TPA's - basic

    credits
    Dan Cardin for updating and giving suggestions :>
    Nielsie for the SCAR syntax highlights

    please correct any scripting mistakes/ inefficiencies, spelling/ grammar mistakes, and of course ideas to add to the script
    Last edited by Awkwardsaw; 10-06-2009 at 10:22 AM.
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

  2. #2
    Join Date
    Feb 2006
    Location
    Tracy/Davis, California
    Posts
    12,631
    Mentioned
    135 Post(s)
    Quoted
    418 Post(s)

    Default

    I press play and SCAR closes and dies?
    Also you spelled any "ant" inf your first post, fixed it for you!
    Nice tool/idea for a refresher lots of people forget basics after being gone/idle for a long time.
    Looking at other existing scripts would also help too ?
    Last edited by YoHoJo; 10-05-2009 at 10:45 AM.

  3. #3
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default

    Quote Originally Posted by YoHoJo View Post
    I press play and SCAR closes and dies?
    Also you spelled any "ant" inf your first post, fixed it for you!
    Nice tool/idea for a refresher lots of people forget basics after being gone/idle for a long time.
    Looking at other existing scripts would also help too ?
    wat?
    thanks
    thanks again
    and yep, i'm also looking through the tutorial island
    Last edited by Awkwardsaw; 10-05-2009 at 10:49 AM.
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

  4. #4
    Join Date
    Feb 2006
    Location
    Tracy/Davis, California
    Posts
    12,631
    Mentioned
    135 Post(s)
    Quoted
    418 Post(s)

    Default

    When I press play on SCAR, it clears the debug, and then just closes.

  5. #5
    Join Date
    Mar 2008
    Location
    New Jersey
    Posts
    1,673
    Mentioned
    1 Post(s)
    Quoted
    9 Post(s)

    Default

    same here YoHoJo, you use vista? for me, it says it's:
    "Data Execution Prevention"

    in the pop-up that shows in the toolbar, saying that:

    Data Execution Prevention (DEP) is a security feature that can help prevent damage to your computer from viruses and other security threats. Harmful programs can try to attack Windows by attempting to run (also known as execute) code from system memory locations reserved for Windows and other authorized programs.


    So I don't know, I didn't really look through the script, but maybe memory was forgot to be free'd or something... not sure really, but hopefully that helps you awkward

  6. #6
    Join Date
    Feb 2006
    Location
    Tracy/Davis, California
    Posts
    12,631
    Mentioned
    135 Post(s)
    Quoted
    418 Post(s)

    Default

    Im on XP. And get no error messages or anything. Debug just clears, and SCAR force-closes.

  7. #7
    Join Date
    Apr 2007
    Location
    UK
    Posts
    2,295
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    SCAR just dies with me too.

    Rogeruk's Al-Kharid Tanner V1.1 [Released]
    Rogeruk's Barbarian Crafter [Coming Soon]
    Rogeruk's Guild Fisher [Coming Soon]
    !! - Taking Requests - !!

  8. #8
    Join Date
    Feb 2007
    Location
    Alberta,Canada
    Posts
    2,358
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    works for me, scar 3.21

    Might I suggest making it an actual tutorial though, it doesnt seem to be really all that helpful. It gives a function with no explaination, and even if its a refresher it would be kinda hard to follow. I like the idea though, I might use a similar way to write a tutorial later.

  9. #9
    Join Date
    Mar 2008
    Location
    New Jersey
    Posts
    1,673
    Mentioned
    1 Post(s)
    Quoted
    9 Post(s)

    Default

    Quote Originally Posted by YoHoJo View Post
    Im on XP. And get no error messages or anything. Debug just clears, and SCAR force-closes.
    I'm on vista, so it told me why it closed.

    and I'm on 3.22 and it didn't work, weird how it works for 3.21 but not 3.22

  10. #10
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default

    thats odd, it works for me and for sandstorm . i'm using 3.21 and vista

    as for bumble, if i explain it in the form, it would be very messy i might figure stuff out later though
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

  11. #11
    Join Date
    Apr 2007
    Posts
    3,152
    Mentioned
    3 Post(s)
    Quoted
    1 Post(s)

    Default

    Nifty idea. You ought to steal Nielsie's SCAR syntax highlighter things. like this!
    SCAR Code:
    var
      frmDesign : TForm;
      Button1, Button2, Button3 : TButton;
      Memo1 : TRichedit;
      mMenu: tMainMenu;
      names: array of TStringarray;
      Panels: array of array of TMenuItem;
      PALL: boolean;

    procedure Fortodo_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:integer;');
        Add('begin');
        add('  for i:= 0 to 10 do');
        add('    writeln(inttostr(i));');
        add('end;');
      end;
    end;

    procedure Integers_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:integer;');
        Add('begin');
        add('  i := random(10);');
        add('  writeln(inttostr(i));');
        add('end;');
      end;
    end;

    procedure Strings_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:string;');
        Add('begin');
        add('  i := ''hello world'';');
        add('  writeln(i);');
        add('end;');
      end;
    end;

    procedure Bool_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:Boolean;');
        Add('begin');
        add('  i := true;');
        add('  if i then writeln(''yay'');');
        add('end;');
      end;
    end;

    procedure While_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:integer;');
        Add('begin');
        add('  while i < 10 do');
        add('  begin');
        add('    writeln(inttostr(i));');
        add('    inc(i);');
        add('  end;');
        add('end;');
      end;
    end;

    procedure Proc_Example;
    begin
      with Memo1.lines do
      begin
        Add('Procedure Test(text: String);');
        Add('begin');
        add('  writeln(text);');
        add('end;');
      end;
    end;

    procedure Func_Example;
    begin
      with Memo1.lines do
      begin
        Add('Function Test:Integer;');
        Add('begin');
        add('  result:= random(10000);');
        add('end;');
      end;
    end;

    procedure TPA_Example;
    begin
      with Memo1.lines do
      begin
        Add('Function FindObj(col, tol:integer; uptext:string):Boolean;');
        Add('var tpa:TPointArray; i:Integer;');
        Add('begin');
        add('  if not findcolorstolerance(tpa, col, msx1, msy1, msx2, msy2, tol) then exit;');
        add('  if length(tpa) < 5 then exit;');
        add('  for i:= 0 to high(tpa) do');
        add('  begin');
        add('    mmouse(tpa[i].x, tpa[i].y, 0, 0);');
        add('    if isuptext(uptext) then');
        add('    begin');
        add('      mouse(tpa[i].x, tpa[i].y, 0, 0, true);');
        add('      break;');
        add('    end;');
        add('  end;');
        add('end;');
      end;
    end;

    procedure SRLPlayerForm_Example;
    begin
      with Memo1.lines do
      begin
        Add('SRLPlayerForm(True, [''booleans''],[''integers''], [''strings''], [''extendeds'']);');
      end;
    end;

    procedure RadialWalk_Example;
    begin
      with Memo1.lines do
      begin
        Add('if not RadialWalk({TheColor}, {start radial}, {end radial}, {radius}, {Xmod}, {Ymod}) then exit;');
      end;
    end;

    procedure SMART_Example;
    begin
      with Memo1.lines do
      begin
        Add('program new;');
        Add('{.include SRL/SRL/Misc/Smart.scar} //you must call this before SRL');
        Add('{.Include SRL/SRL.scar}');
        Add(' ');
        Add('begin');
        Add('  SMART_Server:= 100 //what rs world');
        Add('  Smart_Members:= true //members world?;');
        Add('  Smart_Signed:= false //signed java applet?;');
        Add('  Smart_SuperDetail:= false; //High Detailed mode?');
        Add('  setupsrl; //you must call this to open SMART. AFTER you set the vars');
        Add('end.');
      end;
    end;

    procedure Print_Memo(sender: TObject);
    begin
      writeln(memo1.text);
    end;

    const
      punct = '[!"%&''()*+,-./:;<=>?@[\]_`{|}~]';

    //////////////  ParseIt, ParseAll, ParseLine (Syntax highlighting) by Nielsie95  ///////////////////
    procedure ParseIt(RichEdit: TRichEdit; s: string; OffSet: Integer);
    var
      a, b, c, d, e, f, o, t, l: Integer;
      ts: string;
      keyword, key: TStringArray;
    begin
      Keyword := [' begin ', ' end ', ' else ', ' try ', ' except ', ' finally ', ' finally ', ' repeat ', ' until ', ' procedure ', ' function ', ' var ', ' const ', ' if ', ' string ', ' and ', ' array ', ' as ', ' case ', ' class ', ' const ', ' div ', ' do ', ' downto ', ' end ', ' for ', ' goto ', ' in ', ' is' , ' mod ', ' not ', ' object ', ' of ', ' on ', ' or ', ' procedure ', ' program ', ' record ', ' repeat ', ' set ', ' shl ', ' shr ', ' then ', ' to ', ' type ', ' while ', ' with ', ' xor ', ' forward '];
      t := GetSystemTime;
      with RichEdit do
      begin
        Perform($000B, 0, 0);
        Lines.BeginUpdate;
        b := SelStart;
        c := SelLength;
        l := Length(s);
        SelStart := OffSet;
        SelLength := l;
        SelAttributes.Color := clBlack;    /////////////////
        SelAttributes.Style := [];
        a := High(Keyword);
        for d := 0 to a do
        begin
          o := 1;
          ts := ReplaceRegex(s, punct+Trim(Keyword[d])+punct+'|'+punct+Trim(Keyword[d])+' | '+Trim(Keyword[d])+punct, Keyword[d]);
          e := PosEx(Keyword[d], ts, 1);
          f := Length(Keyword[d]) - 2;
          while (e > 0) do
          begin
            o := e + f;
            SelStart := e - 1 + OffSet;
            SelLength := f;
            SelAttributes.Style := [fsBold];   ///////////////////
            SelAttributes.Color := clBlack;
            e := PosEx(Keyword[d], ts, o);
          end;
        end;
        Key := [' 0', ' 1', ' 2', ' 3', ' 4', ' 5', ' 6', ' 7', ' 8', ' 9'];
        a := High(Key);
        f := l;
        for d := 0 to a do
        begin
          o := 1;
          ts := ReplaceRegex(s, punct+Trim(Key[d]), Key[d]);
          e := PosEx(Key[d], ts, 1);
          while (e > 0) do
          begin
            SelStart := e -1 + OffSet;
            SelLength := 1;
            o := e;
            Inc(e);
            while (Pos(ts[e], '1234567890.') > 0) and (e <= f) do
              Inc(e);
            SelLength := e - o - 1;
            if (Pos('.', Copy(ts, o, e - o)) <= 0) then
            begin
              SelAttributes.Style := [];      ///////////////////////
              SelAttributes.Color := clNavy;
            end;
            o := e + 1;
            e := PosEx(Key[d], ts, o);
          end;
        end;
        d := PosEx(#39, s, 1);
        while (d > 0) do
        begin
          o := d + 1;
          SelStart := d -2 + OffSet;
          SelLength := 1;
          if (SelAttributes.Color = clGreen) then
          begin
            if (d > 0) then
              d := PosEx(#39, s, o);
            Continue;
          end;
          d := PosEx(#39, s, o);
          e := PosEx(Chr(10), Lines.Text, o + OffSet) - OffSet;
          if (d <= 0) then
            d := e
          else
            if (e > 0) then
              d := Min(d, e);
          if (d <= 0) then
            SelLength := l + OffSet - SelStart + 2
          else
            SelLength := d + OffSet - SelStart -1;
          SelAttributes.Style := [];             //////////////////////////
          SelAttributes.Color := clFuchsia;
          o := d + 1;
          if (d > 0) then
            d := PosEx(#39, s, o);
        end;
        d := PosEx(#123, s, 1);
        while (d > 0) do
        begin
          o := d + 1;
          SelStart := d -2 + OffSet;
          SelLength := 1;
          if (SelAttributes.Color = clFuchsia) then
          begin
            if (d > 0) then
              d := PosEx(#123, s, o);
            Continue;
          end;
          d := PosEx(#125, s, o);
          if (d <= 0) then
            SelLength := GetTextLen - SelStart + 2
          else
            SelLength := (d + OffSet) - SelStart -1;
          SelAttributes.Style := [];              ///////////////////////
          SelAttributes.Color := clGreen;
          o := d + 1;
          if (d > 0) then
            d := PosEx(#123, s, o);
        end;
        d := PosEx(#47#47, s, 1);
        while (d > 0) do
        begin
          o := d + 2;
          SelStart := d -2 + OffSet;
          d := PosEx(Chr(10), Lines.Text, o + OffSet);
          if (d <= 0) then
            SelLength := l + OffSet - SelStart + 2
          else
            SelLength := d - SelStart -2;
          SelAttributes.Style := [];
          SelAttributes.Color := clGreen;
          o := d;
          if (d > 0) then
            d := PosEx(#47#47, s, o);
        end;
        SelStart := b;
        SelLength := c;
        Lines.EndUpdate;
        Perform($000B, 1, 0);
        Repaint;
      end;
    end;

    procedure ParseAll(sender: TRichEdit);
    var
      s: string;
    begin
      with sender do
      begin
        s := LowerCase(Lines.Text);
        if (Trim(s) = '') then
          Exit;
        s := ' ' + Replace(s, Chr(13) + Chr(10), '  ') + ' ';
        ParseIt(sender, s, 0);
      end;
      PALL := False;
    end;

    function ParseLine(a: Integer; sender: TRichEdit): Integer;
    var
      b, c, d: Integer;
      s: string;
    begin
      with sender do
      begin
        Result := a;
        s := Lines[a];
        Delete(s, Length(s) -1, 2);
        if (Trim(s) = '') then Exit;
        a := Perform($00BB, a, 0);
        b := LastPosEx(#123, Lines.Text, a -1);
        c := SelStart;
        d := SelLength;
        while (b > 0) do
        begin
          SelStart := b - 1;
          SelLength := 1;
          if (SelAttributes.Color <> clFuchsia) then Break;
          b := LastPosEx(#123, Lines.Text, SelStart);
        end;
        SelStart := c;
        SelLength := d;
        c := LastPosEx(#125, Lines.Text, a -1);
        if (b > c) then
        begin
          c := PosEx(#125, Lines.Text, b);
          if (c <= 0) then
            c := Length(Lines.Text);
          if (c > (a + Length(s) + 1)) then
          begin
            s := Copy(Lines.Text, a, c - a -2);
            if (c > 64000) then
              Result := Perform($0400 + 54, 0, c)
            else
              Result := Perform($00C9, c, 0);
          end;
          Insert('}', s, 1);
          Dec(a);
        end;
        s := ' ' + Replace(s, Chr(13) + Chr(10), '  ')+' ';
        ParseIt(sender, s, a);
      end;
    end;

    procedure Click(Sender: TObject);
    var i, e: integer;
    begin
      memo1.text := '';
      for i := 0 to high(panels) do
      begin
        for e := 1 to high(panels[i]) do
          if sender = panels[i][e] then
            break;
        if(e <= high(panels[i])) then
          if sender = panels[i][e] then
            break;
      end;
      frmdesign.Caption := names[i][e];
      case sender of
        Panels[0][1]: Proc_Example;
        Panels[0][2]: Func_Example;
        Panels[0][3]: Fortodo_Example;
        Panels[0][4]: while_example;
        Panels[0][5]: integers_example;
        Panels[0][6]: strings_example;
        Panels[0][7]: bool_example;
        Panels[0][8]: smart_example;
        Panels[1][1]: SRLPlayerform_Example;
        Panels[1][2]: RadialWalk_example;
        Panels[2][1]: TPA_Example;
      end;
      ParseAll(memo1);
    end;

    procedure Initform;
    var
      TimeInitform,i,e: Integer;
    begin
      TimeInitform := GetSystemTime;
      frmDesign := CreateForm;
      with frmDesign do
      begin
        Position := poScreenCenter;
        BorderStyle := bsSingle;
        BorderIcons := [biMinimize,biSystemMenu];
        Width := 440;
        Height := 296;
        Caption := 'SCAR Examples - Made By Awkwardsaw';
      end;
      mMenu := TMainMenu.create(frmdesign);
      SetArrayLength(names, 3);
      SetArrayLength(Panels, GetArrayLength(names));
      names[0] := ['Beginner',    {/////////} 'Procedures','Functions','For-To-Do','While-Do','Integers','Strings','Booleans','SMART'];
      names[1] := ['Intermediate',{/////////} 'SRL Player Form', 'Radial Walk'];
      names[2] := ['Advanced',    {/////////} 'TPointArrays'];
      for i := 0 to high(names) do
      begin
        SetArrayLength(Panels[i], GetArraylength(names[i]));
        Panels[i][0] := TMenuItem.Create(frmdesign);
        Panels[i][0].caption := names[i][0];
        mMenu.Items.Add(Panels[i][0]);
        for e := 1 to high(names[i]) do
        begin
          Panels[i][e] := TMenuItem.Create(frmdesign);
          Panels[i][e].Caption := names[i][e];
          Panels[i][e].OnClick := @Click;
          mMenu.Items.Items[i].add(Panels[i][e]);
        end;
      end;
      Button3 := TButton.Create(frmDesign);
      with Button3 do
      begin
        Parent := frmDesign;
        SetBounds(5,5,65,20);
        Caption := 'Print';
        OnClick := @Print_Memo;
      end;
      Memo1 := TRichedit.Create(frmDesign);
      with Memo1 do
      begin
        Parent := frmDesign;
        SetBounds(80, 5, 350, 240);
        Memo1.ScrollBars := ssBoth;
      end;
      WriteLn('Initform compiled in ' + IntToStr(GetSystemTime - TimeInitform) + ' milliseconds!');
    end;

    procedure SafeInitform;
    var
      v : TVariantArray;
    begin
      SetArrayLength(v, 0);
      ThreadSafeCall('Initform', v);
    end;

    procedure ShowInitformModal;
    begin
      frmDesign.ShowModal;
    end;

    procedure SafeShowInitformModal;
    var
      v : TVariantArray;
    begin
      SetArrayLength(v, 0);
      ThreadSafeCall('ShowInitformModal', v);
    end;

    procedure MainInitform;
    begin
      try
        SafeInitform;
        SafeShowInitformModal;
      finally
        FreeForm(frmDesign);
      except
        WriteLn('An error seems to have occurred in: Initform');
      end;
    end;

    begin
      ClearDebug;
      MainInitform;
    end.
    i edited it a bit. Same form, a lot easier to add more.
    You could actually probably make it a lot better by Saving all the examples in text files in the same directory as the script. Then it saves a lot of code, makes the examples neater and easier to see and whatnot. Or in an ini, but i think seperate text files would be the best.
    SCAR Tutorials: The Form Tutorial | Types, Arrays, and Classes
    Programming Projects: NotePad | Tetris | Chess


  12. #12
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default

    Quote Originally Posted by Dan Cardin View Post
    Nifty idea. You ought to steal Nielsie's SCAR syntax highlighter things. like this!
    SCAR Code:
    var
      frmDesign : TForm;
      Button1, Button2, Button3 : TButton;
      Memo1 : TRichedit;
      mMenu: tMainMenu;
      names: array of TStringarray;
      Panels: array of array of TMenuItem;
      PALL: boolean;

    procedure Fortodo_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:integer;');
        Add('begin');
        add('  for i:= 0 to 10 do');
        add('    writeln(inttostr(i));');
        add('end;');
      end;
    end;

    procedure Integers_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:integer;');
        Add('begin');
        add('  i := random(10);');
        add('  writeln(inttostr(i));');
        add('end;');
      end;
    end;

    procedure Strings_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:string;');
        Add('begin');
        add('  i := ''hello world'';');
        add('  writeln(i);');
        add('end;');
      end;
    end;

    procedure Bool_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:Boolean;');
        Add('begin');
        add('  i := true;');
        add('  if i then writeln(''yay'');');
        add('end;');
      end;
    end;

    procedure While_Example;
    begin
      with Memo1.lines do
      begin
        Add('var i:integer;');
        Add('begin');
        add('  while i < 10 do');
        add('  begin');
        add('    writeln(inttostr(i));');
        add('    inc(i);');
        add('  end;');
        add('end;');
      end;
    end;

    procedure Proc_Example;
    begin
      with Memo1.lines do
      begin
        Add('Procedure Test(text: String);');
        Add('begin');
        add('  writeln(text);');
        add('end;');
      end;
    end;

    procedure Func_Example;
    begin
      with Memo1.lines do
      begin
        Add('Function Test:Integer;');
        Add('begin');
        add('  result:= random(10000);');
        add('end;');
      end;
    end;

    procedure TPA_Example;
    begin
      with Memo1.lines do
      begin
        Add('Function FindObj(col, tol:integer; uptext:string):Boolean;');
        Add('var tpa:TPointArray; i:Integer;');
        Add('begin');
        add('  if not findcolorstolerance(tpa, col, msx1, msy1, msx2, msy2, tol) then exit;');
        add('  if length(tpa) < 5 then exit;');
        add('  for i:= 0 to high(tpa) do');
        add('  begin');
        add('    mmouse(tpa[i].x, tpa[i].y, 0, 0);');
        add('    if isuptext(uptext) then');
        add('    begin');
        add('      mouse(tpa[i].x, tpa[i].y, 0, 0, true);');
        add('      break;');
        add('    end;');
        add('  end;');
        add('end;');
      end;
    end;

    procedure SRLPlayerForm_Example;
    begin
      with Memo1.lines do
      begin
        Add('SRLPlayerForm(True, [''booleans''],[''integers''], [''strings''], [''extendeds'']);');
      end;
    end;

    procedure RadialWalk_Example;
    begin
      with Memo1.lines do
      begin
        Add('if not RadialWalk({TheColor}, {start radial}, {end radial}, {radius}, {Xmod}, {Ymod}) then exit;');
      end;
    end;

    procedure SMART_Example;
    begin
      with Memo1.lines do
      begin
        Add('program new;');
        Add('{.include SRL/SRL/Misc/Smart.scar} //you must call this before SRL');
        Add('{.Include SRL/SRL.scar}');
        Add(' ');
        Add('begin');
        Add('  SMART_Server:= 100 //what rs world');
        Add('  Smart_Members:= true //members world?;');
        Add('  Smart_Signed:= false //signed java applet?;');
        Add('  Smart_SuperDetail:= false; //High Detailed mode?');
        Add('  setupsrl; //you must call this to open SMART. AFTER you set the vars');
        Add('end.');
      end;
    end;

    procedure Print_Memo(sender: TObject);
    begin
      writeln(memo1.text);
    end;

    const
      punct = '[!"%&''()*+,-./:;<=>?@[\]_`{|}~]';

    //////////////  ParseIt, ParseAll, ParseLine (Syntax highlighting) by Nielsie95  ///////////////////
    procedure ParseIt(RichEdit: TRichEdit; s: string; OffSet: Integer);
    var
      a, b, c, d, e, f, o, t, l: Integer;
      ts: string;
      keyword, key: TStringArray;
    begin
      Keyword := [' begin ', ' end ', ' else ', ' try ', ' except ', ' finally ', ' finally ', ' repeat ', ' until ', ' procedure ', ' function ', ' var ', ' const ', ' if ', ' string ', ' and ', ' array ', ' as ', ' case ', ' class ', ' const ', ' div ', ' do ', ' downto ', ' end ', ' for ', ' goto ', ' in ', ' is' , ' mod ', ' not ', ' object ', ' of ', ' on ', ' or ', ' procedure ', ' program ', ' record ', ' repeat ', ' set ', ' shl ', ' shr ', ' then ', ' to ', ' type ', ' while ', ' with ', ' xor ', ' forward '];
      t := GetSystemTime;
      with RichEdit do
      begin
        Perform($000B, 0, 0);
        Lines.BeginUpdate;
        b := SelStart;
        c := SelLength;
        l := Length(s);
        SelStart := OffSet;
        SelLength := l;
        SelAttributes.Color := clBlack;    /////////////////
        SelAttributes.Style := [];
        a := High(Keyword);
        for d := 0 to a do
        begin
          o := 1;
          ts := ReplaceRegex(s, punct+Trim(Keyword[d])+punct+'|'+punct+Trim(Keyword[d])+' | '+Trim(Keyword[d])+punct, Keyword[d]);
          e := PosEx(Keyword[d], ts, 1);
          f := Length(Keyword[d]) - 2;
          while (e > 0) do
          begin
            o := e + f;
            SelStart := e - 1 + OffSet;
            SelLength := f;
            SelAttributes.Style := [fsBold];   ///////////////////
            SelAttributes.Color := clBlack;
            e := PosEx(Keyword[d], ts, o);
          end;
        end;
        Key := [' 0', ' 1', ' 2', ' 3', ' 4', ' 5', ' 6', ' 7', ' 8', ' 9'];
        a := High(Key);
        f := l;
        for d := 0 to a do
        begin
          o := 1;
          ts := ReplaceRegex(s, punct+Trim(Key[d]), Key[d]);
          e := PosEx(Key[d], ts, 1);
          while (e > 0) do
          begin
            SelStart := e -1 + OffSet;
            SelLength := 1;
            o := e;
            Inc(e);
            while (Pos(ts[e], '1234567890.') > 0) and (e <= f) do
              Inc(e);
            SelLength := e - o - 1;
            if (Pos('.', Copy(ts, o, e - o)) <= 0) then
            begin
              SelAttributes.Style := [];      ///////////////////////
              SelAttributes.Color := clNavy;
            end;
            o := e + 1;
            e := PosEx(Key[d], ts, o);
          end;
        end;
        d := PosEx(#39, s, 1);
        while (d > 0) do
        begin
          o := d + 1;
          SelStart := d -2 + OffSet;
          SelLength := 1;
          if (SelAttributes.Color = clGreen) then
          begin
            if (d > 0) then
              d := PosEx(#39, s, o);
            Continue;
          end;
          d := PosEx(#39, s, o);
          e := PosEx(Chr(10), Lines.Text, o + OffSet) - OffSet;
          if (d <= 0) then
            d := e
          else
            if (e > 0) then
              d := Min(d, e);
          if (d <= 0) then
            SelLength := l + OffSet - SelStart + 2
          else
            SelLength := d + OffSet - SelStart -1;
          SelAttributes.Style := [];             //////////////////////////
          SelAttributes.Color := clFuchsia;
          o := d + 1;
          if (d > 0) then
            d := PosEx(#39, s, o);
        end;
        d := PosEx(#123, s, 1);
        while (d > 0) do
        begin
          o := d + 1;
          SelStart := d -2 + OffSet;
          SelLength := 1;
          if (SelAttributes.Color = clFuchsia) then
          begin
            if (d > 0) then
              d := PosEx(#123, s, o);
            Continue;
          end;
          d := PosEx(#125, s, o);
          if (d <= 0) then
            SelLength := GetTextLen - SelStart + 2
          else
            SelLength := (d + OffSet) - SelStart -1;
          SelAttributes.Style := [];              ///////////////////////
          SelAttributes.Color := clGreen;
          o := d + 1;
          if (d > 0) then
            d := PosEx(#123, s, o);
        end;
        d := PosEx(#47#47, s, 1);
        while (d > 0) do
        begin
          o := d + 2;
          SelStart := d -2 + OffSet;
          d := PosEx(Chr(10), Lines.Text, o + OffSet);
          if (d <= 0) then
            SelLength := l + OffSet - SelStart + 2
          else
            SelLength := d - SelStart -2;
          SelAttributes.Style := [];
          SelAttributes.Color := clGreen;
          o := d;
          if (d > 0) then
            d := PosEx(#47#47, s, o);
        end;
        SelStart := b;
        SelLength := c;
        Lines.EndUpdate;
        Perform($000B, 1, 0);
        Repaint;
      end;
    end;

    procedure ParseAll(sender: TRichEdit);
    var
      s: string;
    begin
      with sender do
      begin
        s := LowerCase(Lines.Text);
        if (Trim(s) = '') then
          Exit;
        s := ' ' + Replace(s, Chr(13) + Chr(10), '  ') + ' ';
        ParseIt(sender, s, 0);
      end;
      PALL := False;
    end;

    function ParseLine(a: Integer; sender: TRichEdit): Integer;
    var
      b, c, d: Integer;
      s: string;
    begin
      with sender do
      begin
        Result := a;
        s := Lines[a];
        Delete(s, Length(s) -1, 2);
        if (Trim(s) = '') then Exit;
        a := Perform($00BB, a, 0);
        b := LastPosEx(#123, Lines.Text, a -1);
        c := SelStart;
        d := SelLength;
        while (b > 0) do
        begin
          SelStart := b - 1;
          SelLength := 1;
          if (SelAttributes.Color <> clFuchsia) then Break;
          b := LastPosEx(#123, Lines.Text, SelStart);
        end;
        SelStart := c;
        SelLength := d;
        c := LastPosEx(#125, Lines.Text, a -1);
        if (b > c) then
        begin
          c := PosEx(#125, Lines.Text, b);
          if (c <= 0) then
            c := Length(Lines.Text);
          if (c > (a + Length(s) + 1)) then
          begin
            s := Copy(Lines.Text, a, c - a -2);
            if (c > 64000) then
              Result := Perform($0400 + 54, 0, c)
            else
              Result := Perform($00C9, c, 0);
          end;
          Insert('}', s, 1);
          Dec(a);
        end;
        s := ' ' + Replace(s, Chr(13) + Chr(10), '  ')+' ';
        ParseIt(sender, s, a);
      end;
    end;

    procedure Click(Sender: TObject);
    var i, e: integer;
    begin
      memo1.text := '';
      for i := 0 to high(panels) do
      begin
        for e := 1 to high(panels[i]) do
          if sender = panels[i][e] then
            break;
        if(e <= high(panels[i])) then
          if sender = panels[i][e] then
            break;
      end;
      frmdesign.Caption := names[i][e];
      case sender of
        Panels[0][1]: Proc_Example;
        Panels[0][2]: Func_Example;
        Panels[0][3]: Fortodo_Example;
        Panels[0][4]: while_example;
        Panels[0][5]: integers_example;
        Panels[0][6]: strings_example;
        Panels[0][7]: bool_example;
        Panels[0][8]: smart_example;
        Panels[1][1]: SRLPlayerform_Example;
        Panels[1][2]: RadialWalk_example;
        Panels[2][1]: TPA_Example;
      end;
      ParseAll(memo1);
    end;

    procedure Initform;
    var
      TimeInitform,i,e: Integer;
    begin
      TimeInitform := GetSystemTime;
      frmDesign := CreateForm;
      with frmDesign do
      begin
        Position := poScreenCenter;
        BorderStyle := bsSingle;
        BorderIcons := [biMinimize,biSystemMenu];
        Width := 440;
        Height := 296;
        Caption := 'SCAR Examples - Made By Awkwardsaw';
      end;
      mMenu := TMainMenu.create(frmdesign);
      SetArrayLength(names, 3);
      SetArrayLength(Panels, GetArrayLength(names));
      names[0] := ['Beginner',    {/////////} 'Procedures','Functions','For-To-Do','While-Do','Integers','Strings','Booleans','SMART'];
      names[1] := ['Intermediate',{/////////} 'SRL Player Form', 'Radial Walk'];
      names[2] := ['Advanced',    {/////////} 'TPointArrays'];
      for i := 0 to high(names) do
      begin
        SetArrayLength(Panels[i], GetArraylength(names[i]));
        Panels[i][0] := TMenuItem.Create(frmdesign);
        Panels[i][0].caption := names[i][0];
        mMenu.Items.Add(Panels[i][0]);
        for e := 1 to high(names[i]) do
        begin
          Panels[i][e] := TMenuItem.Create(frmdesign);
          Panels[i][e].Caption := names[i][e];
          Panels[i][e].OnClick := @Click;
          mMenu.Items.Items[i].add(Panels[i][e]);
        end;
      end;
      Button3 := TButton.Create(frmDesign);
      with Button3 do
      begin
        Parent := frmDesign;
        SetBounds(5,5,65,20);
        Caption := 'Print';
        OnClick := @Print_Memo;
      end;
      Memo1 := TRichedit.Create(frmDesign);
      with Memo1 do
      begin
        Parent := frmDesign;
        SetBounds(80, 5, 350, 240);
        Memo1.ScrollBars := ssBoth;
      end;
      WriteLn('Initform compiled in ' + IntToStr(GetSystemTime - TimeInitform) + ' milliseconds!');
    end;

    procedure SafeInitform;
    var
      v : TVariantArray;
    begin
      SetArrayLength(v, 0);
      ThreadSafeCall('Initform', v);
    end;

    procedure ShowInitformModal;
    begin
      frmDesign.ShowModal;
    end;

    procedure SafeShowInitformModal;
    var
      v : TVariantArray;
    begin
      SetArrayLength(v, 0);
      ThreadSafeCall('ShowInitformModal', v);
    end;

    procedure MainInitform;
    begin
      try
        SafeInitform;
        SafeShowInitformModal;
      finally
        FreeForm(frmDesign);
      except
        WriteLn('An error seems to have occurred in: Initform');
      end;
    end;

    begin
      ClearDebug;
      MainInitform;
    end.
    i edited it a bit. Same form, a lot easier to add more.
    You could actually probably make it a lot better by Saving all the examples in text files in the same directory as the script. Then it saves a lot of code, makes the examples neater and easier to see and whatnot. Or in an ini, but i think seperate text files would be the best.
    i didnt know there was a SCAR syntax hilighter once i get on the other cpu i'll edit and update even more
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

  13. #13
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default

    i updated it last night, using the one that Dan Cardin updated i also changed the order of the examples, and added comments to most of them
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

  14. #14
    Join Date
    May 2007
    Location
    Some where fun.
    Posts
    2,891
    Mentioned
    1 Post(s)
    Quoted
    5 Post(s)

    Default

    I Like it Does not crash for me. Wish this was around when i was d3h noob star

  15. #15
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default

    Quote Originally Posted by Camaro' View Post
    I Like it Does not crash for me. Wish this was around when i was d3h noob star
    lol thanks, and me too!
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

  16. #16
    Join Date
    Apr 2007
    Posts
    3,152
    Mentioned
    3 Post(s)
    Quoted
    1 Post(s)

    Default

    If you were to have it load files rather than being hard coded in, you could also automatically add all the ones that come with SCAR. The only thing that would make it semi-difficult would be determining where to place them as far as categeory, but even that could be easily remedied, by possibly prefixing all the filenames and parsing it in the script. Other than that, the only real problem with it is that it has a very small list of examples.
    SCAR Tutorials: The Form Tutorial | Types, Arrays, and Classes
    Programming Projects: NotePad | Tetris | Chess


  17. #17
    Join Date
    May 2007
    Location
    knoxville
    Posts
    2,873
    Mentioned
    7 Post(s)
    Quoted
    70 Post(s)

    Default

    Quote Originally Posted by Dan Cardin View Post
    If you were to have it load files rather than being hard coded in, you could also automatically add all the ones that come with SCAR. The only thing that would make it semi-difficult would be determining where to place them as far as categeory, but even that could be easily remedied, by possibly prefixing all the filenames and parsing it in the script. Other than that, the only real problem with it is that it has a very small list of examples.
    i'v been trying to do that just cbf atm to re do them
    <TViYH> i had a dream about you again awkwardsaw
    Malachi 2:3

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •