RichEdit Wort finden, Farbig und Fett markieren

[Nils_13]

Zitat von faux:

Hallo!

Also wirklich, ich hab diese Funktion noch nie gebraucht und hab sie sogar ohne Delphi-Hilfe ausfündig gemacht. Da gibt es so eine coole Funktion namens Codevervollständigung.
Etwas mehr Engagement deinerseits würde nicht schaden.

Delphi-Quellcode:

MyRichEdit.SelAttributes.Color := clGreen;
MyRichEdit.SelAttributes.Style := [fsBold];

Grüße
Faux

Das läuft aber nicht ganz, es soll sich ja nur auf alle Wörter die 'START' heißen bezeiehen und man soll natürlich noch normal in Schwarz tippen können.

[faux]

Zitat von Nils_13:

Das läuft aber nicht ganz, es soll sich ja nur auf alle Wörter die 'START' heißen bezeiehen und man soll natürlich noch normal in Schwarz tippen können.

Da kann mein Code doch nichts dafür. Das musst du schon selbst programmieren.

Das geht übrigens nur bei RichEdit. Bei Memo wirst du hier nicht weit kommen.

Grüße
Faux

[Nils_13]

Zitat von faux:

Zitat von Nils_13:

Das läuft aber nicht ganz, es soll sich ja nur auf alle Wörter die 'START' heißen bezeiehen und man soll natürlich noch normal in Schwarz tippen können.

Da kann mein Code doch nichts dafür. Das musst du schon selbst programmieren.

Das geht übrigens nur bei RichEdit. Bei Memo wirst du hier nicht weit kommen.

Grüße
Faux

Das RichEdit wird überall im Code als Memo1 benutzt, da es früher mal ein Memo war, jetzt ist es allerdings ein RichEdit.

[jim_raynor]

Zitat von Nils_13:

Das läuft aber nicht ganz, es soll sich ja nur auf alle Wörter die 'START' heißen bezeiehen und man soll natürlich noch normal in Schwarz tippen können.

Ist mit einem Richedit nicht möglich bzw. nicht performant zu machen, da du bei jeder Änderung die Markierung neu machen müsstest. Warum nutzt die nicht SynEdit. Eine Memo-Komponente mit Syntax-Highlighting. Das ist doch, was du machen willst oder?

Und bevor du fragst. Mit SynEdit kann man auch eigene Highlighter machen.

[Nils_13]

Zitat von jim_raynor:

Zitat von Nils_13:

Das läuft aber nicht ganz, es soll sich ja nur auf alle Wörter die 'START' heißen bezeiehen und man soll natürlich noch normal in Schwarz tippen können.

Ist mit einem Richedit nicht möglich bzw. nicht performant zu machen, da du bei jeder Änderung die Markierung neu machen müsstest. Warum nutzt die nicht SynEdit. Eine Memo-Komponente mit Syntax-Highlighting. Das ist doch, was du machen willst oder?

Und bevor du fragst. Mit SynEdit kann man auch eigene Highlighter machen.

Ich weiß. Ich finde es 1. nicht so gut und 2. will ich es selber programmieren.

Wisst ihr warum bei diesem Code von mare_crisium nichts mehr markiert wird ?

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Click;
  searchStart := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var StartPos, ToEnd, foundAt: integer;
    lsuchText             : string;
    lfundStelle           : integer;
begin
  lsuchText :='START';
  lfundStelle := Memo1.FindText(lsuchText,searchStart,length(Memo1.text),[]);
  if (lfundStelle > 0)
  then begin
    Memo1.SetFocus;
    Memo1.SelStart := lfundStelle;
    Memo1.SelLength := Length(lsuchText);
    searchStart := Memo1.selStart + Memo1.selLength+1;
    if ( searchStart > length(Memo1.text))
    then searchStart:=0;
  end
  else searchStart:=0;

  if (Memo1.selLength > 0)
  then begin
    Memo1.SelAttributes.color := clBlue;
    Memo1.SelAttributes.style := [fsBold];
  end;
end;

Der Übrsprüngliche Code sah so aus, aber da wurde halt nur ein Wort markiert, obwohl es mehrfach dastand:

Delphi-Quellcode:

 suchText:='START';
    foundAt := Memo1.findText(suchText,0,length(Memo1.text),[stMatchCase]);
    if FoundAt <> -1 then
    begin
      Memo1.SelStart := FoundAt;
      Memo1.SelLength := Length(suchText);
      if (Memo1.selLength > 0)
      then begin
        Memo1.SelAttributes.color := clBlue;
        Memo1.SelAttributes.style := [fsBold];
      end;
      //Memo1.SelAttributes.Color := clGreen;
      //Memo1.SelAttributes.Style := [fsBold];
    end;

Evtl. liegt der Code-Schnipsel

Delphi-Quellcode:

  if (Memo1.selLength > 0)
  then begin
    Memo1.SelAttributes.color := clBlue;
    Memo1.SelAttributes.style := [fsBold];
  end;

an der falschen Stelle, aber ich habe schon alles durchprobiert, auch wie es mare_crisium gemacht hat mit zwei Buttons, es läuft nicht, egal wohin das

Delphi-Quellcode:

  if (Memo1.selLength > 0)
  then begin
    Memo1.SelAttributes.color := clBlue;
    Memo1.SelAttributes.style := [fsBold];
  end;

kommt.

[marabu]

Hallo Nils,

auch mit deinem Code würde, wenn er funktionieren würde, nur die erste Fundstelle markiert - du hast schließlich keine Schleife drin. Auch hast du die Bedingung für FindText() falsch abgeändert - nicht > 0 sondern >= 0 müsstes du abfangen. Die nächste Suche würde in deinem Code eine Stelle auslassen, so dass du direkt hintereinander stehende Fundstellen nicht erkennst. Ich habe keine weiteren Fehler gesucht, aber es können durchaus noch weitere in deinem Code stecken.

Delphi-Quellcode:

uses
  Types;

function 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 TDemoForm.FindButtonClick(Sender: TObject);
var
  ida: TIntegerDynArray;
  i: integer;
  sText: string;
begin
  sText := FindEdit.Text;
  ida := FindTextAll(RichEdit, sText, []);
  for i := Low(ida) to High(ida) do
    with RichEdit do
    begin
      SelStart := ida[i];
      SelLength := Length(sText);
      SelAttributes.Color := clBlue;
      SelAttributes.Style := [fsBold];
    end;
  RichEdit.SetFocus;
end;

Grüße vom marabu

[Nils_13]

Danke, allgemein läuft es jetzt, aber wenn ich etwas editiere, wird sText schwarz markiert, wie kann ich das noch verhindern. Aber sonsten schon mal danke

Es soll ja ein Highlighter werden, also habe ich in OnChange den Button aufruf drinnen.

[marabu]

Hallo Nils,

wenn du bestimmte Schlüsselwörter hervorheben möchtest, dann solltest du meinen Beispiel-Code nicht einsetzen, sonst wird ja für jedes Schlüsselwort der gesamte Text erneut durchsucht. Da ist ein Parser die einzig richtige Lösung. Nur über einen Parser erhältst du Kontextinformation, anhand der du entscheiden kannst, ob ein Schlüsselwort wirklich ein Schlüsselwort ist oder nur ein einfaches Literal.

marabu

[jim_raynor]

Zitat von Nils_13:

2. will ich es selber programmieren.

Vielleicht lernst ja irgendwann, dass man nicht alles in vernüftiger Form im vertretbaren Zeitaufwand alleine schafft. Mit einem TRichEdit wirst du nie eine angemessene Geschwindkeit erreichen. Teste es mit einer größeren Datei aus und du kannst nach jedem Tastendruck Kaffee trinken. Aber es ist deine Entscheidung.

Als Alternative zu Synedit gibts auch noch Scintella. Dieses benötigt aber eine DLL, die immer mitgeliefert werden muss.

[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.