...Rich-Text zu HTML konvertieren?

Cyrus · Beiträge: 56

Funktion stammt nicht von mir hab nur einwenig daran gebastelt:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:

Procedure RtfToHtml(contenthead:string; Source:TRichedit; Dest:TMemo);
var loop,loop2:integer; // Counter
    s,s2:string; // Strings, zur Bearbeitung
    fett,kursiv,us,bullet:boolean; // welche Attribute hatte das letzte Zeichen?
    Aktcolor:tColor; // aktuelle Farbe
    aktSize:integer; // aktuelle Schriftgröße
    AktLine:Integer; // welche Zeile bearbeiten wir
    Align1:TAlignment; // wie ist die Ausrichtung
    ReihenFolge:TList; // in welche Reihenfolge werden die Tags bearbeitet
     // 1= fett 
     // 2 = kursiv 
     // 3 = unterstrichen
     // 4 = Color 
     // 5 = Size
     // 6 = li 

function CalculateSize(pt:integer):integer;
begin 
  case pt of 
   0..7: result:=1;
   8..10: result:=2; 
   11..13: result:=3; 
   14..16: result:=4;
   17..20: result:=5; 
   21..24: result:=6; 
   else result:=7;
  end; 
end; // CalculateSize;

begin
   Source.Visible:=false;
   Source.Width:=32000; 

   Dest.Lines.Clear; 
   ReihenFolge:=TList.Create; 

   // der Header
   s:= 
   '<html><head><meta name="generator" content="'+contenthead+'"></head>'+
   '<body text="#000000" bgcolor="#FFFFFF" link="#FF0000"alink="#FF0000" vlink="#FF0000">'; 

   fett:=false; 
   kursiv:=false; 
   us:=false;
   bullet:=false; 

   // wieviele Zeichen insgesamt 
   Source.SelectAll; 
   loop2:=Source.SelLength; 

   // die Daten des ersten Zeichens herausfinden
   Source.SelLength:=1; 
   AktColor:=Source.SelAttributes.Color; 
   AktSize:=CalculateSize(Source.SelAttributes.Size); 
   Align1:=Source.Paragraph.Alignment; 

   // erstmal eine völlig willkürliche Reihenfolge festlegen 
   ReihenFolge.Add(Pointer(1));
   ReihenFolge.Add(Pointer(2)); 
   ReihenFolge.Add(Pointer(3)); 
   ReihenFolge.Add(Pointer(4)); 
   ReihenFolge.Add(Pointer(5)); 
   ReihenFolge.Add(Pointer(6));

   AktLine:=0; 

   // Die Fonteinstellungen des ersten Zeichens 
   s:=s+'<font size="'+IntToStr(aktsize)+'" color="#'+
   IntToHex(GetRValue(AktColor),2)+ 
   IntToHex(GetGValue(AktColor),2)+ 
   IntToHex(GetBValue(AktColor),2)+'">'; 

   // Der erste Paragraph 
   case Align1 of
    taLeftJustify:s:=s+'<p align="left">'; 
    taRightJustify:s:=s+'<p align="right">'; 
    taCenter:s:=s+'<p align="center">'; 
   end; 

   for loop:=0 to loop2 do
    begin 
     // immer das nächste zeichen 
     Source.SelStart:=loop; 
     Source.SelLength:=1; 

     // jetzt wird geschaut, ob sich etwas getan hat
     with Source.SelAttributes do 
      begin 

     // Testen, ob wir eine neue Zeile erreicht haben, wenn ja, 
     // dann entweder neuer Paragraph oder <br>
     if AktLine <> SendMessage (Source.Handle, EM_LINEFROMCHAR, 
                                Source.SelStart, 0) then 
      begin 
       // wenn wir in einer Aufzählung sind, dann wird durch eine neue 
       // Zeile diese immer abgeschlossen
       if bullet then 
        begin 
         s:=s+'</li>'; 
         bullet:=false; 

         ReihenFolge.Move(ReihenFolge.IndexOf(Pointer(6)),ReihenFolge.Count-1); 
         // wenn in der neuen Zeile nicht wieder eine Aufzählung ist, 
         // dann erstellen wir eine neue Zeile 
         if Source.Paragraph.Numbering <> nsBullet then 
          begin
          // Bevor wir in die neue Zeile wechseln, schließen wir alle offenen Tags 
          for loop2:=0 to ReihenFolge.Count-1 do 
           case Integer(Reihenfolge[loop2]) of 
            1: if fett then s:=s+'</b>'; 
            2: if kursiv then s:=s+'</i>';
            3: if us then s:=s+'</u>'; 
            4: s:=s+'</font>'; 
           end; // case 
          fett:=false; 
          kursiv:=false;
          us:=false; 

           s:=s+'<br>'; 
          end;
        end 
        else 
        begin 
         if Trim(Source.Lines[AktLine])='' then
         // wenn die nächste Zeile leer ist, dann fügen wir einen neuen Paragraphen 
         // ein, sonst nur ein <br> 
          begin 
          // Alle offenen Tags werden geschlosssen
           for loop2:=0 to ReihenFolge.Count-1 do 
            case Integer(Reihenfolge[loop2]) of 
             1: if fett then s:=s+'</b>'; 
             2: if kursiv then s:=s+'</i>';
             3: if us then s:=s+'</u>'; 
             4: s:=s+'</font>'; 
            end; // case 
           fett:=false;
           kursiv:=false; 
           us:=false; 
           s:=s+'</p>'; 
           Align1:=Source.Paragraph.Alignment; 
           case Align1 of
            taLeftJustify:s:=s+'<p align="left">'; 
            taRightJustify:s:=s+'<p align="right">'; 
            taCenter:s:=s+'<p align="center">'; 
           end; 
          end else s:=s+'<br>';

         end; // keine Aufzählung 
       AktLine:=SendMessage (Source.Handle, EM_LINEFROMCHAR, 
                             Source.SelStart, 0); 
      end; // neue Zeile 

       for loop2:=0 to ReihenFolge.Count-1 do 
        case Integer(ReihenFolge[loop2]) of 

         1: if fsBold in Style then 
              begin 
               if not fett then
                begin 
                 s:=s+'<b>'; 
                 fett:=true; 
                 ReihenFolge.Move(loop2,0); 
               end; 
              end else begin
               if fett then 
                begin 
                 s:=s+'</b>'; 
                 fett:=false; 
                 ReihenFolge.Move(loop2,ReihenFolge.Count-1);
                end; 
              end;

            2: if fsItalic in Style then 
                begin 
                 if not kursiv then
                  begin 
                   s:=s+'<i>'; 
                   kursiv:=true; 
                   ReihenFolge.Move(loop2,0);
                  end; 
                end else begin 
                 if kursiv then 
                  begin
                   s:=s+'</i>'; 
                   kursiv:=false; 
                   ReihenFolge.Move(loop2,ReihenFolge.Count-1); 
                  end; 
                end;

            3: if fsUnderline in Style then 
                begin 
                 if not us then 
                  begin
                   s:=s+'<u>'; 
                   us:=true; 
                   ReihenFolge.Move(loop2,0); 
                  end; 
                 end else begin
                  if us then 
                   begin 
                    s:=s+'</u>'; 
                    us:=false; 
                    ReihenFolge.Move(loop2,ReihenFolge.Count-1);
                   end; 
                 end; 

             4 : if Color<>aktcolor then 
                 begin
                  aktcolor:=color; 
                  s:=s+'</font><font size="'+ 
                  IntToStr(aktsize)+'" color="#'+ 
              IntToHex(GetRValue(AktColor),2)+ 
              IntToHex(GetGValue(AktColor),2)+ 
              IntToHex(GetBValue(AktColor),2)+'">';
                  ReihenFolge.Move(loop2,0); 
                end; 

             5: if CalculateSize(Size)<>aktSize then 
                 begin 
                  aktsize:=CalculateSize(size);
                  s:=s+'</font><font size="'+IntToStr(aktsize)+'">'; 
                  ReihenFolge.Move(loop2,0); 
                 end; 

             6: if Source.Paragraph.Numbering =nsBullet then 
                 begin
                  if not bullet then 
                   begin 
                    s:=s+'<li>'; 
                    bullet:=true; 
                    ReihenFolge.Move(loop2,0); 
                   end;
                 end else begin 
                  if bullet then 
                    begin 
                     s:=s+'</li>'; 
                     bullet:=false; 
                     ReihenFolge.Move(loop2,ReihenFolge.Count-1);
                   end; 
                  end; 

       end; // case 

      end; // with selattributes do 


      // jetzt wird erst mal alles gesäubert, was in der HTM-Datei nicht so nett
      // aussehen würde
      if source.SelText='"' then 
        s:=s+'"'
       else 
      if source.SelText='<' then 
        s:=s+'<' 
       else
      if source.SelText='>' then 
        s:=s+'>' 
       else 
      if source.SelText='ä' then
        s:=s+'ä' 
       else 
      if source.SelText='Ä' then
        s:=s+'Ä' 
       else 
      if source.SelText='ö' then
        s:=s+'ö' 
       else 
      if source.SelText='Ö' then 
        s:=s+'Ö'
       else 
      if source.SelText='ü' then 
        s:=s+'ü' 
       else 
      if source.SelText='Ü' then
        s:=s+'Ü' 
       else 
      if source.SelText='ß' then
        s:=s+'ß' 
       else
        s:=s+Source.SelText; 
    end; // jedes zeichen 

     // Zum Abschluß schließen wir die ganzen Tags nochmal 
     for loop2:=0 to ReihenFolge.Count-1 do 
      case Integer(Reihenfolge[loop2]) of
       1: if fett then s:=s+'</b>'; 
       2: if kursiv then s:=s+'</i>'; 
       3: if us then s:=s+'</u>';
       4: s:=s+'</font>'; 
       6: s:=s+'</li>'; 
      end; // case

      // der letzte Paragraph wird geschlossen 
    s:=s+'</p>';

   // jetzt leerzeichen raus 
   for loop:=100 downto 2 do
    begin 
     s2:=''; 
     for loop2:=1 to loop do
      s2:=s2+' '; 
     s:=StringReplace(s,s2,'<!--'+IntToStr(loop)+'-->', 
                       [rfReplaceAll,rfIgnoreCase]);
    end; 
   for loop:=100 downto 2 do 
    begin
     s2:=''; 
     for loop2:=1 to loop do 
      s2:=s2+' ';
     s:=StringReplace(s,'<!--'+IntToStr(loop)+'-->',s2, 
                       [rfReplaceAll,rfIgnoreCase]); 
    end;

   // jetzt sind wir fertig 
   s:=s+'</html>';

   Dest.Lines.Add(s); 
   Reihenfolge.free;

   Source.Width:=630; 
   Source.Visible:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RtfToHtml('Test Header',Richedit1,Memo1);
end;

Greetz Cyrus

Moderiert von UGrohne: Code- durch Delphi-Tags ersetzt

_________________
Wer glaub er ist, hört auf zu werden!
Delphi Rulez!!!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme