TWEbbrowser带背景图

quasiceo 2012-12-24

展开全文

具体代码如下；你建立一个Application，直接覆盖Form1的所有代码编译即可运行。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SHDocVw, ActiveX; //加入ShdocVw,ActiveX

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    procedure OnMessage(var Msg: TMsg; var Handled: Boolean); //处理按键，因为这个是vcl封装TWebBrowser的bug.
  end;

var
  Form1: TForm1;
  MyEditor: TWebBrowser;  //这里是变量
implementation

{$R *.dfm}

//直接修改浏览器内容函数
procedure WB_LoadHTML(WebBrowser: TWebBrowser; HTMLCode: string);
var
  sl: TStringList;
  ms: TMemoryStream;
begin

  if Assigned(WebBrowser.Document) then
  begin
    sl := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        sl.Text := HTMLCode;
        sl.SaveToStream(ms);
        ms.Seek(0, 0);
        (WebBrowser.Document as
          IPersistStreamInit).Load(TStreamAdapter.Create(ms));
      finally
        ms.Free;
      end;
    finally
      sl.Free;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  backgroundImagePath: string; //背景图象路径
begin

  Application.OnMessage := OnMessage;
  MyEditor := TWebBrowser.Create(self); //创建
  MyEditor.ParentWindow := Handle;
  MyEditor.SetBounds(0, 0, 400, 400); //设置大小
  ///// 必须定向到空白页 //////////
  MyEditor.Navigate('about:blank');
  while MyEditor.ReadyState < READYSTATE_INTERACTIVE do
    Application.ProcessMessages; //等待完成
  ///// 修改为可编辑模式 //////////
  MyEditor.OleObject.document.designMode := 'On';
  //你的背景图片路径
  backgroundImagePath := 'F:\p.项目_Projects\模拟Word\1.jpg';
  //这里设置了2个图片
  //1.是按流模式增加的图象，和word插入图片一样
  //2.是背景图片，按绝对定位，在文字下方
  WB_LoadHtml(MyEditor,
    '<html><body style="font-size:12px;margin:0px;"><img src="' + backgroundImagePath
      + '" /><img style="position: absolute;left:100px;top:43px;z-index:-999" src="' + backgroundImagePath
      + '" /></body></html>');
  MyEditor.Show;

end;

procedure TForm1.OnMessage(var Msg: TMsg; var Handled: Boolean);
const
  StdKeys = [VK_TAB, VK_RETURN];
  ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT];
  fExtended = $01000000;
var
  WebBrowser1: TWebBrowser;
begin

  WebBrowser1 := MyEditor;
  Handled := False;
  with Msg do
    if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
      ((wParam in StdKeys) or
{$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}
      (wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
    try
      if IsChild(WebBrowser1.Handle, hWnd) then
      begin
        with WebBrowser1.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 TForm1.FormDestroy(Sender: TObject);
begin
  Application.OnMessage := nil;
  MyEditor.Free;
end;

//////访问activex 时需要的处理
initialization
  OleInitialize(nil);
finalization
  try
    OleUninitialize;
  except
  end;

end.