捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
TEditWebBrowser 组件
关键字：TEditWebBrowser TWebBrowser 组件
来　自：原创
平　台：Win9x,Win2k/XP/NT,Win2003 下载所需：0 火柴
深浅度：中级 完成时间：2005/9/1
发布者：xcoming 发布时间：2005/9/1
编辑器：DELPHI7 语　　种：简体中文
分　类：编辑框与文本框 下载浏览：2/20999
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名：
 密　码：
自动登陆(30天有效)
无图片
继承TWebBrowser组件编写的组件：TEditWebBrowser，改写了原Mouse、Keyboard事件和OnEnter、OnExit事件。改写了TWebBrowser的焦点设置获取方法。
超强的Edit功能，完全替代TRichEdit组件，可以更方便的插入图片和表格。

unit EditWebBrowser;
//////////
//    制作：xcoming
//    版本：2005-8-30
//    联系：xcoming@21cn.com
//////////
interface

uses
  SysUtils, Classes, Controls, OleCtrls, SHDocVw,Consts,
  Messages,Forms,windows,ActiveX,typinfo,MSHTML;

const
  IID_IOleCommandTarget:TGUID='{B722BCCB-4E68-101B-A2BC-00AA00404770}';

type
  TMouseDownEvent=procedure(Sender:Tobject;Button:TMouseButton;Shift:TShiftState;x,y:integer) of object;
  TMouseUpEvent=procedure(Sender:Tobject;Button:TMouseButton;Shift:TShiftState;x,y:integer) of object;
  TMouseMoveEvent=procedure(Sender:Tobject;Shift:TShiftState;x,y:integer) of object;
  TEnterEvent=procedure(Sender:Tobject) of object;
  TExitEvent=procedure(Sender:Tobject) of object;

  TDblClickEvent=procedure(Sender:Tobject;Button:TMouseButton;Shift:TShiftState;x,y:integer) of object;

  TKeyDownEvent=procedure(Sender:Tobject;Shift:TShiftState;Key:word) of object;
  TKeyUpEvent=procedure(Sender:Tobject;Shift:TShiftState;Key:word) of object;

  TEditWebBrowser = class(TWebBrowser)
  private
    { Private declarations }
    FParentWinControl:TWinControl;
    FApplication:TApplication;
    FOnMouseDown:TMouseDownEvent;
    FOnMouseUp:TMouseUpEvent;
    FOnMouseMove:TMouseMoveEvent;
    FOnEnter:TEnterEvent;
    FOnExit:TExitEvent;
    FOnDblClick:TDblClickEvent;

    FOnKeyDown:TKeyDownEvent;
    FOnKeyUp:TKeyUpEvent;

    FFocused:boolean;
    FisShowSelfPopupMenu:boolean;
    FWantReturns:boolean;
    FVisible:boolean;

    FShiftFoceed,FCtrlFoceed:boolean;
    FReadOnly:boolean;
    FScrollbar:boolean;

    procedure OnMyMessage(var Msg:TMsg;var Handled:Boolean);
    function GetPoint(C:TComponent;p:TPoint):TPoint;

    procedure DoMouseDown(Button:TMouseButton;Shift:TShiftState;x,y:integer);
    procedure DoMouseUp(Button:TMouseButton;Shift:TShiftState;x,y:integer);
    procedure DoMouseMove(Shift:TShiftState;x,y:integer);
    procedure DoDblClick(Button:TMouseButton;Shift:TShiftState;x,y:integer);

    procedure DoKeyDown(Shift:TShiftState;Key:word);
    procedure DoKeyUp(Shift:TShiftState;Key:word);

    function GetInnerHTML:string;
    function GetInnerText:string;
    procedure SetisShowSelfPopupMenu(v:boolean);
    procedure SetWantReturns(v:boolean);
    procedure SetReadOnly(v:boolean);

    function GetScrollTop:integer;
    function GetScrollHeight:integer;
    function GetScrollLeft:integer;
    function GetScrollWidth:integer;
    function GetDocument:IHTMLDocument2;
    function GetWindow:IHTMLWindow2;
    function GetDocCMD:IOleCommandTarget;

    procedure SetScrollbar(v:boolean);
    function GetSelText():string;
    procedure SetSelText(s:string);
    function GetSelHTML():string;
    procedure SetSelHTML(s:string);

    procedure SetVisible(v:boolean);

    procedure DoEnter;
    procedure DoExit;
  protected

  public
    { Public declarations }
    constructor Create(Owner:TComponent);override;
    destructor Destroy;override;
    property Focused:boolean read FFocused;
    property InnerHTML:String read GetInnerHTML;
    property InnerText:String read GetInnerText;
    property ScrollTop:integer read GetScrollTop;
    property ScrollHeight:integer read GetScrollHeight;
    property ScrollLeft:integer read GetScrollLeft;
    property ScrollWidth:integer read GetScrollWidth;
    property Doc:IHTMLDocument2 read GetDocument;
    property Win:IHTMLWindow2 read GetWindow;
    property DocCMD:IOleCommandTarget read GetDocCMD;
    property Scrollbar:boolean read FScrollbar write SetScrollbar;
    property SelText:string read GetSelText write SetSelText;
    property SelHTML:string read GetSelHTML write SetSelHTML;

    procedure SetFocus;
    procedure WriteHTML(HTML:string);
    procedure AppendHTML(HTML:string);
    procedure Clear;
    procedure Print(isPrintView:boolean=true);
    procedure PrintPageSetup;
    procedure Copy;
    procedure Cut;
    procedure Paste;
    procedure SelectAll;
    procedure SaveAs(FileName:string='blank.htm');
    procedure ScrollTo(x,y:integer);
    procedure SetMargin(top,bottom,left,right:integer);

    procedure SetSelection(Start,Length:integer);
  published
    { Published declarations }
    property OnMouseDown:TMouseDownEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp:TMouseUpEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseMove:TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnEnter:TEnterEvent read FOnEnter write FOnEnter;
    property OnExit:TExitEvent read FOnExit write FOnExit;
    property OnDblClick:TDblClickEvent read FOnDblClick write FOnDblClick;

    property OnKeyUp:TKeyUpEvent read FOnKeyUp write FOnKeyUp;
    property OnKeyDown:TKeyDownEvent read FOnKeyDown write FOnKeyDown;
    property isShowSelfPopupMenu:boolean read FisShowSelfPopupMenu write SetisShowSelfPopupMenu;
    property WantReturns:boolean read FWantReturns write SetWantReturns;
    property ReadOnly:boolean read FReadOnly write SetReadOnly;
    property Visible:boolean read FVisible write SetVisible;

  end;

procedure Register;

implementation

type TEditWebBrowsers=class(TComponent)
  private
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
  public
    EditWebBrowsers:array of TEditWebBrowser;
    procedure OnMyMessage(var Msg:TMsg;var Handled:Boolean);
end;

var EditWebBrowsers:TEditWebBrowsers=nil;

procedure TEditWebBrowsers.OnMyMessage(var Msg:TMsg;var Handled:Boolean);
var i:integer;
begin
  try
    for i:=0 to length(self.EditWebBrowsers) do
      if self.EditWebBrowsers[i]<>nil then
        if not self.EditWebBrowsers[i].OleObject.document.hasfocus then
          if self.EditWebBrowsers[i].FFocused then begin
          self.EditWebBrowsers[i].DoExit; break;
          end;
  except end;
  try
    for i:=0 to length(self.EditWebBrowsers) do
      if self.EditWebBrowsers[i]<>nil then
        if self.EditWebBrowsers[i].OleObject.document.hasfocus then
          if not self.EditWebBrowsers[i].FFocused then begin
          self.EditWebBrowsers[i].DoEnter; break;
          end;
  except end; 
 try
   for i:=0 to length(self.EditWebBrowsers) do
      if self.EditWebBrowsers[i]<>nil then
       try self.EditWebBrowsers[i].OnMyMessage(Msg,Handled); except end;
  except end;
end;

constructor TEditWebBrowsers.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Application.OnMessage:=OnMyMessage;
end;

destructor TEditWebBrowsers.Destroy;
begin
  Application.OnMessage:=nil;
end;

constructor TEditWebBrowser.Create(Owner:TComponent);
var i:integer; flag:boolean;
begin
  inherited Create(Owner);
  if not Assigned(self.Document) then self.Navigate('about:blank');
  self.SetReadOnly(false);
  FisShowSelfPopupMenu:=true;
  self.SetWantReturns(true);
  self.SetisShowSelfPopupMenu(false);
  self.FScrollbar:=true;
  self.FFocused:=false;
  self.FVisible:=true;
  flag:=false;
  try
   for i:=0 to length(EditWebBrowsers.EditWebBrowsers)-1 do
     if EditWebBrowsers.EditWebBrowsers[i]=nil then begin
       EditWebBrowsers.EditWebBrowsers[i]:=self;
       flag:=true;break;
     end;
  except end;
  if not flag then begin
    setLength(EditWebBrowsers.EditWebBrowsers
      ,length(EditWebBrowsers.EditWebBrowsers)+1);
    EditWebBrowsers.EditWebBrowsers
      [length(EditWebBrowsers.EditWebBrowsers)-1]:=self;
  end;
end;

procedure TEditWebBrowser.DoEnter;
begin 
  self.FFocused:=true;
  TWinControl(self).SetFocus;
  if self.Win<>nil then self.Win.focus;
  if Assigned(FOnEnter) then FOnEnter(self);
end;

procedure TEditWebBrowser.DoExit;
begin
  self.FFocused:=false;
  if self.OleObject.document.hasfocus then
    if self.Win<>nil then self.Win.blur;
  if Assigned(FOnExit) then FOnExit(self);
end;

function TEditWebBrowser.GetDocument:IHTMLDocument2;
begin
  result:=self.Document as IHTMLDocument2;
end;

function TEditWebBrowser.GetWindow:IHTMLWindow2;
var W:IHTMLWindow2;
begin
  repeat W:=self.Doc.parentWindow;
  until W<>nil;     result:=W;
end;

function TEditWebBrowser.GetDocCMD:IOleCommandTarget;
var DCMD:IOleCommandTarget;
begin
  repeat self.Doc.QueryInterface(IOleCommandTarget,DCMD);
  until DCMD<>nil;
  result:=DCMD;
end;

procedure TEditWebBrowser.SetReadOnly(v:boolean);
begin
  self.FReadOnly:=v;
  if self.FReadOnly then
    self.Doc.designMode:='off'
  else
    self.Doc.designMode:='on';
end;

procedure TEditWebBrowser.SetMargin(top,bottom,left,right:integer);
begin
  self.Doc.body.style.marginTop:=top;
  self.Doc.body.style.marginBottom:=bottom;
  self.Doc.body.style.marginLeft:=left;
  self.Doc.body.style.marginRight:=right;
end;

procedure TEditWebBrowser.ScrollTo(x,y:integer);
begin
  self.OleObject.document.parentwindow.scrollto(x,y);
end;

function TEditWebBrowser.GetScrollTop:integer;
begin
  result:=self.OleObject.document.body.scrollTop;
end;

function TEditWebBrowser.GetScrollHeight:integer;
begin
  result:=self.OleObject.document.body.scrollHeight;
end;

function TEditWebBrowser.GetScrollLeft:integer;
begin
  result:=self.OleObject.document.body.scrollLeft;
end;

function TEditWebBrowser.GetScrollWidth:integer;
begin
  result:=self.OleObject.document.body.scrollWidth;
end;

destructor TEditWebBrowser.Destroy;
var i:integer;
begin
  try
    for i:=0 to length(EditWebBrowsers.EditWebBrowsers)-1 do
      if EditWebBrowsers.EditWebBrowsers[i]=self then begin
        EditWebBrowsers.EditWebBrowsers[i]:=nil;
        break;
      end;
  except end;
  inherited Destroy;
end;

function TEditWebBrowser.GetInnerHTML:string;
begin
  result:=self.OleObject.document.All.item.innerhtml;
end;

function TEditWebBrowser.GetInnerText:string;
begin
  result:=self.OleObject.document.All.item.innerText;
end;

procedure TEditWebBrowser.WriteHTML(HTML:string);
begin
  self.OleObject.document.close();
  self.OleObject.document.clear();
  self.OleObject.document.write(HTML);
end;

procedure TEditWebBrowser.Clear;
begin
  self.OleObject.document.close();
  self.OleObject.document.clear();
  //本方法不能真正清除文档，最好是用：WriteHtml(' ')清除
end;

procedure TEditWebBrowser.SetScrollbar(v:boolean);
begin
  self.FScrollbar:=v;
  if v then self.Doc.body.style.overflow:='scroll'
  else self.Doc.body.style.overflow:='hidden'
end;

procedure TEditWebBrowser.AppendHTML(HTML:string);
begin
  self.OleObject.document.write(HTML);
end;

procedure TEditWebBrowser.SetFocus;
begin
  {注：设定某一个TEditWebBrowser的焦点时，如果当前的焦点正在另
  一个TEditWebBrowser上，则此时最好先使有焦点的TEditWebBrowser控件
  失去焦点。例如：
    EW1有焦点，要通过程序设置EW2的焦点，应该这样：
      EW1.Win.blur;
      EW2.SetFocus;
  }
  self.Win.focus;
end;

procedure TEditWebBrowser.Print(isPrintView:boolean=true);
begin
  if isPrintView then
    self.ExecWB(OLECMDID_PRINTPREVIEW,OLECMDEXECOPT_DODEFAULT)
  else
    self.ExecWB(OLECMDID_PRINT,OLECMDEXECOPT_DODEFAULT);
end;

procedure TEditWebBrowser.PrintPageSetup;
begin
  self.ExecWB(OLECMDID_PAGESETUP,OLECMDEXECOPT_DODEFAULT);
end;

procedure TEditWebBrowser.Copy;
begin
  self.ExecWB(OLECMDID_COPY,OLECMDEXECOPT_DODEFAULT);
end;

procedure TEditWebBrowser.Paste;
begin
  self.ExecWB(OLECMDID_PASTE,OLECMDEXECOPT_DODEFAULT);
end;

procedure TEditWebBrowser.SelectAll;
begin
  self.ExecWB(OLECMDID_SELECTALL,OLECMDEXECOPT_DODEFAULT);
end;

procedure TEditWebBrowser.Cut;
begin
  self.ExecWB(OLECMDID_CUT,OLECMDEXECOPT_DODEFAULT);
end;

procedure TEditWebBrowser.SaveAs(FileName:string='blank.htm');
begin
  self.Doc.execCommand('SaveAs',false,FileName);
end;

function TEditWebBrowser.GetPoint(C:TComponent;p:TPoint):TPoint;
var rsp:TPoint;
begin
  if C.Owner is TForm then begin
    rsp.X:=p.X-(C.Owner as TForm).Left;
    rsp.Y:=p.Y-(C.Owner as TForm).Top;
    rsp.X:=rsp.X-((C.Owner as TForm).Width-(C.Owner as TForm).ClientWidth) div 2;
    rsp.Y:=rsp.Y-((C.Owner as TForm).Height-(C.Owner as TForm).ClientHeight);
    result:=rsp;
  end else begin
    rsp.X:=p.X-GetOrdProp(C.Owner,'Left');
    rsp.Y:=p.Y-GetOrdProp(C.Owner,'Top');
    result:=self.GetPoint(C.Owner,rsp);
  end;
end;

procedure TEditWebBrowser.OnMyMessage(var Msg:TMsg;var Handled:Boolean);
var p:TPoint;ShiftState:TShiftState;Key:word;
  bKey:TKeyBoardState;
begin
  //GetCursorPos(p); 

  p.X:=Msg.pt.X-self.Left;  p.Y:=Msg.pt.Y-self.Top;
  p:=self.GetPoint(self,p);
  if (p.X>=0) and (p.X<=self.Width) and (p.Y>=0)
    and (p.Y<=self.Height) then begin
    if Msg.message=WM_RBUTTONDOWN then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      Handled:=not self.FisShowSelfPopupMenu;
      DoMouseDown(mbRight,ShiftState,p.X,p.Y);
    end else if Msg.message=WM_LBUTTONDOWN then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      DoMouseDown(mbLeft,ShiftState,p.X,p.Y);
    end else if Msg.message=WM_RBUTTONUP then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      Handled:=not self.FisShowSelfPopupMenu;
      DoMouseUp(mbRight,ShiftState,p.X,p.Y);
    end else if Msg.message=WM_LBUTTONUP then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      DoMouseUp(mbLeft,ShiftState,p.X,p.Y);
    end else if Msg.message=WM_MOUSEMOVE then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      DoMouseMove(ShiftState,p.X,p.Y);
    end else if Msg.message=WM_LBUTTONDBLCLK then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      DoDblClick(mbLeft,ShiftState,p.X,p.Y);
    end else if Msg.message=WM_RBUTTONDBLCLK then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      Handled:=not self.FisShowSelfPopupMenu;
      DoDblClick(mbRight,ShiftState,p.X,p.Y);
    end;
  end;

  if self.OleObject.document.hasfocus then begin
    if Msg.message=WM_KEYDOWN then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      Key:=Msg.wParam;
      if not self.FReadOnly then begin
        if Key=13 then begin
          if self.FWantReturns then begin
          if not (ssShift in ShiftState) then begin
          GetKeyboardState(bKey);
          bKey[VK_Shift]:=not bKey[VK_Shift];
          SetKeyboardState(bKey);
          self.FShiftFoceed:=true;
          end;
          end else begin
          if (ssCtrl in ShiftState) then begin
          self.FCtrlFoceed:=true;
          GetKeyboardState(bKey);
          bKey[VK_CONTROL]:=not bKey[VK_CONTROL];
          SetKeyboardState(bKey);
          if not (ssShift in ShiftState) then begin
          GetKeyboardState(bKey);
          bKey[VK_Shift]:=not bKey[VK_Shift];
          SetKeyboardState(bKey);
          self.FShiftFoceed:=true;
          end;
          end else Msg.wParam:=0;
          end;
        end;
      end;
      DoKeyDown(ShiftState,Key);
    end else if Msg.message=WM_KEYUP then begin
      ShiftState:=KeyDataToShiftState(Msg.wParam);
      Key:=Msg.wParam;
      if not self.FReadOnly then begin
        if Key=13 then begin
          if self.FShiftFoceed then begin
          GetKeyboardState(bKey);
          bKey[VK_Shift]:=not bKey[VK_Shift];
          SetKeyboardState(bKey);
          Msg.wParam:=0;
          self.FShiftFoceed:=false;
          end;
        end;
      end;
      if self.FCtrlFoceed then begin
        Include(ShiftState,ssCtrl);
        self.FCtrlFoceed:=false;
      end;
      DoKeyUp(ShiftState,Key);
    end;
  end;

  //TranslateMessage(Msg);
  //DispatchMessage(Msg);
end;

procedure TEditWebBrowser.DoMouseDown(Button:TMouseButton;Shift:TShiftState;x,y:integer);
begin
  if Assigned(FOnMouseDown) then FOnMouseDown(self,Button,Shift,x,y);
end;

procedure TEditWebBrowser.DoMouseUp(Button:TMouseButton;Shift:TShiftState;x,y:integer);
begin
  if Assigned(FOnMouseUp) then FOnMouseUp(self,Button,Shift,x,y);
end;

procedure TEditWebBrowser.DoMouseMove(Shift:TShiftState;x,y:integer);
begin
  if Assigned(FOnMouseMove) then FOnMouseMove(self,Shift,x,y);
end;

procedure TEditWebBrowser.DoDblClick(Button:TMouseButton;Shift:TShiftState;x,y:integer);
begin
  if Assigned(FOnDblClick) then FOnDblClick(self,Button,Shift,x,y);
end;

procedure TEditWebBrowser.DoKeyDown(Shift:TShiftState;Key:word);
begin
  if Assigned(FOnKeyDown) then FOnKeyDown(self,Shift,Key);
end;

procedure TEditWebBrowser.DoKeyUp(Shift:TShiftState;Key:word);
begin
  if Assigned(FOnKeyUp) then FOnKeyUp(self,Shift,Key);
end;

procedure TEditWebBrowser.SetisShowSelfPopupMenu(v:boolean);
begin
  self.FisShowSelfPopupMenu:=v;
end;

procedure TEditWebBrowser.SetWantReturns(v:boolean);
begin
  self.FWantReturns:=v;
end;

function TEditWebBrowser.GetSelText():string;
begin
  result:=(self.Doc.selection.createRange as IHtmlTxtRange).text;
end;

procedure TEditWebBrowser.SetSelText(s:string);
begin
  (self.Doc.selection.createRange as IHtmlTxtRange).text:=s;
end;

function TEditWebBrowser.GetSelHTML():string;
begin
  result:=(self.Doc.selection.createRange as IHtmlTxtRange).htmlText;
end;

procedure TEditWebBrowser.SetSelHTML(s:string);
begin
  (self.Doc.selection.createRange as IHtmlTxtRange).pasteHTML(s);
end;

procedure TEditWebBrowser.SetVisible(v:boolean);
begin
  self.FVisible:=v;
  TWinControl(self).Visible:=v;
end;

procedure TEditWebBrowser.SetSelection(Start,Length:integer);
var TextRange:IHtmlTxtRange;
begin
  self.Doc.selection.empty;
  TextRange:=self.Doc.selection.createRange as IHtmlTxtRange;
  TextRange.collapse(true);
  TextRange.moveEnd('character',Start+Length);
  TextRange.moveStart('character',Start);
  TextRange.select;
end;

procedure Register;
begin
  RegisterComponents('Internet', [TEditWebBrowser]);
end;

initialization
  try OleInitialize(nil); except end;
  EditWebBrowsers:=TEditWebBrowsers.Create(application);
finalization
  try OleUninitialize; except end;
  
end.
Google
 
本站原创作品，未经作者许可，严禁任何方式转载；转载作品，如果侵犯了您的权益，请联系我们！
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
　相关文章
HtmlEdit v0.01 编辑窗控件
register 2007/5/17 下+9172/浏+20002 评+14
HtmlEdit 编辑窗控件
register 2006/5/7 下+3921/浏+18898 评+9
TEditWebBrowser 组件
xcoming 2005/9/1 下+2/浏+21000 评+14
可视化网页编辑DLL(使用微软DHTMLEdit)
redtools 2004/8/11 下+5977/浏+19636 评+9
相关评论
共有评论14条
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表