Richedit: Suche nach Attributen (z.B. fsBold)

[Dieter.Soergel]

Hallo,
ich suche nach einem schnelleren Verfahren um nach Attributen (Style, Fontsize ...) zu suchen.
Das Durchsuchen von 9000 Zeichen dauert ca. 20 Sekunden.
Ich verwende Delphi 10.4 CE.
Hier ein einfaches Beispiel, suche nach fsBold:

Code:

  
Repeat
    // Ist fsBold enthalten?
    LFound := TFontStyle.fsBold in rtfText.SelAttributes.Style;

    if LFound then
      Break; // fertig

    // nächstes Zeichen
    rtfText.SelStart := rtfText.SelStart + 1;
    rtfText.SelLength := 1;

until rtfText.SelStart = Length(rtfText.Text);

Hab im Web nichts gefunden, wie nach Formatierung gesucht werden kann.

Danke für Tipps!
Dieter

[Redeemer]

Zum bestehenden Code:

• 9000x Length(rtfText.Text) aufzurufen ist verdammt teuer! TRichEditStrings ist eine ganz schlechte Krücke, die irgendwie zwischen Plaintext (Eigenschaft Text), RTF (Methoden LoadFromFile, SaveToFile) und Speicherinhalt konvertiert. Das ist aus gutem Grund nur im implementation-Teil von ComCtrls.pas deklariert und nicht dokumentiert. Damit nach jedem Schleifendurchlauf den Plaintext zu generieren (Kompatibilität mit TCustomMemo), ist eben sehr teuer.
• Warum setzt du SelLength? Das verstehe ich nicht.

Idee für ein grundlegend anderes Verfahren für wirklich große Dateien: Teile und herrsche mit ConsistentAttributes. Das ist für Boole'sche Eigenschaften vermutlich einfacher zu implementieren als für andere. Dafür brauchst du dann natürlich SelLength. Und eine brauchbare Implementierung für ConsistentAttributes (Message EM_GETCHARFORMAT) in RichEd32, von der ich nicht weiß, ob sie existiert.

[jziersch]

Für diese Anwendung würde sich die Verwendung einer Komponente wie WPTools anbieten. Dort lassen sich für jedes Zeichen die Attribute direkt und sehr schnell ermitteln.

Diese Methode ist noch nicht mal optimiert, dennoch kommt ein Ergebnis bei ein paar 100.000 Zeichen sehr schnell.

Code:

   i := 0;
   WPRichText1.CPPosition := 0;
   repeat
      if WPRichText1.CPAttr.HasStyle(afsBold) then
           inc(i);
   until (not WPRichText1.CPMoveNext);
   ShowMessage(IntToStr(i) + ' chars');

[Dieter.Soergel]

Zitat von Redeemer:

Zum bestehenden Code:

• 9000x Length(rtfText.Text) aufzurufen ist verdammt teuer!
  ...
  
• Warum setzt du SelLength? Das verstehe ich nicht.

DANKE!
Length(rtfText.Text) war nicht bewusst, gab ich korrigiert.
SelLength hab ich entfernt.
Ist um Welten schneller.

Problem erst mal gelöst.

[Dieter.Soergel]

Zitat von jziersch:

Für diese Anwendung würde sich die Verwendung einer Komponente wie WPTools anbieten. Dort lassen sich für jedes Zeichen die Attribute direkt und sehr schnell ermitteln.

Das schau ich mir auf jedem Fall an.
Gute Idee, Danke.

[taaktaak]

Moin, Moin,
es geht in der Tat schneller. Meine Lösung wäre diese:

Delphi-Quellcode:

procedure InitCF2(var CF2:TCharFormat2;Mask:DWord);
begin
 FillChar(CF2,SizeOf(CF2),0);
 CF2.cbSize:=SizeOf(CF2);
 CF2.dwMask:=Mask
end;

procedure GetCharFormat(RE:TRichEdit;var CF2:TCharFormat2;Start,Length:LongInt);
var SelRange : TCharRange;
begin
 SelRange.cpMin:=Start;
 SelRange.cpMax:=Start+Length;
 RE.Perform(EM_ExSetSel,0,LParam(@SelRange));
 RE.Perform(EM_GetCharFormat,SCF_Selection,LParam(@CF2));
end;

var FOldEventMask : LongInt;

procedure BeginUpdate(RE:TRichEdit;LockEvents:Boolean=true);
begin
 if LockEvents then FOldEventMask:=SendMessage(RE.Handle,EM_SetEventMask,0,0); 
 SendMessage(RE.Handle,WM_SetRedraw,0,0)
end;

procedure EndUpdate(RE:TRichEdit;UnLockEvents:Boolean=true);
begin
 SendMessage(RE.Handle,WM_SetRedraw,1,0);                                     
 if UnlockEvents then SendMessage(RE.Handle,EM_SetEventMask,0,FOldEventMask )
end;

procedure TfoTest07.buFindPosClick(Sender:TObject);
var CF2               : TCharFormat2;
    i,SelStart,SelLen : Integer;
begin
 BeginUpdate(RE);

 laInfo.Caption:='';
 //InitAndStartTimer;

 SelStart:=RE.SelStart; // backup selection
 SelLen  :=RE.SelLength;

 InitCF2(CF2,CFM_Bold);
 for i:=1 to length(RE.Text) do begin
  GetCharFormat(RE,CF2,i,1);
  if cf2.dwEffects and cfm_Bold=cfm_Bold then begin laInfo.Caption:='Bold attribute found at '+IntToStr(i);
                                                    Break;
                                                    end;
  end;

 RE.SelStart :=SelStart; // restore selection
 RE.SelLength:=SelLen;

 if laInfo.Caption='' then laInfo.Caption:='No bold attribute found';
 //StopAndShowTimer;

 EndUpdate(RE);
 RE.SetFocus;
end;

Auf diese Weise findet sich die Positon in einem 65.535 Zeichen langen Richedit auf einem nicht sonderlich schnellen PC in etwa einer halben Sekunde, wenn die letzten Zeichen in BOLD formatiert sind.
Gruß Ralph