unit miniprog_u;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, info_u, LMDControl, LMDBaseControl, LMDBaseGraphicControl,
LMDBaseLabel, LMDCustomLabel, LMDCustomLabelFill, LMDLabelFill, SynEdit,
SynMemo, XPMan, ComCtrls, LMDCustomControl, LMDCustomPanel,
LMDCustomBevelPanel, LMDCustomParentPanel, LMDBackPanel, ExtCtrls, Types;
type
TForm1 =
class(TForm)
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Memo2: TMemo;
errormemo: TSynMemo;
XPManifest1: TXPManifest;
FindDialog1: TFindDialog;
Memo1: TRichEdit;
Panel1: TPanel;
infoButton: TButton;
oeffnenButton: TButton;
speichernButton: TButton;
parseButton: TButton;
Button1: TButton;
endeButton: TButton;
ColorBox1: TColorBox;
function FindTextAll(re: TRichEdit; sText:
string; options: TSearchTypes): TIntegerDynArray;
procedure parseButtonClick(Sender: TObject);
procedure endeButtonClick(Sender: TObject);
procedure infoButtonClick(Sender: TObject);
procedure oeffnenButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CodingChange(Sender: TObject);
procedure speichernButtonClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure Memo1Change(Sender: TObject);
private
{ Private-Deklarationen }
dateiname:
string;
searchStart: integer;
geaendert: boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
Document: TCustomRichEdit;
ida: TIntegerDynArray;
i: integer;
sText:
string;
implementation
uses options;
{$R *.DFM}
CONST
signs:
SET OF CHAR = ['
+', '
-'];
ziffern:
SET OF CHAR = ['
0' .. '
9'];
procedure parse (s:
string);
var sym:
string; c: char; c_pos: integer; abbruch: boolean;
function next: char;
begin
inc (c_pos);
if c_pos > length (s)
then next := #0
else next := s [c_pos]
end;
{ next }
{ function nextsym: string;
begin
result := '';
while (c=' ') or (c=#10) or (c=#13) do c:=next;
if c in [';', ',', '.', '(', ')', '+'] then result := c
else if c=':' then begin
result := c;
c := next;
if c='=' then begin
result := result+c;
c := next;
end;
end
else if c in ziffern then begin
result := c;
c := next;
while c in ziffern do begin
result := result + c; c := next
end;
end
else begin
while c In ['A'..'Z', 'a'..'z'] Do Begin
result := result + upcase(c);
c:=next;
end;
end;
form1.memo2.lines.add(result);
end; { nextsym }
function nextSym:
string;
var symbol:
string;
begin
while (c = '
')
or (c = #10)
or (c = #13)
do c := next;
if c
in ['
.', '
;', '
,', '
(', '
)', '
+']
then
begin
symbol := c;
c := next
end
else
if c = '
:'
then
begin
symbol := c;
c := next;
if c = '
='
then
begin
symbol := '
:=';
c := next
end
end
else
if c
in ziffern
then
begin
symbol := c;
c := next;
while c
in ziffern
do
begin
symbol := symbol + c; c := next
end
end
else
if upcase (c)
in ['
A'..'
Z']
then
begin
symbol := c;
c := next;
while upcase (c)
in ['
A'..'
Z']
do
begin
symbol := symbol + c; c := next
end
end;
symbol := uppercase (symbol);
form1.Memo2.Lines.Add (symbol);
result := symbol
end;
{ nextSym }
PROCEDURE error (m:
STRING);
BEGIN
abbruch := true;
Form1.errormemo.Lines.Add(m)
END;
{ error }
function Programm: boolean;
function Bezeichner: boolean;
var i: integer;
begin
result := true;
for i:=1
to length(sym)
do
if not (sym[i]
in ['
A'..'
Z'])
then result := false;
if result
then
result := (sym <> '
PROGRAM')
and (sym <> '
VAR')
and (sym <> '
INTEGER')
and
(sym <> '
PROCEDURE')
and (sym <> '
BEGIN')
and (sym <> '
END')
and
(sym <> '
WRITELN')
and (sym <> '
READLN');
if result
then sym := nextsym
else error('
Ungültiger Bezeichner gefunden!');
end;
// Bezeichner
function Programm_Kopf: boolean;
begin
result := true;
If sym <> '
START'
then begin
result := false;
error ('
"START" erwartet!');
end
else sym := nextsym;
If result
then result := Bezeichner;
If result
and (sym <> '
;')
then begin
result := false;
error ('
";" erwartet!');
end
else sym := nextsym;
end;
// Programm_Kopf
function Block: boolean;
function Variablen_Deklarationsteil: boolean;
begin
result := (sym = '
VAR');
if result
then begin
sym := nextsym;
result := Bezeichner;
while result
and (sym = '
,')
do begin
sym := nextsym;
result := Bezeichner;
end;
if result
then begin
if sym <> '
:'
then begin
result := false;
error ('
":" erwartet!');
end
else begin
sym := nextsym;
If sym <> '
INTEGER'
then begin
result := false;
error ('
"INTEGER" erwartet!');
end
else begin
sym := nextsym;
if sym <> '
;'
then begin
result := false;
error ('
";" erwartet!');
end
else sym := nextsym;
end;
end;
end;
end
else error ('
Variablen-Deklarationsteil erwartet!')
end;
// Variablen_Deklarationsteil
function Prozeduren_Deklarationsteil: boolean;
begin
result := (sym='
PROCEDURE');
if result
then begin
sym := nextsym;
if Bezeichner
then begin
if not (sym = '
;')
then begin
result := false;
error ('
";" erwartet!');
end
else begin
sym := nextsym;
if Block
then begin
if not (sym = '
;')
then begin
result := false;
error ('
";" erwartet!');
end
else sym := nextsym;
end
else result := false;
end;
end;
end
else begin
result := false;
error ('
Prozeduren-Deklarationsteil erwartet!');
end;
end;
// Prozeduren_Deklarationsteil
function Anweisungsteil: boolean;
function Anweisung: boolean;
function Zuweisung: boolean;
function Konstante: boolean;
begin
end;
// Konstante
function Summe: boolean;
begin
end;
// Summe
begin
if Bezeichner
then
if sym = '
:='
then begin
sym := nextsym;
if Bezeichner
then begin
result := true;
if sym = '
+'
then
if Bezeichner
then result := true
else result := false;
end
else result := false;
end
else begin
result := false;
error ('
":=" erwartet!');
end
else result := false;
end;
// Zuweisung
begin
if (sym = '
WRITELN')
Or (sym = '
READLN')
then begin
sym := nextsym;
if sym = '
('
then begin
sym := nextsym;
if Bezeichner
then
if sym = '
)'
then begin
result := true;
sym := nextsym;
end
else begin
result := false;
error ('
")" erwartet!');
end;
end
else begin
result := false;
error ('
"(" erwartet!');
end;
end
else result := Zuweisung;
end;
// Anweisung
begin
result := false;
if sym = '
BEGIN'
then begin
result := true;
sym := nextsym;
if Anweisung
then begin
while result
and (sym = '
;')
do begin
sym := nextsym;
result := Anweisung;
end;
if result
then begin
if sym = '
END'
then begin
result := true;
sym := nextsym;
end
else begin
result := false;
error ('
"END" erwartet!')
end;
end;
end
else begin
result := false;
error ('
Anweisung erwartet!');
end;
end
else begin
result := false;
error ('
Anweisungsteil erwartet!');
end;
end;
// Anweisungsteil
begin
if sym = '
VAR'
then result := Variablen_Deklarationsteil
else result := true;
while result
and (sym = '
PROCEDURE')
do result := Prozeduren_Deklarationsteil;
if result
then result := Anweisungsteil;
end;
// Block
begin
Result := false;
If Programm_Kopf
then
If Block
then
If sym='
.'
then result := true;
end;
// Programm
begin
c_pos := 0;
abbruch := false;
c := next;
sym := nextsym;
If Programm
Then
begin
Form1.errormemo.Clear;
Form1.errormemo.Visible := False;
end
Else
begin
Form1.errormemo.Visible := True;
end;
// If Programm Then Form1.Labeltest.Caption := '#'
// Else Showmessage ('Fehler im Programm!')
end;
{ parse }
procedure TForm1.parseButtonClick(Sender: TObject);
begin
memo2.lines.Clear;
parse (memo1.text)
end;
{ TForm1.testButtonClick }
procedure TForm1.endeButtonClick(Sender: TObject);
begin
close
end;
{ TForm1.endeButtonClick }
procedure TForm1.infoButtonClick(Sender: TObject);
begin
form2.showModal
end;
procedure TForm1.oeffnenButtonClick(Sender: TObject);
begin
if openDialog1.Execute
then
begin
dateiname := openDialog1.FileName;
memo1.lines.LoadFromFile (dateiname);
form1.Caption := dateiname
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Button1.Click;
searchStart := 0;
forceCurrentDirectory := true;
geaendert := false;
end;
procedure TForm1.CodingChange(Sender: TObject);
begin
geaendert := true
end;
procedure TForm1.speichernButtonClick(Sender: TObject);
begin
if saveDialog1.Execute
then
begin
dateiname := saveDialog1.FileName;
memo1.lines.savetoFile (dateiname);
form1.Caption := dateiname;
geaendert := false;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var antwort: integer;
begin
if geaendert
then begin
antwort := messagebox(0, '
Die Datei wurde verändert. Soll sie gespeichert werden?', '
Parser', MB_YESNOCANCEL+MB_ICONQUESTION);
if antwort = 6
then begin
speichernButtonClick(Sender);
canclose := true;
end
else if antwort = 7
then canclose := true
else canclose := false;
end
else canclose := true;
end;
function TForm1.FindTextAll(re: TRichEdit; sText:
string; options: TSearchTypes): TIntegerDynArray;
var
iStart, iFound, iLength: integer;
begin
SetLength(Result, 0);
iStart := 0;
iLength := Length(re.Lines.Text);
while iStart < (iLength - Length(sText))
do
begin
iFound := re.FindText(sText, iStart, iLength - iStart, options);
if iFound = -1
then
Exit;
SetLength(Result, Succ(Length(Result)));
Result[High(Result)] := iFound;
iStart := iFound + Length(sText);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
sText := '
start';
ida := FindTextAll(Memo1, sText, []);
for i := Low(ida)
to High(ida)
do
with Memo1
do
begin
SelStart := ida[i];
SelLength := Length(sText);
SelAttributes.Color := clBlue;
//SelAttributes.Color := ColorBox1.Selected;
// SelAttributes.Color := optionform.ColorBox1.Selected;
SelAttributes.Style := [fsBold];
end;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
// ida := FindTextAll(Memo1, sText, []);
// Button1.Click;
end;
end.