RichEdit Wort finden, Farbig und Fett markieren

[Nils_13]

Ich habe aus irgendeinem thread noch einen Parser, das hier ist jetzt das gesamte Programm:

Delphi-Quellcode:

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.

Ich wäre euch für Hilfe sehr dankbar

Evtl. steckt es ja in der
procedure parse (s: string); Unit drinnen.