products/sources/formale Sprachen/Delphi/Autor 0.7 image not shown  

Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: Sumbool.v   Sprache: Delphi

unit rtf2html;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
interface
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, StrUtils,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, UniRtf2HtmlUnit1;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure RichEditToHTML(RichEdit: TRichEdit; var strHTMLCode: string);
procedure HTMLToRichEdit(strHTMLCode: string; RichEdit: TRichEdit);
procedure GetLineBreak(var iBreakPos: integer;var strLine, strBreakChar: string;var CurrentParagraphFormat: TParagraphFormat);
procedure RemoveLineBreak(var strLine: string);
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
implementation
const
 skip:array[1..13] of String=
 ('
'
,
  '
  • ', '
  • '
    ,
      '

    ', '

    '
    ,
      '

    ',
      '

    ',
      '

    ',
      '

    ', '
    '
    ,
      '
    ',
      '
    ',
      '
    ');
    //------------------------------------------------------------------------------
    //
    //------------------------------------------------------------------------------
    procedure RichEditToHTML(RichEdit: TRichEdit; var strHTMLCode: string);
    var
      RTFString: TStringStream;
      strStream: string;
      UniRtf2Html: TUniRtf2Html;
    begin
      if RichEdit.Text <> '' then
      begin
        RichEdit.Text := Trim(RichEdit.Text);
        RTFString := TStringStream.Create(strStream);
        try
          UniRtf2Html := TUniRtf2Html.Create;
          try
            RichEdit.Lines.SaveToStream(RTFString);
            RTFString.Position := 0;
            strHTMLCode := UniRtf2Html.ConvertRtfToHtml(RTFString.ReadString(RTFString.Size));
          finally
            UniRtf2Html.Free;
          end;
        finally
          RTFString.Free;
        end;
      end;
    end;
    //------------------------------------------------------------------------------
    //
    //------------------------------------------------------------------------------
    procedure HTMLToRichEdit(strHTMLCode: string; RichEdit: TRichEdit);
    var
      iBreakPos, iPosCtrlCharStart, iPosCtrlCharEnd, iPrevLinesLength, i, j: integer;
      strLine, strCtrlChar, strBreakChar: string;ll,oct:integer;Buf:string;
      TextLayouts: array of record t:string;p:TAlignment;a:TTextFormat;end;
      CurrentTextFormat: TTextFormat;CurrentParagraphFormat: TParagraphFormat;
    begin
      // RichEdit.Clear;
      // Per regel de RichEdit vullen en opmaak toepassen.
      CurrentParagraphFormat.Itemize.IsItemized := False;
      CurrentParagraphFormat.CurrentAlign := Left;
      RichEdit.Paragraph.Alignment:=taLeftJustify;
      // convert octals like “
      ll:=1;
      while ll<Length(strHTMLCode)-3 do begin
        if (strHTMLCode[ll]='&'and (strHTMLCode[ll+1]='#')
        and (strHTMLCode[ll+2] in ['0','1','2']) then begin
          Buf:=MidStr(strHTMLCode,ll,6);
          oct:=(ord(Buf[3])-ord('0'))*100+(ord(Buf[4])-ord('0'))*10+(ord(Buf[5])-ord('0'));
          strHTMLCode := StringReplace(strHTMLCode, Buf, chr(oct), [rfReplaceAll]);
          ll:=ll+3;
         end;
        ll:=ll+1;
      end;

      UniRtf2Html.SpecialChars(strHTMLCode,true);

      strLine := strHTMLCode;

      GetLineBreak(iBreakPos, strLine, strBreakChar, CurrentParagraphFormat);

      iPrevLinesLength := 0;
      CurrentTextFormat.Bold := Neutral;
      CurrentTextFormat.Italic := Neutral;
      CurrentTextFormat.Underline := Neutral;

      while iBreakPos <> 0 do begin
        if iBreakPos=-1 then begin
          iBreakPos:=0;
          //strHTMLCode:='';
        end else begin
          strHTMLCode := Copy(strHTMLCode, iBreakPos + Length(strBreakChar), Length(strHTMLCode));
        end;
        // De tekstregel in strLine zetten:
        // De huidige regel van strHTMLCode afknippen:
        i := 0;
        SetLength(TextLayouts, i);
        iPosCtrlCharStart := Pos('<', strLine);
        if iPosCtrlCharStart <> 1 then begin
          // De HTML-code begint niet een controlchar; het eerste deel van
          // de text heeft geen opmaak.
          SetLength(TextLayouts, i + 1);
          TextLayouts[i].t := Copy(strLine, 1, iPosCtrlCharStart - 1);
          TextLayouts[i].p := Left;
          TextLayouts[i].a.Bold := Neutral;
          TextLayouts[i].a.Italic := Neutral;
          TextLayouts[i].a.Underline := Neutral;
          strLine := Copy(strLine, iPosCtrlCharStart, Length(strLine));
          inc(i);
        end;
        // iPosCtrlCharStart = 1 in strLine
        iPosCtrlCharEnd := Pos('>', strLine);
        while iPosCtrlCharEnd > 0 do begin
          SetLength(TextLayouts, i + 1);
          strCtrlChar := Copy(strLine, 2, iPosCtrlCharEnd - 2);
          strLine := Copy(strLine, iPosCtrlCharEnd + 1, Length(strLine));
          iPosCtrlCharStart := Pos('<', strLine);
          if iPosCtrlCharStart > 0 then begin
            TextLayouts[i].t := Copy(strLine, 1, iPosCtrlCharStart - 1);
            strLine := Copy(strLine, iPosCtrlCharStart, Length(strLine));
          end else begin
            // Geen controlchars meer; rest van strLine toevoegen:
            TextLayouts[i].T := strLine;
            strLine := '';
          end;
          // Opmaak toepassen:
          TextLayouts[i].a.Bold := Neutral;
          TextLayouts[i].a.Italic := Neutral;
          TextLayouts[i].a.Underline := Neutral;

          if strCtrlChar = 'b' then
            TextLayouts[i].a.Bold := Activate;
          if strCtrlChar = '/b' then
            TextLayouts[i].a.Bold := Deactivate;
          if strCtrlChar = 'i' then
            TextLayouts[i].a.Italic := Activate;
          if strCtrlChar = '/i' then
            TextLayouts[i].a.Italic := Deactivate;
          if strCtrlChar = 'u' then
            TextLayouts[i].a.Underline := Activate;
          if strCtrlChar = '/u' then
            TextLayouts[i].a.Underline := Deactivate;

          iPosCtrlCharEnd := Pos('>', strLine);

          inc(i);
        end;
        if Length(strLine) > 0 then
        begin
          SetLength(TextLayouts, i + 1);
          TextLayouts[i].T := strLine;
          TextLayouts[i].a.Bold := Neutral;
          TextLayouts[i].a.Italic := Neutral;
          TextLayouts[i].a.Underline := Neutral;
        end;

        strLine := '';
        for i := Low(TextLayouts) to High(TextLayouts) do
        begin
          strLine := strLine + TextLayouts[i].t;
        end;
        RichEdit.Lines.Add(strLine);

        //RichEdit.Paragraph.Alignment := CurrentParagraphFormat;

        if CurrentParagraphFormat.Itemize.IsItemized and
          (RichEdit.Paragraph.Numbering = nsNone) then
          RichEdit.Paragraph.Numbering := nsBullet;
        if (not CurrentParagraphFormat.Itemize.IsItemized) and
          (RichEdit.Paragraph.Numbering = nsBullet) then
          RichEdit.Paragraph.Numbering := nsNone;

        j := 0;
        for i := Low(TextLayouts) to High(TextLayouts) do
        begin
          if (TextLayouts[i].a.Bold = Activate) then
            CurrentTextFormat.Bold := Activate;
          if (TextLayouts[i].a.Bold = Deactivate) then
            CurrentTextFormat.Bold := Deactivate;

          if (TextLayouts[i].a.Italic = Activate) then
            CurrentTextFormat.Italic := Activate;
          if (TextLayouts[i].a.Italic = Deactivate) then
            CurrentTextFormat.Italic := Deactivate;

          if (TextLayouts[i].a.Underline = Activate) then
            CurrentTextFormat.Underline := Activate;
          if (TextLayouts[i].a.Underline = Deactivate) then
            CurrentTextFormat.Underline := Deactivate;

          RichEdit.SelStart := j + iPrevLinesLength;
          RichEdit.SelLength := Length(TextLayouts[i].T);

          if (CurrentTextFormat.Bold = Activate) and
            not (fsBold in RichEdit.SelAttributes.Style) then
            RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsBold];
          if (CurrentTextFormat.Bold = Deactivate) and
            (fsBold in RichEdit.SelAttributes.Style) then
            RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsBold];

          if (CurrentTextFormat.Italic = Activate) and
            not (fsItalic in RichEdit.SelAttributes.Style) then
            RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsItalic];
          if (CurrentTextFormat.Italic = Deactivate) and
            (fsItalic in RichEdit.SelAttributes.Style) then
            RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsItalic];

          if (CurrentTextFormat.Underline = Activate) and
            not (fsUnderline in RichEdit.SelAttributes.Style) then
            RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsUnderline];
          if (CurrentTextFormat.Underline = Deactivate) and
            (fsUnderline in RichEdit.SelAttributes.Style) then
            RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsUnderline];

          j := j + sizeof(TextLayouts[i]);
        end;
        iPrevLinesLength := Length(RichEdit.Text);

        strLine := strHTMLCode;
        if iBreakPos > 0 then
          GetLineBreak(iBreakPos, strLine, strBreakChar, CurrentParagraphFormat);
      end;
    end;
    //------------------------------------------------------------------------------
    //
    //------------------------------------------------------------------------------
    procedure RemoveLineBreak(var strLine: string);
    const
     bold:array[1..2] of String=('''');
    var i: integer;
    begin
      for i := 1 to length(skip) do strLine := StringReplace(strLine, skip[i], '', [rfReplaceAll]);
      for i := 1 to length(bold) do strLine := StringReplace(strLine, bold[i], '', [rfReplaceAll]);
    end;
    //------------------------------------------------------------------------------
    //
    //------------------------------------------------------------------------------
    procedure GetLineBreak(var iBreakPos: integer;var strLine, strBreakChar: string;
                           var CurrentParagraphFormat: TParagraphFormat);
    var
      i, j: integer;
      str1: string;
      IsOk: boolean;
    begin
      iBreakPos := 0;
      for i := 1 to length(skip) do begin
        j := Pos(skip[i], strLine);
        if j > 0 then
        begin
          if iBreakPos = 0 then begin
            iBreakPos := j
          end else begin
            if j < iBreakPos then iBreakPos := j;
          end;
        end;
      end;
      str1 := Copy(strLine, iBreakPos, Length(strLine));
      if iBreakPos > 0 then
        strLine := Copy(strLine, 1, iBreakPos - 1)
      else iBreakPos := -1;
      strBreakChar := '';
      IsOk := True;
      while IsOk do begin
        IsOk := False;
        for i := 1 to length(skip) do begin
          if Pos(skip[i], str1) = 1 then begin
            if (skip[i] <> '
    '
    or (Length(strBreakChar) = 0) then
              strBreakChar := strBreakChar + skip[i];
            str1 := Copy(str1, Length(skip[i]) + 1, Length(str1));
            if skip[i] <> '
    '
     then
              IsOk := True;
            if skip[i] = '

    '
     then
              CurrentParagraphFormat.CurrentAlign := Left;
            if skip[i] = '
  • then
              CurrentParagraphFormat.Itemize.IsItemized := True;
            if skip[i] = '
  • '
     then
              CurrentParagraphFormat.Itemize.IsItemized := False;
            if skip[i] = '

    then begin
              CurrentParagraphFormat.CurrentAlign := Left;
              IsOk := True;
            end;
            if skip[i] = '

    then begin
              CurrentParagraphFormat.CurrentAlign := Center;
              IsOk := True;
            end;
            if skip[i] = '

    then  begin
              CurrentParagraphFormat.CurrentAlign := Right;
              IsOk := True;
            end;
          end;
        end;
      end;
    end;
    //------------------------------------------------------------------------------
    //
    //------------------------------------------------------------------------------
    end.


    ¤ Dauer der Verarbeitung: 0.22 Sekunden  (vorverarbeitet)  ¤





    Download des
    Quellennavigators
    Download des
    sprechenden Kalenders

    in der Quellcodebibliothek suchen




    Haftungshinweis

    Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.


    Bemerkung:

    Die farbliche Syntaxdarstellung ist noch experimentell.


    Bot Zugriff