HTML Editor -> Automatisch ein schliessendes Tag hinzufügen!

[Lannes]

Hallo,

etwas zum erweitern, verbessern :
was u.a. noch fehlt:
-prüfen ob Tag im nachfolgenden Text schon geschlossen wurde
-erzeugen von leeren Taggerüsten verhindern'<></>'
-Groß-/Kleinschreibung der Tags

Delphi-Quellcode:

function SetEndTag(aMemo: TMemo): Boolean;
const NoTagEnd = 'br,hr,img';//Tag abschließen nicht erforderlich
var iTagBegin,z : Integer;
    c : Char;
    sTag : String;
begin
  Result := False;
  with aMemo do
    begin
    //ist Tag eingegeben und wo beginnt er ?
    for z := SelStart downto 1 do
      begin
      c := Text[z];
      if c = '>' then//es wurde zuvor kein Tag geöffnet
        Break
        else
          if c = '<' then//aha, hier beginnt eingegebener Tag
            begin
            Result := True;
            iTagBegin := z;
            end;
      end;
    //ist es ein Kommentar-Tag '<!---' ?
    if Text[iTagBegin+1] = '!' then
      Result := False;

    if Result then
      begin
      //eingegebenen Tag ermitteln
      for z := iTagBegin to SelStart do
        begin
        c := Text[z];
        if c in ['a'..'z','A'..'Z'] then
          sTag := sTag+c
          else
            if c = ' ' then//ist Leerzeichen, dann folgen Tag-Attribute
            Break;
        end;
      //abschließender Tag erforderlich ?
      if Pos(LowerCase(sTag),NoTagEnd) = 0 then
        begin
        SelText := '></'+sTag+'>';
        SelStart := SelStart-Length(sTag)-3;
        end
        else
          Result := False;
      end;
    end;
end;

Der Aufruf:

Delphi-Quellcode:

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = '>' then
    if SetEndTag(Memo1) then
      Key := #0;//sonst wird Zeichen doppelt eingetragen
end;