Access中以文件流方式存储的RTF文件如何导出为HTML文件

procedure TMainForm.SpeedButton1Click(Sender: TObject);
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
 Align: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;
// Umrechung der Schriftgr鲞e in Pixel in ein HTML-Format
// Die Einteilung ist v鰈lig willk黵lich und wurde von mir so gew鋒lt.
// Wer etwas anderes will, kann das hier 鋘dern
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><title>'+OpenDialog.FileName+'</title><meta name="generator" content="Johannes'' rtf2html-Konverter"></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);
Align:=Source.Paragraph.Alignment; // erstmal eine v鰈lig willk黵liche 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+''; // Der erste Paragraph
case Align of
 taLeftJustify:s:=s+'';
 taRightJustify:s:=s+'';
 taCenter:s:=s+'';
end; for loop:=0 to loop2 do
 begin
 // immer das n鋍hste 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 
 if AktLine <> SendMessage (Source.Handle, EM_LINEFROMCHAR,
 Source.SelStart, 0) then
 begin
 // wenn wir in einer Aufz鋒lung 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鋒lung ist,
 // dann erstellen wir eine neue Zeile
 if Source.Paragraph.Numbering <> nsBullet then
 begin
 // Bevor wir in die neue Zeile wechseln, schlie遝n wir alle offenen Tags
 for loop2:=0 to ReihenFolge.Count-1 do
 case Integer(Reihenfolge[loop2]) of
 1: if fett then s:=s+'';
 2: if kursiv then s:=s+'';
 3: if us then s:=s+'';
 4: s:=s+'';
 end; // case
 fett:=false;
 kursiv:=false;
 us:=false; s:=s+' ';
 end;
 end
 else
 begin
 if Trim(Source.Lines[AktLine])='' then
 // wenn die n鋍hste Zeile leer ist, dann f黦en wir einen neuen Paragraphen
 // ein, sonst nur ein 
 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+'';
 2: if kursiv then s:=s+'';
 3: if us then s:=s+'';
 4: s:=s+'';
 end; // case
 fett:=false;
 kursiv:=false;
 us:=false;
 s:=s+'';
 Align:=Source.Paragraph.Alignment;
 case Align of
 taLeftJustify:s:=s+'';
 taRightJustify:s:=s+'';
 taCenter:s:=s+'';
 end;
 end else s:=s+' '; end; // keine Aufz鋒lung
 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+'';
 fett:=true;
 ReihenFolge.Move(loop2,0);
 end;
 end else begin
 if fett then
 begin
 s:=s+'';
 fett:=false;
 ReihenFolge.Move(loop2,ReihenFolge.Count-1);
 end;
 end; 2: if fsItalic in Style then
 begin
 if not kursiv then
 begin
 s:=s+'';
 kursiv:=true;
 ReihenFolge.Move(loop2,0);
 end;
 end else begin
 if kursiv then
 begin
 s:=s+'';
 kursiv:=false;
 ReihenFolge.Move(loop2,ReihenFolge.Count-1);
 end;
 end; 3: if fsUnderline in Style then
 begin
 if not us then
 begin
 s:=s+'';
 us:=true;
 ReihenFolge.Move(loop2,0);
 end;
 end else begin
 if us then
 begin
 s:=s+'';
 us:=false;
 ReihenFolge.Move(loop2,ReihenFolge.Count-1);
 end;
 end;

4 : if Color<>aktcolor then
 begin
 aktcolor:=color;
 s:=s+'';
 ReihenFolge.Move(loop2,0);
 end; 5: if CalculateSize(Size)<>aktSize then
 begin
 aktsize:=CalculateSize(size);
 s:=s+'';
 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鋟bert, was in der HTM-Datei nicht so nett
 // aussehen w黵de
 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遝n wir die ganzen Tags nochmal
 for loop2:=0 to ReihenFolge.Count-1 do
 case Integer(Reihenfolge[loop2]) of
 1: if fett then s:=s+'';
 2: if kursiv then s:=s+'';
 3: if us then s:=s+'';
 4: s:=s+'';
 6: s:=s+'</li>';
 end; // case // der letzte Paragraph wird geschlossen
 s:=s+''; // jetzt leerzeichen raus
for loop:=100 downto 2 do
 begin
 s2:='';
 for loop2:=1 to loop do
 s2:=s2+' ';
 s:=StringReplace(s,s2,'',[rfReplaceAll,rfIgnoreCase]);
 end;
for loop:=100 downto 2 do
 begin
 s2:='';
 for loop2:=1 to loop do
 s2:=s2+' ';
 s:=StringReplace(s,'',s2,[rfReplaceAll,rfIgnoreCase]);
 end; // jetzt sind wir fertig
s:=s+' Erstellt mit rtf2html - © 2001 by Johannes Tränkle - für Delphi-source.de</body></html>';

Dest.Lines.Add(s);
Reihenfolge.free; Source.Width:=630;
Source.Visible:=true;
end;

其中 Source, Dest 是兩個TMemo,
你將流讀到 Source 這個Memo中, 就可轉了!
或者不用Memo, 改成你自己想要的

to:aiirii(ari-爱的眼睛) ,请问你代码中的一些问号那里应该是什么啊，谢谢你了

http://www.hkiwc.com/html/special.html

调试易

Access中以文件流方式存储的RTF文件如何导出为HTML文件

解决方案 »