[Gelöst] String von exotischen Zeichen reinigen

[GLR]

Hallo!

Ich weiß, "exotische" Zeichen sind ein schwammiger Begriff.
Hier ein Beispiel:
Diese können z.B. in ein Memo aus der Zwischenablage einkopiert werden.
Bei Abfrage mit ORD ergeben sich dann Werte aus der ANSI-Tabelle.
Gibt es eine einfache Funktion, mit der ich solche Zeichen aus einem String (bzw. aus dem Memo) entfernen kann?

Grüße
Lothar

[theo]

Ja, das ist schwammig und eine "einfache" Funktion gibt es für schwammige Vorstellungen eher nicht.

In LCLUnicodeData (sicher in trunk) gibt es GetInfoForCodePoint. Beispiel:

Code: Alles auswählen

  ShowMessage(GetInfoForCodePoint('📉'));

Das zeigt dir, in welchem Unicode Zusammenhang sich das Zeichen befindet. Im Beispiel "Emoji & Pictographs | Supplementary Multilingual Plane | Miscellaneous Symbols and Pictographs"
Anhand dieser Information könntest du deine Frage präziser formulieren.

P.S. Als Orientierungshilfe kann auch die Zeichentabelle dienen (Bearbeiten -> Aus der Zeichentabelle einfügen. Ggf charactermap_ide_pkg installieren).

[kralle]

Moin,
willst Du nur diese Symbole finden und entfernen oder auch z.B. Chinesische und Griechische Buchstaben?
Wenn alles raus soll, dann den String Zeichen mit den erlaubten Zeichen vergleichen und z.B. durch Unterstriche ersetzen.

Gruß Kralle

[GLR]

Hallo Kralle,

genau das ist meine Frage:
Wie prüfe ich den String auf erlaubte Zeichen? Mit ORD und einem Zahlenbereich ( 0 - 255) geht es ja nicht. (Erlaubte Zeichen wären alle ANSI-Zeichen).

[theo]

Ein wenig solltest du dich mit Unicode befassen.
Ich habe dir hier mal ein recht allgemeines Beispiel gemacht.
Hier wird z. B. alles, was nicht im "Basic Multilingual Plane" ist rausgeworfen.
Beim Kommentar "Hier Filter" kann man auch andere Kriterien einsetzen.

Code: Alles auswählen

uses LazUTF8, LCLUnicodeData;

function CPBMPOnly(const AUTF8String: string): string;
var
  p: pchar;
  CharLen: integer;
  Cpc: cardinal;
  BlockIdx: integer;
begin
  Result := EmptyStr;
  p := PChar(AUTF8String);
  repeat
    Cpc := UTF8CodepointToUnicode(p, CharLen);
    for BlockIdx := Low(UnicodeBlocks) to High(UnicodeBlocks) do
      if (UnicodeBlocks[BlockIdx].S <= Cpc) and (UnicodeBlocks[BlockIdx].E >= Cpc) then
        //Hier Filter:
        if UnicodeBlocks[BlockIdx].PL = 0 then Result := Result + UnicodeToUTF8(Cpc);
    Inc(p, CharLen);
  until (CharLen = 0) or (Cpc = 0);
end;  

[Jorg3000]

Hi!
Endlich mal wieder mein Lieblingsthema: Strings und Unicode und UTF-8.

In der Unit Character gibt es Kategorien für Unicode-Zeichen, z.B. ucOtherSymbol für andere Symbole.
Falls das als Filter nicht ausreicht, kann man der Klammer: if Category in [...] weitere Kategorien hinzufügen.

Code: Alles auswählen

uses ... Character, LazUtf8;

function removeUnicodeSymbols(var s: String): Integer;
var
  i: Integer;
  currentChar: UnicodeString;
  Category: Character.TUnicodeCategory;
begin
  Result:=0;
  for i:=UTF8Length(s) downto 1 do
    begin
     currentChar := UTF8Copy(s,i,1);
     Category := GetUnicodeCategory(currentChar[1]);
     if Category in [TUnicodeCategory.ucOtherSymbol] then begin UTF8Delete(s,i,1); inc(Result); end;
   end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var s: String;
begin
  s:=Memo1.Text;
  if removeUnicodeSymbols({var}s) > 0 then Memo1.Lines.AddText(s);
end;

Grüße, Jörg

[GLR]

Ha, was für ein Spaß!
Ich habe Deine Routine, Jorg3000, genommen, und mit der Holzhammermethode alle ca. 29 Kategorien durchgespielt/herausgenommen.
Die "Übeltäter" habe ich dann mit TUnicodeCategory.ucSurrogate "erwischt" und vernichtet.

Vielen Dank auch für die Tips und Hilfen der anderen Poster.
Es ist schön, daß einem hier so schnell und gut geholfen wird!

Grüße
Lothar

[theo]

Beide Varianten (über Character oder LCLUnicodeData) können als Filter dienen.
Es ist nur nicht das Gleiche..
Bei Character bekommt man Informationen über den Typ des Zeichens (z.B. Buchstabe, Nummer, Satzzeichen etc.) während man mit LCLUnicodeData Informationen über die Zeichenbereiche bekommt (Chinesische Zeichen, kyrillische Zeichen, Symbole und Piktogramme etc).
Je nach Bedarf ist das eine oder das andere besser geeignet.

[theo]

Habe noch ein bisschen gespielt. Vielleicht hilft es ja irgendwann mal jemandem.
Dies ist die Kombination beider Varianten.
Diese Funktion entfernt alle Zeichen, die NICHT entweder Satz- oder Leerzeichen sind oder auf der Seite "Mathematical Operators" stehen.
Also aus 'bla,. blabla 1234 ∉∑∰≷≼⊑⋸⋶ b брый день' wird ',. ∉∑∰≷≼⊑⋸⋶ ' extrahiert.
Das kann man natürlich beliebig "weiterspinnen".

Code: Alles auswählen

uses LazUTF8, LCLUnicodeData, character, unicodedata;

function MathOpOnly(const AUTF8String: string): string;
const
  MY_CATEGORIES = [TUnicodeCategory.ucConnectPunctuation,
    TUnicodeCategory.ucDashPunctuation, TUnicodeCategory.ucOpenPunctuation,
    TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucInitialPunctuation,
    TUnicodeCategory.ucFinalPunctuation, TUnicodeCategory.ucOtherPunctuation,
    TUnicodeCategory.ucSpaceSeparator, TUnicodeCategory.ucLineSeparator,
    TUnicodeCategory.ucParagraphSeparator];
var
  p: pchar;
  CharLen: integer;
  Cpc: cardinal;
  BlockIdx: integer;
begin
  Result := EmptyStr;
  p := PChar(AUTF8String);
  repeat
    Cpc := UTF8CodepointToUnicode(p, CharLen);
    if TUnicodeCategory(GetProps(Cpc)^.Category) in MY_CATEGORIES then
      Result := Result + UnicodeToUTF8(Cpc)
    else
      for BlockIdx := Low(UnicodeBlocks) to High(UnicodeBlocks) do
        if (UnicodeBlocks[BlockIdx].S <= Cpc) and (UnicodeBlocks[BlockIdx].E >= Cpc) then
          //Hier Filter:
          if UnicodeBlocks[BlockIdx].PG = 'Mathematical Operators' then
            Result := Result + UnicodeToUTF8(Cpc);
    Inc(p, CharLen);
  until (CharLen = 0) or (Cpc = 0);
end;   

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := MathOpOnly('bla,. blabla 1234 ∉∑∰≷≼⊑⋸⋶ b брый день');
end;