5,388
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
chinawcs 2014-06-27
- 打赏
- 举报
首先谢谢你的回答 基本思路我知道了 顺便问下 是否 支持 上传附件
stephenchern 2014-06-19
- 打赏
- 举报
我这里已经用了好多年了 基本上相对比较稳定了
但是html编辑毕竟不如word 所以我最近在考虑换成word
也在这里发帖请教大家
http://bbs.csdn.net/topics/390813483stephenchern 2014-06-19
- 打赏
- 举报
procedure TfraHtmlEdit.BtnRightJustifyClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('JustifyRight', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnUnderlineClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('Underline', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnUndoClick(Sender: TObject);
begin
WebBrowser.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT);
end;
procedure TfraHtmlEdit.cbFontSizeCloseUp(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('FontSize', False, cbFontSize.ItemIndex + 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
function TfraHtmlEdit.CheckImgSize: Boolean;
begin
Result := CheckImgSize(200*1024);
if not Result then
begin
MsgDlg('图片容量太大，不能超过200k，请压缩图片后再继续保存操作', '提示', MB_OK + MB_ICONINFORMATION);
WebBrowser.SetFocus;
end;
end;
function TfraHtmlEdit.CheckImgSize(Size: Int64): Boolean;
var
i: Integer;
FileName: string;
begin
Result := True;
for i := 0 to WebBrowser.OleObject.document.images.length - 1 do
begin
FileName := WebBrowser.OleObject.document.images.item(i).href;
FileName := StringReplace(FileName, 'file:///', '', [rfReplaceAll]);
FileName := StringReplace(FileName, '/', '\', [rfReplaceAll]);
FileName := StringReplace(FileName, '%20', ' ', [rfReplaceAll]);
if GetFileSizes(FileName) > Size then
begin
Result := False;
Break;
end;
end;
end;
function TfraHtmlEdit.GetHTML: WideString;
begin
Result := (WebBrowser.Document as IHTMLDocument2).body.innerHTML;
end;
function TfraHtmlEdit.GetHTML_(ID: string): WideString;
var
i: Integer;
FileName: string;
str: WideString;
begin
str := HTML;
for i := 0 to WebBrowser.OleObject.document.images.length - 1 do
begin//注意：这有时候地址会替换不过来
FileName := StringReplace(WebBrowser.OleObject.document.images.item(i).href, 'file:///', '', [rfReplaceAll]);
FileName := StringReplace(FileName, '/', '\', [rfReplaceAll]);
FileName := StringReplace(FileName, '%20', ' ', [rfReplaceAll]);
str := StringReplace(str, FileName, 'C:\Temp\'+ID+'_'+IntToStr(i)+ExtractFileExt(FileName), [rfReplaceAll]);
end;
Result := str;
end;
function TfraHtmlEdit.GetSource: string;
var
i: Integer;
Disp: IDispatch;
Element: IHTMLElement;
begin
for i := 0 to (WebBrowser.Document as IHTMLDocument2).all.length -1 do
begin
Disp := (WebBrowser.Document as IHTMLDocument2).all.item(i, 0);
if Disp <> nil then
begin
Disp.QueryInterface(IID_IHTMLElement, Element);
if Element <> nil then
if SameText(Element.tagName, 'html') then
begin
Result := Element.outerHTML;
Break;
end;
end;
end;
end;
function TfraHtmlEdit.GetText: WideString;
begin
Result := (WebBrowser.Document as IHTMLDocument2).body.innerText;//HTMLDocument2.body.innerText;
end;
procedure TfraHtmlEdit.Init;
begin
Application.OnMessage := MessageHandler;
WebBrowser.Navigate('about:blank');
while WebBrowser.Busy do
Application.ProcessMessages;
HTMLDocument2 := WebBrowser.Document as IHTMLDocument2;
if not SameText(HTMLDocument2.designMode, 'on') then
HTMLDocument2.designMode := 'on';
end;
procedure TfraHtmlEdit.MessageHandler(var Msg: TMsg; var Handled: Boolean);
const
StdKeys = [VK_TAB, VK_RETURN]; { 标准键 }
ExtKeys = [VK_Delete, VK_BACK, VK_LEFT, VK_RIGHT]; { 扩展键 }
fExtended = $01000000; { 扩展键标志 }
begin
Handled := False;
with Msg do
if ((Message >= WM_KEYFIRST)
and (Message <= WM_KEYLAST))
and ((wParam in StdKeys) or (GetKeyState(VK_CONTROL) < 0) or (wParam in ExtKeys)
and ((lParam and fExtended) = fExtended)) then
try
if IsChild(webbrowser.Handle, hWnd) then
{ 处理所有的浏览器相关消息 }
begin
with (Webbrowser.Application as IOleInPlaceActiveObject) do
Handled := TranslateAccelerator(Msg) = S_OK;
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end;
procedure TfraHtmlEdit.RzFontComboBoxCloseUp(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('FontName', False, RzFontComboBox.FontName);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnOutdentClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('Outdent', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnSuperScriptClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('SuperScript', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnSubScriptClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('SubScript', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnStrikeThroughClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('StrikeThrough', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.SetHTML(const Value: WideString);
begin
Application.ProcessMessages;
HTMLDocument2.body.innerHTML := Value;
end;
procedure TfraHtmlEdit.SetText(const Value: WideString);
begin
Application.ProcessMessages;
HTMLDocument2.body.innerText := Value;
end;
initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
end.
stephenchern 2014-06-19
- 打赏
- 举报
MSHTML Editor 别用了 楼上说的对
还是用twebrowser自己写一个
我这里就是自己写一个，是可以用的
代码如下： 我是写成frame 其他窗口调用
unit unt_fraHtmlEdit;
interface
uses
Classes, Controls, Forms, SysUtils, Windows, RzPanel, RzButton, Vcl.ComCtrls,
RzCmboBx, Dialogs, ExtDlgs, ImgList, OleCtrls, StdCtrls, ExtCtrls, MSHTML,
Vcl.Graphics, Winapi.Messages, SHDocVw, cxGraphics, cxControls, StrUtils,
cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit, cxTextEdit, cxMemo;
type
TfraHtmlEdit = class(TFrame)
RzToolbar: TRzToolbar;
ImageList: TImageList;
BtnBold: TRzToolButton;
BtnItalic: TRzToolButton;
BtnUnderline: TRzToolButton;
BtnFontColor: TRzToolButton;
BtnLeftJustify: TRzToolButton;
BtnCenterJustify: TRzToolButton;
BtnRightJustify: TRzToolButton;
BtnInsertImage: TRzToolButton;
BtnUndo: TRzToolButton;
BtnRedo: TRzToolButton;
RzSpacer4: TRzSpacer;
RzSpacer7: TRzSpacer;
RzFontComboBox: TRzFontComboBox;
cbFontSize: TRzComboBox;
RzSpacer8: TRzSpacer;
BtnStrikeThrough: TRzToolButton;
BtnSuperScript: TRzToolButton;
BtnSubScript: TRzToolButton;
BtnOutdent: TRzToolButton;
BtnIndent: TRzToolButton;
BtnInsertParagraph: TRzToolButton;
BtnCreateLink: TRzToolButton;
WebBrowser: TWebBrowser;
btnRefresh: TRzToolButton;
procedure BtnUnderlineClick(Sender: TObject);
procedure BtnUndoClick(Sender: TObject);
procedure BtnRedoClick(Sender: TObject);
procedure BtnLeftJustifyClick(Sender: TObject);
procedure BtnRightJustifyClick(Sender: TObject);
procedure BtnInsertImageClick(Sender: TObject);
procedure BtnFontColorClick(Sender: TObject);
procedure BtnBoldClick(Sender: TObject);
procedure BtnItalicClick(Sender: TObject);
procedure BtnStrikeThroughClick(Sender: TObject);
procedure RzFontComboBoxCloseUp(Sender: TObject);
procedure cbFontSizeCloseUp(Sender: TObject);
procedure BtnCenterJustifyClick(Sender: TObject);
procedure BtnSuperScriptClick(Sender: TObject);
procedure BtnSubScriptClick(Sender: TObject);
procedure BtnOutdentClick(Sender: TObject);
procedure BtnIndentClick(Sender: TObject);
procedure BtnInsertParagraphClick(Sender: TObject);
procedure BtnCreateLinkClick(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
private
{ Private declarations }
HTMLDocument2: IHTMLDocument2;
//WebBrowser上回车等按键事件处理
procedure MessageHandler(var Msg: TMsg; var Handled: Boolean);
function GetHTML: WideString;
procedure SetHTML(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
function GetSource: string;
public
{ Public declarations }
//初始化操作，将WebBrowser置为可编辑状态， 在窗体OnCreate时执行
procedure Init;
//检查图片容量是否超过指定大小
function CheckImgSize(Size: Int64): Boolean; overload;
//检查图片容量是否超过指定大小
function CheckImgSize: Boolean; overload;
property HTML: WideString read GetHTML write SetHTML;
property Text: WideString read GetText write SetText;
property Source: string read GetSource;
//获得将图片地址替换掉的HTML，地址替换成C:\Exam\SubjectID_PictureNo.jpg
function GetHTML_(ID: string): WideString;
end;
implementation
uses Winapi.ActiveX, unt_FileProc, unt_OtherProc, unt_StringProc;
{$R *.dfm}
procedure TfraHtmlEdit.BtnBoldClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('Bold', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnCenterJustifyClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('JustifyCenter', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnCreateLinkClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('CreateLink', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnFontColorClick(Sender: TObject);
function ColorToString(Color: TColor): string;
var
cl: Cardinal;
begin
cl := ColorToRGB(Color);
Result := '#' + IntToHex(Byte(cl), 2) + IntToHex(Byte(cl shr 8), 2) + IntToHex(Byte(cl shr 16), 2);
end;
var
ColorDialog: TColorDialog;
begin
ColorDialog := TColorDialog.Create(Self);
try
if ColorDialog.Execute(Handle) then
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('ForeColor', False, ColorToString(ColorDialog.Color));
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
finally
ColorDialog.Free;
end;
end;
procedure TfraHtmlEdit.BtnIndentClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('Indent', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnInsertImageClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('InsertImage', True, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnInsertParagraphClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('InsertParagraph', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnItalicClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('Italic', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnLeftJustifyClick(Sender: TObject);
begin
with (WebBrowser.Document as IHTMLDocument2) do
begin
execCommand('JustifyLeft', False, 1);
webbrowser.ExecWB(OLECMDID_SAVE, OLECMDEXECOPT_DONTPROMPTUSER);
end;
end;
procedure TfraHtmlEdit.BtnRedoClick(Sender: TObject);
begin
WebBrowser.ExecWB(OLECMDID_REDO, OLECMDEXECOPT_DODEFAULT);
end;
procedure TfraHtmlEdit.btnRefreshClick(Sender: TObject);
var
SourceHTML, ShapeStr, StyleStr, ImgStr, SrcStr, Str: string;
i, j: Integer;
begin
{<v:shape id=_x0000_i1025
style="HEIGHT: 33.75pt;WIDTH: 1in" o:ole="" type="#_x0000_t75"><v:imagedata o:title=""
src="file:///C:\Users\ADMINI~1\AppData\Local\Temp\msohtml1\01\clip_image001.wmz">
</v:imagedata></v:shape>}
//替换为如下：
{<img style="HEIGHT: 33.75pt;WIDTH: 1in" src="c:/clip_image001.wmz"}
SourceHTML := HTML;
while Pos('<v:shape ', SourceHTML) > 0 do
begin
i := Pos('<v:shape ', SourceHTML);
j := Pos('</v:shape>', SourceHTML)+10;
ShapeStr := Copy(SourceHTML, i, j-i);//将shape截出来
Str := Copy(ShapeStr, Pos('style=', ShapeStr)+7, Length(ShapeStr));
StyleStr := Copy(Str, 0, Pos('"', Str)-1);//将shape中的style截出来
Str := Copy(ShapeStr, Pos('src=', ShapeStr)+13, Length(ShapeStr));
SrcStr := Copy(Str, 0, Pos('"', Str)-1);
Str := ExtractFileNameWithoutExt(SrcStr);
SrcStr := ExtractFilePath(SrcStr)
+ LeftStr(Str, Length(Str)-3)+RightStr('00'+IntToStr(StrToInt(RightStr(Str, 3))+1),3)
+ '.gif';
CopyFile_(SrcStr, ExtractFilePath(ParamStr(0))+'Temp\'+GetGuidValue+ExtractFileExt(SrcStr));
SrcStr := ExtractFilePath(ParamStr(0))+'Temp\'+GetGuidValue+ExtractFileExt(SrcStr);
ImgStr := '<img style="'+StyleStr+'" src="'+SrcStr+'"/>';
MsgDlg(ImgStr);
SourceHTML := StringReplace(SourceHTML, ShapeStr, ImgStr, [rfReplaceAll]);
MsgDlg(SourceHTML);
{
int start = html.IndexOf("<v:shape ");
int end = html.IndexOf("<:shape>") + 10;
string shapeImageStr = html.Substring(start, end - start);
string styleStart = shapeImageStr.Substring(shapeImageStr.IndexOf("style=\"") + 7);
string style = styleStart.Substring(0, styleStart.IndexOf("\""));//提取style属性值
string srcStart = shapeImageStr.Substring(shapeImageStr.IndexOf("src=\"") + 5);
string src = srcStart.Substring(0, srcStart.IndexOf("\""));//提取src属性值
src = Path.GetFullPath(src.Replace("%20", " ").Replace("file:///", ""));
//把剪贴板中图片复制到临时文件夹temp下，防止剪贴板重复粘贴出现后面的图片一直显示为第一次粘贴的图片
string newImageFileName = tempFilePath+Guid.NewGuid().ToString("N") + Path.GetExtension(src);
File.Copy(src, newImageFileName);
//拼接图片标签,(使用新图片路径)
string imageStr = "<img style=\"" + style + "\" src=\"" + newImageFileName + "\"/>";
//替换字符串
html = html.Replace(shapeImageStr, imageStr);
}
end;
HTML := SourceHTML;
end;
李正己 2014-06-19
- 打赏
- 举报
我用过 MSHTML Editor， 是开源的，不过版本很老了，早就不更新了，升级到 XE5后就不用这个控件了，直接用TWebbower写了一个。
我也一直在找过可以编辑html的组件，一直没有找到合适，收费的也找过没有找到。
