Nifty idea. You ought to steal Nielsie's SCAR syntax highlighter things. like this!
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.