Шустрый
Профиль
Группа: Участник
Сообщений: 73
Регистрация: 24.9.2008
Репутация: нет
Всего: 1
|
Всё всем спасибки нашёл то что хотел!! кому интересно выкладую!!! На форме распологаем MEmo RichEdit OpenDialog и Savedialog | Код | unit main;
(*
rtf2html
(c) 2001 by Johannes Trдnkle ([email protected])
Dieses Programm konvertiert eine RTF-Datei in eine HTML-Datei.
Fьr nдhere Informationen verweise ich auf das Tutorial unter
www.delphi-source.de, fьr das dieses Programm erstellt wurde.
Sollte dieses Projekt irgendjemand weiterhelfen, so wдre ich
fьr einen kurzen Hinweis dankbar.
*)
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, Buttons, ExtCtrls;
type
TMainForm = class(TForm)
Panel1: TPanel;
SpeedButton1: TSpeedButton;
Source: TRichEdit;
Dest: TMemo;
Splitter1: TSplitter;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
begin
Source.Align:=alClient;
end;
procedure TMainForm.SpeedButton2Click(Sender: TObject);
begin
if OpenDialog.Execute then Source.Lines.LoadFromFile(OpenDialog.FileName);
end;
procedure TMainForm.SpeedButton3Click(Sender: TObject);
begin
if SaveDialog.Execute then Dest.Lines.saveToFile(SaveDialog.FileName);
end;
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цllig willkьrlich und wurde von mir so gewдhlt.
// Wer etwas anderes will, kann das hier дndern
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ц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 Align 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>';
Align:=Source.Paragraph.Alignment;
case Align 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+'<p align="center"> Erstellt mit rtf2html - © 2001 by Johannes Tränkle - für Delphi-source.de</p></body></html>';
Dest.Lines.Add(s);
Reihenfolge.free;
Source.Width:=630;
Source.Visible:=true;
end;
end.
|
|
RTF to HTML 
Загрузка ...
