Ich wollte mehre verschiedene Wörter in einem RichEdit markieren. "Er" macht aber immer nur das erste Suchwort (zwar im ganzen Text), aber keine weiteren? Gibst da irgendeinen Trick? (Nur falls Zeit und Lust so während dem Fußball)

zusammenfalten · markieren

Delphi-Quellcode:

function TFindSourceMainForm.RichEditPos(const S: string): integer;
begin
  if WholeWordsCheckBox.Checked then
    Result := TStrUtils.WordPos(FSubStr, S)
  else
    Result := TStrUtils.Pos(FSubStr, S);
end;

procedure TFindSourceMainForm.HighlightResults;
var
  I, J, APos, ACount, K, SubStrCount: Integer;
  ARichEdit: TRichEdit;
begin
  for I := 0 to PageControl.PageCount - 1 do
  begin
    ACount := 0;
    ARichEdit := RichEdit(I);
    ARichEdit.Lines.BeginUpdate;
    try
      if GraphicObjectTypesCheckBox.Checked then
        SubStrCount := FGraphicObjectTypes.Count
      else
        SubStrCount := 1;
      for K := 0 to SubStrCount - 1 do // ***
      begin
        if GraphicObjectTypesCheckBox.Checked then
          FSubStr := FGraphicObjectTypes[K];
        for J := 0 to ARichEdit.Lines.Count - 1 do
        begin
          APos := RichEditPos(ARichEdit.Lines[J]);
          if APos > 0 then
          begin
            ARichEdit.SelStart := ACount + APos - 1;
            ARichEdit.SelLength := Length(FSubStr);
            ARichEdit.SelAttributes.Color := clBlack;
            ARichEdit.SelAttributes.Style := [fsBold];
          end;
          ACount := ACount + Length(ARichEdit.Lines[J]) + 2; // 2 = Zeilenumbruch;
          if FCancel then
            Exit;
        end;
      end;
    finally
      ARichEdit.Lines.EndUpdate;
      ARichEdit.SelStart := 0;
      ARichEdit.SelLength := 0;
    end;
  end;
end;

Was sagt denn der Debugger?
* Geht der Code mehrmals in if APos > 0 then rein?
* Wenn ja, was passiert da drin? (die Variablen/Positionen)

Soll wirklich immer nur das erste jeweilige Wort pro Zeile behandelt werden?
Wenn nicht, dann ist es erst Recht einfacher über den gesamten Text zu suchen (PosEx und Co.)

Zitat:

// 2 = Zeilenumbruch;

Wer behauptet das?

Und ich bezieh mich nichmal auf iOS/Android, wo auch noch sows wie APos > 0 falsch wäre, da Strings nicht mehr mit Index 1 beginnen.
Ich weiß nicht mehr genau seit wann, aber spätestens in D2009 wurde das Richedit auf eine neuerere API-Version umgestellt und seitdem sind intern die Zeilenumbrüche auf #13 (Mac), seitens der WinAPI und auch im SelStart/SelLength, auch wenn man blöder Weise nur im .Text das durch sLineBreak (#13#10 im Windows) ersetzt wird, was dann falsche Positionen erzeugt, wenn man die Position im String 1:1 auf SelStart anwendet. :doppel-wall:

Wenn du die anhand der Zeilenposition die gesamtposition haben willst, dann solltest du die WinAPI fragen.

APos findet alle. Die 2 stimmt auch. Es ist mir ein Rätsel?

Achso, jetzt weiß ich was du meinst, Klar da sollte man auch ein PosEx mit While Schleife draus machen. Löst aber das problem nicht.

Ich hab mir den Algo jetzt mal näher angeschaut. Kann so nicht funktionieren. Vergiss es. Sorry. #schäm#

Wenn du magst kannst du ja mal das durchlaufen lassen und kur Bescheid geben ob das auch für > D2007 jeht?. Thanx!

zusammenfalten · markieren

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FSelList: TStringList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure Highlight(RichEdit: TRichEdit;
  SelList: TStrings; SelColor: TColor; SelStyle: TFontStyles);
var
  I, J, Pos, Index: Integer;
begin
  RichEdit.Lines.BeginUpdate;
  try
    Index := 0;
    for I := 0 to RichEdit.Lines.Count - 1 do
    begin
      for J := 0 to SelList.Count - 1 do
      begin
        Pos := PosEx(SelList[J], RichEdit.Lines[I], 1);
        while Pos > 0 do
        begin
          RichEdit.SelStart := Index + Pos - 1;
          RichEdit.SelLength := Length(SelList[J]);
          RichEdit.SelLength := Length(SelList[J]);
          RichEdit.SelAttributes.Color := SelColor;
          RichEdit.SelAttributes.Style := SelStyle;
          Pos := PosEx(SelList[J], RichEdit.Lines[I], Pos + 1);
        end;
      end;
      Index := Index + Length(RichEdit.Lines[I]) + Length(sLineBreak);
    end;
  finally
    RichEdit.Lines.EndUpdate;
    RichEdit.SelStart := 0;
    RichEdit.SelLength := 0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.Font.Color := clLtGray;

  RichEdit1.Lines.Add('+++ Liveticker Deutschland gegen Algerien +++');
  RichEdit1.Lines.Add('Löw ist restlos bedient - wie reagiert er?');
  RichEdit1.Lines.Add('Deutschland, der klare Favorit im WM-Achtelfinale? Denkste!');
  RichEdit1.Lines.Add('Algerien ist überlegen, hat viele Großchancen.');
  RichEdit1.Lines.Add('Deutschland spielt unsicher und konfus.');
  RichEdit1.Lines.Add('Löw ist restlos bedient - hat er ist einen Plan?');
  RichEdit1.Lines.Add('Verfolgen Sie die Partie im Liveticker.');

  FSelList.Clear;
  FSelList.Add('Löw');
  FSelList.Add('ist');
  FSelList.Add('Liveticker');

  Highlight(RichEdit1, FSelList, clBlack, [fsBold]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FSelList := TStringList.Create;
  // RichEdit1.HideSelection := false;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FSelList.Free;
end;

Unter XE laufen lassen (siehe Screenshot).

Gut. Dann ist Length(sLineBreak) um 1 falsch (zu groß). Was ist denn bei dir Length(sLineBreak)?

Erwartungsgemäß 2. Allerdings glaube ich, dass das RichEdit in Delphi XE ziemlich verbuggt ist, ich hatte mit ähnlichen Routinen auch schon schier unlösbare Probleme.

Ok. Danke. Ich glaub ich wird mir erst dann eine neue Delphiversion holen wenn es einen Compilerschalter $Ansistrings gibt.

Also im Klartext nie