If you need to go any further the MSHTML option is not at all hard to
implement. As far as I can determine you can keep to a basic core
functionality that reaches back as far as IE5 (or even IE4 if you must).
Also the Mozzilla Component is becoming much more Delphi friendly and can
ship as as component apart from the whole distribution - I have been
recently given to understand. I have not attempted this yet but am looking
into it incase MS becomes too "in house" under .NET. Further this would
release the MS MSHTML version concern.
Much much more than shown here can be achieved with just a little more
effort.
Use TembeddedWB from the Euromind site instead of TWebBrowser that ships
with later Delphis. Throw in MSHTML_TLB OleCtrls, SHDocVw_TLB, EmbeddedWB,
{depending on your delphi} ComCtrls, ComObj and placing the TEmbeddedWB
should add anything else needed, possibly add ActiveX for earlier versions
of Delphi.
(see There is a Yahoo Group on the topic.
http://groups.yahoo.com/group/delphi-webbrowser/
(TEmbeddedWB the better replacement for TWebBrowser which can both be used
virtually for some aspects of mass production drops from databases. See
http://www.euromind.com/iedelphi/embeddedwb.htm) handles printing pages
setup , saving , opening loadfrom Stram string etc .. and I think now print
preview and a host of other issues.
Undo and Redo are little bit more exotic, coverd at end of this posting.
For a WYSIWYG direct HTML editor, try this.
==================================
You can make normal toolbar ( and or Menu) with Word processing style
buttons and do direct implementations of the properly worded button hints,
even avoiding all IHTMLdahdah with olevariant based code no more difficult
than the following. Where TemailFax is just an average form, faxEmailDoc is
a TEmbededWB, Toolbar Button Hints are
Underline
Italic
Bold
Delete
Cut
Copy
Paste
Select All
Justify Right
Justify Left
Justify Center
Justify Full
Remove Format
Indent
Outdent
Insert Horizontal Rule
Insert Paragraph
There is a list of possible commands in (and I am looking at the MSDN 2001
April edition)
mk:@MSITStore:c:\Documents%20and%20Settings\All%20Users\Documents\Program%20
Files\Microsoft\Microsoft%20Visual%20Studio\MSDN\2001APR\1033\
inet.chm::/workshop/author/dhtml/reference/commandids.htm
//=================================================================
PROCEDURE TemailFax.ToolButtonPlainClick(Sender: TObject);
var cmd :string;
begin
//using hint string as command verb so first remove all spaces from hint
string
if (sender is TToolButton) then
CMD :=stringreplace((Sender as TToolButton).Hint,#32,'',[rfreplaceall])
else
if (sender is Tmenuitem) then
CMD :=stringreplace((Sender as Tmenuitem).caption,#32,'',[rfreplaceall]);
// for Delphi 7 menus that can auto add an ampersaand for underline effect
CMD :=stringreplace(CMD,'&','',[rfreplaceall]);
if returnSelect.queryCommandEnabled(CMD) then // checks for availablity of
command first
//like type could be used elsewhere to set state of button
// queryCommandValue from memory
returnSelect.execCommand(CMD,false,true);
end;
//=================================================================
FUNCTION TemailFax.returnSelect:olevariant;
var selected :olevariant;
begin
selected :=
faxDoc.OleObject.document.selection.createRange;
returnSelect := selected;
end;
//=================================================================
//UNDO AND REDO FOLLOW
PROCEDURE TemailFax.toolButtonUndoClick(Sender: TObject);
var
vaIn , vaOut :olevariant;
begin
faxdoc.InvokeCMD(FALSE, OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT, vaIn,
vaOut);
end;
PROCEDURE TemailFax.ToolButtonRedoClick(Sender: TObject);
var
vaIn , vaOut :olevariant;
begin
faxdoc.InvokeCMD(FALSE, OLECMDID_REDO, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut)
;
end;
Font size and font face and image insertion have to be handled seperately.
(unit MSHTML_stuff is given below it handles basic OLevariant use of
TWebBrowser and TEmbeddedWB. allows for direct handling of selected browser
display as root HTML. retrieve, and paste back.
one way of doing it as it allows the toolbar button with the Hint: Remove
Format
to clear the fonting. Appears to remove anything at all placed using the
FONT tag. Faint name may be handled the same way.
procedure TemailFax.COurierFontSizeClick(Sender: TObject); //drop down
preset.
begin
mshtml_stuff.selPasteHtml(faxDoc,
'<font style="FONT-SIZE:'+COurierFontSize.text+'pt">'
+ mshtml_stuff.selHtml(faxDoc)+'</font>');
end;
Inserting image (standard Outlook Express type no picture graphic locator)
is a button with this hint
Insert Image
Use this procedure:
procedure TemailFax.ToolButtonTrueNullClick(Sender: TObject);
var CMD :string;
begin
CMD :=stringreplace((Sender as TToolButton).Hint,#32,'',[rfreplaceall]);
if returnSelect.queryCommandEnabled(CMD) then
returnSelect.execCommand(CMD,true,NULL);
end;
===========MSHTML_STUFF.PAS very simplistic but also simply effective -
designed for both TWebBrowser TEmbeddedWB
unit mshtml_stuff;
{ This unit provides simple functions and procedures to enable simple
editing
functions on a TwebBrowser or TembededdWB component which is being used
for
interactive editing.
Each of the routines is briefly explained in the body of the unit.
Please use if useful, I've taken all care but all the responsability for
using this
unit is yours.
GNU license.
Paul A Norman http://PaulANorman.com [EMAIL PROTECTED] }
interface
uses
SysUtils,comctrls, classes, menus, SHDocVw_TLB, mshtml_tlb, EmbeddedWB,
jpeg, clipbrd,
graphics, dialogs;
{below is not developed yet}
type
THtmlTags = class(tcomponent)
public
crLf : string;
tblTDclosed :string; tblTDOpening :string; tblTDClosing :string;
tblTRclosed : string; tblTROpening : string; tblTRClosing :
string;
tblTHclosed : string; tblTHOpening : string; tblTHClosing :
string;
tblTBodyClosed : string; tblTBodyOpening : string; tblTBodyClosing
: string;
tblTHeadClosed :string; tblTHeadOpening :string; tblTHeadClosing
:string;
tblTFootClosed : string; tblTFootOpening : string; tblTFootClosing
: string;
tblTableClosed :string; tblTableOpening :string; tblTableClosing
:string;
tbl5colsx3rows : string;
constructor setup;
destructor finished;
private
protected
end;
function returnAllHtml(editor:tembeddedWB):string ; overload;
function returnAllHtml(editor:twebbrowser):string ; overload;
procedure saveAllHtmlTo(editor:tembeddedWB; fileName :string;
JpgQuality100Max : integer) ; overload;
procedure saveAllHtmlTo(editor:twebbrowser; fileName :string;
JpgQuality100Max : integer) ; overload;
function editable(editor:tembeddedWB) : string; overload;
function editable(editor:twebbrowser) : string; overload;
procedure makeEditable(editor:tembeddedWB); overload;
procedure makeEditable(editor:twebbrowser); overload;
procedure selPasteHtml(editor:twebbrowser;HTML :string); overload;
procedure selPasteHtml(editor:tembeddedWB;HTML :string); overload;
function selHtml(editor:twebbrowser) :string; overload;
function selHtml(editor:tembeddedWB) :string; overload;
function selText(editor:tembeddedWB) :string; overload;
function selText(editor:twebbrowser) :string; overload;
function selTextRange(editor:twebbrowser) : olevariant; overload;
function selTextRange(editor:tembeddedWB) : olevariant; overload;
function selSelection(editor:twebbrowser):olevariant; overload;
function selSelection(editor:tembeddedWB):olevariant; overload;
function selBodyRange(editor:twebbrowser):olevariant; overload;
function selBodyRange(editor:tembeddedWB):olevariant; overload;
procedure selCurrentTag(editor:tembeddedWB); overload;
procedure selCurrentTag(editor:twebbrowser); overload;
function selType(editor:tembeddedWB) :string; overload;
function selType(editor:twebbrowser) :string; overload;
procedure ToolButtonPlainClick(editor:tembeddedWB;Sender: TObject);overload;
procedure ToolButtonPlainClick(editor:twebbrowser;Sender: TObject);overload;
function returnSelect(editor:tembeddedWB):olevariant; overload;
function returnSelect(editor:twebbrowser):olevariant; overload;
procedure convertBmptoJpg( filename:string; const quality100Max :integer);
function plainPath(path:string):string;
var
currentTag:olevariant;
const
docType = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN">';
crLf = #13#10;
tblTD ='<TD> </TD>'; tblTDa ='<TD>'; tblTDz ='</TD>';
tblTR = '<TR> </TR>'; tblTRa = '<TR>'; tblTRz = '</TR>';
tblTH = '<TH> </TH>'; tblTHa = '<TH>'; tblTHz = '</TH>';
tblTBody = '<TBODY></TBODY>'; tblTBodya = '<TBODY>'; tblTBodyz =
'</TBODY>';
tblTHead ='<THEAD></THEAD>'; tblTHeada ='<THEAD>'; tblTHeadz
='</THEAD>';
tblTFoot = '<TFOOT></TFOOT>'; tblTFoota = '<TFOOT>'; tblTFootz =
'</TFOOT>';
tblTable ='<TABLE></TABLE>'; tblTablea ='<TABLE>'; tblTablez
='</TABLE>';
tbl5x3 = {tblTablea} '<TABLE border=1 rules=all frame=box
bgcolor=lightBlue>' +crLf
+ tblTHead +crLf
+ tblTBodya + crlf
+ tblTra +tblTH +tblTH +tblTH +tblTH +tblTH +tblTH
+tblTrz+crlf
+ tblTra +tblTd +tblTd +tblTd +tblTd +tblTd +tblTd
+tblTrz+crlf
+ tblTra +tblTd +tblTd +tblTd +tblTd +tblTd +tblTd
+tblTrz+crlf
+ tblTbodyz + crlf
+ tblTFoot + crLf
+ tblTablez;
implementation
// if you use tool buttons or menu items with the hint set to words like
// (no quote marks) "Justify Full" "Bold" "Underline" etc ..
// then this routine will implement the commnads
// (see mk:@MSITStore:c:\ [somewhere]
inet.chm::/workshop/author/dhtml/reference/commandids.htm
// leave the "IDM_" portion off.
//
//Allows for the Delphi 7 happening where the menu items are often auto
'&'-ed
//If it happens to you you'll know about it.
procedure ToolButtonPlainClick(editor:tembeddedWB;Sender: TObject);
var cmd :string;
begin
// using hint string as command verb so first remove all spaces and any
ampersands
// from hint string
if (sender is TToolButton) then
CMD :=stringreplace((Sender as TToolButton).Hint,#32,'',[rfreplaceall])
else
if (sender is Tmenuitem) then
CMD :=stringreplace((Sender as Tmenuitem).caption,#32,'',[rfreplaceall]);
CMD :=stringreplace(CMD,'&','',[rfreplaceall]);
if returnSelect(editor).queryCommandEnabled(CMD) then
returnSelect(editor).execCommand(CMD,false,true);
end;
procedure ToolButtonPlainClick(editor:twebbrowser;Sender: TObject);
var cmd :string;
begin
// using hint string as command verb so first remove all spaces and any
ampersands
// from hint string
if (sender is TToolButton) then
CMD :=stringreplace((Sender as TToolButton).Hint,#32,'',[rfreplaceall])
else
if (sender is Tmenuitem) then
CMD :=stringreplace((Sender as Tmenuitem).caption,#32,'',[rfreplaceall]);
CMD :=stringreplace(CMD,'&','',[rfreplaceall]);
if returnSelect(editor).queryCommandEnabled(CMD) then
returnSelect(editor).execCommand(CMD,false,true);
end;
// returns a range from a selected area
function returnSelect(editor:tembeddedWB):olevariant;
var selected :olevariant;
begin
selected :=
editor.OleObject.document.selection.createRange;
returnSelect := selected;
end;
function returnSelect(editor:twebbrowser):olevariant;
var selected :olevariant;
begin
selected :=
editor.OleObject.document.selection.createRange;
returnSelect := selected;
end;
// returns a string telling you what kind of thing is selected
// None or Text or Control
function selType(editor:twebbrowser) :string;
begin
result := selSelection(editor).type;
end;
function selType(editor:tembeddedWB) :string;
begin
result := selSelection(editor).type;
end;
// creates a textRange over a selected portion of text
// establishes what the parent (enclosing) <tag> is
// moves the textRange to those limits and
// shows the new textRangs as a selection.
//
// Also sets the Global varible (in this unit's var clause)
currentTag
// as the current tag.
//
// (You can do things like:
// currentTag.style.border := 'solid 1pt black';
// showmessage(currentTag.style.cssText);
procedure selCurrentTag(editor:twebbrowser);
var textRange:olevariant;
begin
textRange := selTextRange(editor);
currentTag := textRange.parentElement;
TextRange:= selBodyRange(editor);
TextRange.moveToElementText(currentTag);
TextRange.select;
end;
procedure selCurrentTag(editor:tembeddedWB);
var textRange:olevariant;
begin
textRange := selTextRange(editor);
currentTag := textRange.parentElement;
TextRange:= selBodyRange(editor);
TextRange.moveToElementText(currentTag);
TextRange.select;
end;
// returns a textrange object created on the document Body
function selBodyRange(editor:twebbrowser):olevariant;
begin
result:= editor.OleObject.document.body.createTextRange;
end;
function selBodyRange(editor:tembeddedWB):olevariant;
begin
result:= editor.OleObject.document.body.createTextRange;
end;
// returns the selection object
// exposed by the document object
function selSelection(editor:tembeddedWB):olevariant;
begin
result := editor.OleObject.document.selection;
end;
function selSelection(editor:twebbrowser):olevariant;
begin
result := editor.OleObject.document.selection;
end;
// returns the Range represented by a selection
function selTextRange(editor:twebbrowser) : olevariant;
begin
result := selSelection(editor).createRange;
end;
function selTextRange(editor:tembeddedWB) : olevariant;
begin
result := selSelection(editor).createRange;
end;
// returns the plain Text in a selected area
function selText(editor:tembeddedWB) :string;
begin
result:=selTextRange(editor).text;
end;
function selText(editor:twebbrowser) :string;
begin
result:=selTextRange(editor).text;
end;
// returns the HTML underlying a selected area
function selHtml(editor:twebbrowser) :string;
begin
result := selTextRange(editor).htmlText;
end;
function selHtml(editor:tembeddedWB) :string;
begin
result := selTextRange(editor).htmlText;
end;
// Replaces the selected text underlying HTML with the HTML you
// Supply
procedure selPasteHtml(editor:twebbrowser;HTML :string);
begin
seltextRange(editor).pasteHTML(HTML);
end;
procedure selPasteHtml(editor:tembeddedWB;HTML :string);
begin
seltextRange(editor).pasteHTML(HTML);
end;
//tells you if the BODY tag is set for user editing
function editable(editor:tembeddedWB) : string;
begin
result :=editor.OleObject.document.body.contentEditable;
end;
function editable(editor:twebbrowser) : string;
begin
result :=editor.OleObject.document.body.contentEditable;
end;
//tells you if the BODY tag is set for user editing
procedure makeEditable(editor:tembeddedWB);
begin
editor.OleObject.document.body.contentEditable := true;
end;
procedure makeEditable(editor:twebbrowser) ;
begin
editor.OleObject.document.body.contentEditable := true;
end;
procedure saveAllHtmlTo(editor:tembeddedWB; fileName :string;
JpgQuality100Max : integer) ; overload;
var
pageSave :tstringlist;
document: ihtmldocument2;
all : ihtmlElementCollection;
htmlTag: ihtmlelement;
images : ihtmlElementCollection;
image : ihtmlimgelement;
counter : integer;
filepath, holdName, newName :string;
begin
document := editor.document as ihtmldocument2;
filepath := extractfilepath(filename);
if (JpgQuality100Max >0) and (pos('email', lowercase(filepath)) > 0)
then
//filepath has 'email' in it
begin
images := document.images;
for counter := 0 to images.length -1 do
begin
image := images.item(counter, counter) as ihtmlimgelement;
holdName := plainPath(image.src);
if lowercase(extractfileext(holdname)) = '.bmp' then
// conversion needed
begin
newName := changefileext(holdname,'.JPG');
if not fileexists(newName) then
// the user has not made a JPEG version
begin
convertBmptoJpg(holdName,85);
image.src := newName;
end; // the user has not made a JPEG version
end; // conversion needed
end;// counter to number of images
end; //filepath has 'email' in it
all := document.all.tags('HTML') as ihtmlElementCollection;
htmlTag := all.item(0,0) as ihtmlelement ;
//htmlTag.outerHTML
try
pageSave := tstringlist.create;
pageSave.add(docType);
pageSave.Add(htmlTag.outerHTML);
pageSave.SaveToFile(filename);
finally
pageSave.Free;
end;
end;
procedure saveAllHtmlTo(editor:twebbrowser; fileName :string;
JpgQuality100Max : integer) ; overload;
var
pageSave :tstringlist;
document: ihtmldocument2;
all : ihtmlElementCollection;
htmlTag: ihtmlelement;
begin
document := editor.document as ihtmldocument2;
all := document.all.tags('HTML') as ihtmlElementCollection;
htmlTag := all.item(0,0) as ihtmlelement ;
//htmlTag.outerHTML
try
pageSave := tstringlist.create;
pageSave.add(docType);
pageSave.Add(htmlTag.outerHTML);
pageSave.SaveToFile(filename);
finally
pageSave.Free;
end;
end;
function returnAllHtml(editor:tembeddedWB):string ; overload;
var
pageSave :tstringlist;
document: ihtmldocument2;
all : ihtmlElementCollection;
htmlTag: ihtmlelement;
begin
document := editor.document as ihtmldocument2;
all := document.all.tags('HTML') as ihtmlElementCollection;
htmlTag := all.item(0,0) as ihtmlelement ;
//htmlTag.outerHTML
try
pageSave := tstringlist.create;
pageSave.add(docType);
pageSave.Add(htmlTag.outerHTML);
returnAllHtml:=pageSave.text;
finally
pageSave.Free;
end;
end;
function returnAllHtml(editor:twebbrowser):string ; overload;
var
pageSave :tstringlist;
document: ihtmldocument2;
all : ihtmlElementCollection;
htmlTag: ihtmlelement;
begin
document := editor.document as ihtmldocument2;
all := document.all.tags('HTML') as ihtmlElementCollection;
htmlTag := all.item(0,0) as ihtmlelement ;
//htmlTag.outerHTML
try
pageSave := tstringlist.create;
pageSave.add(docType);
pageSave.Add(htmlTag.outerHTML);
returnAllHtml:=pageSave.text;
finally
pageSave.Free;
end;
end;
procedure convertBmptoJpg( filename:string; const quality100Max :integer);
var
jpg : TJpegImage;
bmp : tbitmap;
begin
try // try images creation
jpg:= tjpegimage.Create; bmp := tbitmap.create;
bmp.loadfromfile(fileName);
jpg.Assign(bmp);
jpg.CompressionQuality:= quality100Max;
jpg.Compress;
filename := changefileext(filename,'.JPG') ;
jpg.SaveToFile(filename);
finally
jpg.Free; bmp.free end;// try images creation
end;
function plainPath(path:string):string;
begin
path:=stringreplace(copy(path,9,length(path)),'%20',#32,[rfreplaceall]);
Path:= stringreplace(path, '/','\',[rfreplaceall]);
Path:= stringreplace(path, '&','&',[rfreplaceall]);
Path:= stringreplace(path, '>','>',[rfreplaceall]);
Path:= stringreplace(path, '<','<',[rfreplaceall]);
Path:= stringreplace(path, '"',#34,[rfreplaceall]);
Path:= stringreplace(path, '%26',#22,[rfreplaceall]);
// path:=hyperstr.URLDecode(path) ;
plainPath := path;
// if fileexists(path) then
// showmessage('OK: '+path);
clipboard.AsText:=path;
end;
{ THtmlTags }
destructor THtmlTags.finished;
begin
inherited free;
end;
constructor THtmlTags.setup;
begin
self.crLf := crLf;
self.tblTDclosed := tblTD;
self.tblTDOpening := tblTDa;
self.tblTDClosing := tblTDz;
self.tblTRclosed := tblTR ;
self.tblTROpening := tblTRa ;
self.tblTRClosing := tblTRz ;
self.tblTHclosed := tblTH;
self.tblTHOpening := tblTha ;
self.tblTHClosing := tblThz ;
self.tblTBodyClosed := tblTBody;
self.tblTBodyOpening := tblTBodya;
self.tblTBodyClosing := tblTBodyz;
self.tblTHeadClosed := tblTHead ;
self.tblTHeadOpening := tblTHeada ;
self.tblTHeadClosing := tblTHeadz ;
self.tblTFootClosed := tblTFoot ;
self.tblTFootOpening := tblTFoota ;
self.tblTFootOpening := tblTFootz ;
self.tblTableClosed := tblTable ;
self.tblTableOpening := tblTablea ;
self.tblTableClosing := tblTablez ;
self.tbl5colsx3rows := tbl5x3;
inherited create(nil);
end;
end.
_______________________________________________
Delphi mailing list
[EMAIL PROTECTED]
http://ns3.123.co.nz/mailman/listinfo/delphi
