Peter Kiers
asked on
Save text as HTML
Dear experts,
When the a user choose Menu-item Test -> Test Fill Buf, the TImage-Canvas
will be filled with characters and numbers. Now I want to make another menu-
item called Send Mail, to copy the canvas to clipboard and paste it automaticly
in the body of the mail.
I have this procedure for opening the installed e-mail client:
procedure TForm1.SendMail1Click(Send er: TObject);
begin
ShellExecute(0, 'open', 'mailto:',
nil, nil, SW_SHOWNORMAL);
end;
And this is a procedure I made to select all text of the canvas:
procedure TForm1.SaveAsText;
var
i, j: integer;
s: string;
begin
s := '';
for i := 1 to SCRROWS do
begin
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
s := s + ScrBuf[i, j].Data;
if s <> '' then s := s + #13#10;
end;
with Clipboard do
begin
open;
astext := s;
close;
end;
end;
How can I get automaticly the text of the canvas in to the body of the mail
and display it exactly the same as the canvas?
I have put an example on my site: http://members.home.nl/peterkiers/
(beneath the Under Construction bar, you see a floppy disk)
Greetings,
Peter Kiers
When the a user choose Menu-item Test -> Test Fill Buf, the TImage-Canvas
will be filled with characters and numbers. Now I want to make another menu-
item called Send Mail, to copy the canvas to clipboard and paste it automaticly
in the body of the mail.
I have this procedure for opening the installed e-mail client:
procedure TForm1.SendMail1Click(Send
begin
ShellExecute(0, 'open', 'mailto:',
nil, nil, SW_SHOWNORMAL);
end;
And this is a procedure I made to select all text of the canvas:
procedure TForm1.SaveAsText;
var
i, j: integer;
s: string;
begin
s := '';
for i := 1 to SCRROWS do
begin
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
s := s + ScrBuf[i, j].Data;
if s <> '' then s := s + #13#10;
end;
with Clipboard do
begin
open;
astext := s;
close;
end;
end;
How can I get automaticly the text of the canvas in to the body of the mail
and display it exactly the same as the canvas?
I have put an example on my site: http://members.home.nl/peterkiers/
(beneath the Under Construction bar, you see a floppy disk)
Greetings,
Peter Kiers
ASKER
Oke, but their is one problem:
For example if the text is displayed on the canvas
like this:
A
B C
D E
F G
H I
In the body-part the text appears like this:
ABCDEFGHI
And it has to be exactly like it is displayed on the canvas, I think the only way to do that is save the
text as HTML.
Greetings,
Peter Kiers
For example if the text is displayed on the canvas
like this:
A
B C
D E
F G
H I
In the body-part the text appears like this:
ABCDEFGHI
And it has to be exactly like it is displayed on the canvas, I think the only way to do that is save the
text as HTML.
Greetings,
Peter Kiers
is it working
procedure TForm1.SendMail1Click(Send er: TObject);
var
i, j: integer;
s: string;
begin
s := '';
for i := 1 to SCRROWS do
begin
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
s := s + ScrBuf[i, j].Data;
if s <> '' then s := s +'%0a';
end;
ShellExecute(0, 'open', pchar('mailto:&Body='+ s),
nil, nil, SW_SHOWNORMAL);
end;
procedure TForm1.SendMail1Click(Send
var
i, j: integer;
s: string;
begin
s := '';
for i := 1 to SCRROWS do
begin
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
s := s + ScrBuf[i, j].Data;
if s <> '' then s := s +'%0a';
end;
ShellExecute(0, 'open', pchar('mailto:&Body='+ s),
nil, nil, SW_SHOWNORMAL);
end;
ASKER
YES, but the data will not be displayed correctly.
Peter.
Peter.
Is this OK for you
procedure TForm1.SendMail1Click(Send er: TObject);
var
i, j: integer;
s,CurLine: string;
function FilterTextAndAddNewLine(S: string):St ring;
var textFilter:TStringList;
NumOfBlankLinesAbove:Integ er;
i, j: integer;
begin
Result:='';
textFilter:=TStringList.Cr eate;
textFilter.Text:=S;
NumOfBlankLinesAbove:=0;
for i:=0 to textFilter.Count-1 do
begin
if textFilter.Strings[i]='' then inc(NumOfBlankLinesAbove)
else
begin
for j:=1 to NumOfBlankLinesAbove do Result:=Result+#13#10;
Result:=Result+textFilter. Strings[i] +#13#10;
NumOfBlankLinesAbove:=0;
end;
end;
textFilter.Text:=Result;
Result:='';
for i:=0 to textFilter.Count-1 do
begin
Result:=Result+textFilter. Strings[i] +'%0a';
end;
textFilter.Free;
end;
begin
s := '';
for i := 1 to SCRROWS do
begin
CurLine:='';
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
CurLine := CurLine + ScrBuf[i, j].Data
else if ScrBuf[i, j].Data=#0 then CurLine:=CurLine+' ';
s := s+TrimRight(CurLine) +#13#10;
end;
s:=FilterTextAndAddNewLine (s);
ShellExecute(0, 'open', pchar('mailto:&Body='+ s),
nil, nil, SW_SHOWNORMAL);
end;
procedure TForm1.SendMail1Click(Send
var
i, j: integer;
s,CurLine: string;
function FilterTextAndAddNewLine(S:
var textFilter:TStringList;
NumOfBlankLinesAbove:Integ
i, j: integer;
begin
Result:='';
textFilter:=TStringList.Cr
textFilter.Text:=S;
NumOfBlankLinesAbove:=0;
for i:=0 to textFilter.Count-1 do
begin
if textFilter.Strings[i]='' then inc(NumOfBlankLinesAbove)
else
begin
for j:=1 to NumOfBlankLinesAbove do Result:=Result+#13#10;
Result:=Result+textFilter.
NumOfBlankLinesAbove:=0;
end;
end;
textFilter.Text:=Result;
Result:='';
for i:=0 to textFilter.Count-1 do
begin
Result:=Result+textFilter.
end;
textFilter.Free;
end;
begin
s := '';
for i := 1 to SCRROWS do
begin
CurLine:='';
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
CurLine := CurLine + ScrBuf[i, j].Data
else if ScrBuf[i, j].Data=#0 then CurLine:=CurLine+' ';
s := s+TrimRight(CurLine) +#13#10;
end;
s:=FilterTextAndAddNewLine
ShellExecute(0, 'open', pchar('mailto:&Body='+ s),
nil, nil, SW_SHOWNORMAL);
end;
ASKER
Almost when i select Test -> Test Field On
and then select Menu-item Send Mail and use
your example I get this:
Field Test Screen
Default Reverse Blink Underline
Red: ABCabc123 ABCabc123 ABCabc123 ABCabc123
Pink: ABCabc123 ABCabc123 ABCabc123 ABCabc123
Green: ABCabc123 ABCabc123 ABCabc1
You see not it's not like the text on the canvas.
Greetings,
Peter Kiers
and then select Menu-item Send Mail and use
your example I get this:
Field Test Screen
Default Reverse Blink Underline
Red: ABCabc123 ABCabc123 ABCabc123 ABCabc123
Pink: ABCabc123 ABCabc123 ABCabc123 ABCabc123
Green: ABCabc123 ABCabc123 ABCabc1
You see not it's not like the text on the canvas.
Greetings,
Peter Kiers
ASKER
I am really gratefull that you will help me.
P.
P.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Oke, thank you for the help
500 points comming your way.
Greetings,
Peter Kiers
500 points comming your way.
Greetings,
Peter Kiers
var
i, j: integer;
s: string;
begin
s := '';
for i := 1 to SCRROWS do
begin
for j := 1 to SCRCOLS do
if (ScrBuf[i, j].Data in ['A'..'Z', 'a'..'z', '0'..'9', ' ',
',', '!', '@', '#', '$', '%', '^', '&', '*', '(', '[', ']', ')',
'<', '>', ';', ':', '=', '-', '.', '/', '\', '+', '"', '|']) then
s := s + ScrBuf[i, j].Data;
if s <> '' then s := s + #13#10;
end;
ShellExecute(0, 'open', pchar('mailto:&Body='+s),
nil, nil, SW_SHOWNORMAL);
end;