How to Convert Simple RichText to HTML tags in Delphi?

前端 未结 3 1977
自闭症患者
自闭症患者 2021-02-09 03:59

You may say that there are lots of discussions about this in stackOverflow, but most of them are more complicated than what I need and mostly for other languages.

I have

3条回答
  •  孤独总比滥情好
    2021-02-09 04:26

    After trying many different solutions which did not gave accurate results, I was inspired by this solution: Convert RTF to HTML and HTML to RTF.

    The idea is that TWebBrowser control (in design/edit mode) can handle and convert correctly Rich text format when it was pasted from the clipboard.

    uses SHDocVw, MSHTML;
    
    function ClipboardToHTML(AParent: TWinControl): WideString;
    var
      wb: TWebBrowser;
    
      function WaitDocumentReady: Boolean;
      var
        StartTime: DWORD;
      begin
        StartTime := GetTickCount;
        while wb.ReadyState <> READYSTATE_COMPLETE do
        begin
          Application.HandleMessage;
          if GetTickCount >= StartTime + 2000 then // time-out of max 2 sec
          begin
            Result := False; // time-out
            Exit;
          end;
        end;
        Result := True;
      end;
    begin
      Result := '';
      wb := TWebBrowser.Create(nil);
      try
        wb.Silent := True;
        wb.Width := 0;
        wb.Height := 0;
        wb.Visible := False;
        TWinControl(wb).Parent := AParent;
        wb.HandleNeeded;
        if wb.HandleAllocated then
        begin
          wb.Navigate('about:blank');
          (wb.Document as IHTMLDocument2).designMode := 'on';
          if WaitDocumentReady then
          begin
            (wb.Document as IHTMLDocument2).execCommand('Paste', False, 0);
            Result := (wb.Document as IHTMLDocument2).body.innerHTML;
          end;
        end;
      finally
        wb.Free;
      end;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      RichEdit1.SelectAll;
      RichEdit1.CopyToClipboard;
    
      ShowMessage(ClipboardToHTML(Self));
    end;
    

提交回复
热议问题