delphi 嵌入网页中的相关操作

应用程序通过内嵌浏览器的方式，利用js的window.external可以达到控制窗体行为的效果，如控制窗体宽高大小，透明度，网页截屏，网页读写文件，网页控制桌面行为等，最近利用DELPHI就实现了这一点，一般软件可以是很小巧，2，3百K的样子，如果大家有谁需要的，我将无偿提供这方面的源代码，因为这方面的应用目前还不是很广（QQ Zone用的这样的技术），所以我就不在这里给出代码了。我扩展的window.external函数如下：

Pascal核心代码片段：

unit CusExternal;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows,ComObj, ActiveX, tlink_TLB, StdVcl,CoolTrayIcon,forms,SysUtils,Dialogs;



type
  TTBrowserToDelphi = class(TAutoObject, ITBrowserToDelphi)
  protected
    procedure setWndTitle(title: OleVariant); safecall;
    procedure modifyWndSize(w, h: OleVariant); safecall;
    procedure flashIcon; safecall;
    procedure popHint(str, title: OleVariant); safecall;
    procedure closeWnd; safecall;
    procedure setIconTitle(title: OleVariant); safecall;
    procedure setSb(i: Integer; title: OleVariant); safecall;
    procedure setSbWidth(i, w: Integer); safecall;
    procedure popHintAdv(str, title: OleVariant; style, secs: Integer);
      safecall;
    procedure formTitleControl(flag: Integer); safecall;
    function showMessage(flag: Integer; hit: OleVariant;
      iconflag: Integer): OleVariant; safecall;
    procedure minTotray; safecall;
    procedure moveBtnPos(sleft, stop, swidth, sheight, isVisible: Integer);
      safecall;
    function getMinStatus: OleVariant; safecall;
    function cameraScreen(flag: Integer): OleVariant; safecall;
    procedure speak(str: OleVariant); safecall;
    function uploadToFtp(remoteAddr, localPath: OleVariant): OleVariant;
      safecall;
  end;

implementation


uses ComServ,login;

var
  iflag:boolean=true;

procedure TTBrowserToDelphi.setWndTitle(title: OleVariant);
begin
   mainForm.Caption:=title;
end;

procedure TTBrowserToDelphi.modifyWndSize(w, h: OleVariant);
begin
    mainForm.Width:=w;
    mainForm.Height:=h;
    mainForm.Position:=poScreenCenter;
    mainForm.Update;
end;

procedure TTBrowserToDelphi.flashIcon;
begin
      mainForm.CoolTrayIcon1.IconList := mainForm.ImageList1;
      mainForm.CoolTrayIcon1.CycleInterval := 400;
      mainForm.CoolTrayIcon1.CycleIcons := True;
end;

procedure TTBrowserToDelphi.popHint(str, title: OleVariant);
begin
     mainForm.CoolTrayIcon1.ShowBalloonHint(title,
        str,
        bitInfo, 10);
end;

procedure TTBrowserToDelphi.closeWnd;
begin
    //mainForm.Close;
    Application.Terminate;
end;

procedure TTBrowserToDelphi.setIconTitle(title: OleVariant);
begin
    mainForm.CoolTrayIcon1.Hint:=title;
end;

procedure TTBrowserToDelphi.setSb(i: Integer; title: OleVariant);
begin
    if(i>1) then i:=1;
    mainForm.sb.Panels[i].Text:=title;
end;

procedure TTBrowserToDelphi.setSbWidth(i, w: Integer);
begin
    if(i>1) then i:=1;
    mainForm.sb.Panels[i].Width:=w;
end;

procedure TTBrowserToDelphi.popHintAdv(str, title: OleVariant; style,
  secs: Integer);
begin
     if secs<1 then secs:=1
     else if secs>100 then secs:=100
     else ;

     mainForm.Timer1.Interval:= secs*1000;
     mainForm.Timer1.Enabled:=true;

     if style = 1 then
       mainForm.CoolTrayIcon1.ShowBalloonHint(title,
        str,
        bitError, secs)
     else if style = 2 then
       mainForm.CoolTrayIcon1.ShowBalloonHint(title,
        str,
        bitWarning, secs)
     else if style=3 then
        mainForm.CoolTrayIcon1.ShowBalloonHint(title,
        str,
        bitNone, secs)
     else
     mainForm.CoolTrayIcon1.ShowBalloonHint(title,
        str,
        bitInfo, secs);

     //mainForm.CoolTrayIcon1.HideBalloonHint;
end;

procedure TTBrowserToDelphi.formTitleControl(flag: Integer);
begin
   if(flag=0) then
   begin
     with mainform do
     begin
       SetWindowLong(Handle,                   // 当前窗体句柄
                GWL_STYLE,                // 表示当前是要设置新的窗体（普通）样式
                // 得到指定窗体信息
                GetWindowLong(Handle, GWL_STYLE)
                  and (not WS_CAPTION));  // 去掉样式(s)中的“标题”样式
       Height := ClientHeight;
       Width := ClientWidth;
     end;
   end
   else if(flag=2) then
       mainForm.BorderStyle:=bsDialog
   else if(flag=3) then
       mainForm.BorderStyle:=bsSingle
   else if(flag=4) then //窗口获得焦点
   begin
       if(not mainForm.IsMinimized) then
       begin
         SetForegroundWindow(mainForm.Handle);
       end
       else
       begin
         with mainForm do
         begin
           FloatRectangles(False, True);
           CoolTrayIcon1.ShowMainForm;
           IsMinimized := False;
         end;
       end;
   end
   else if(flag=5) then //停止闪烁
   begin
       mainForm.CoolTrayIcon1.Icon:=Application.Icon;
       mainForm.CoolTrayIcon1.CycleIcons:=false
   end
   else if(flag=6) then   //任务栏闪烁
     mainForm.FlashMe
   else
       ;
end;

function TTBrowserToDelphi.showMessage(flag: Integer; hit: OleVariant;
  iconflag: Integer): OleVariant;
begin
  if(not iflag) then exit;

  iflag:=false;//锁定函数

  if(flag=0) then     //无返回值提醒
  begin
     if iconflag=1 then
       messagedlg(hit,mterror,[mbok],0)
     else if iconflag=2 then
       messagedlg(hit,mtwarning,[mbok],0)
     else
       messagedlg(hit,mtinformation,[mbok],0);
     result:=0;
  end
  else
  begin
    if(iconflag=1) then //yes+no+cancel
      result:=messagedlg(hit,mtConfirmation,[mbyes,mbno,mbcancel],0)
    else if(iconflag=2) then //ok+cancel
      result:=messagedlg(hit,mtConfirmation,[mbok,mbcancel],0)
    else if(iconflag=3) then //ignore+retry+cancel
      result:=messagedlg(hit,mtConfirmation,[mbIgnore,mbRetry,mbcancel],0)
    else
      result:=messagedlg(hit,mtConfirmation,[mbyes,mbno],0);
  end;

  iflag:=true;//释放锁定
  //result:=1;
end;



procedure TTBrowserToDelphi.minTotray;
begin
  with mainform do
  begin
        FloatRectangles(True, True);
        CoolTrayIcon1.HideMainForm;
        IsMinimized:=true;
  end;
end;



procedure TTBrowserToDelphi.moveBtnPos(sleft, stop, swidth, sheight,
  isVisible: Integer);
begin
    with mainform do
    begin
      bitbtn1.Width:=swidth;
      bitbtn1.Height:=sheight;
      bitbtn1.Left:=sleft;
      bitbtn1.Top:=stop;
      if(isVisible=1) then
        bitbtn1.Visible:=true
      else
        bitbtn1.visible:=false;
    end;
end;

function TTBrowserToDelphi.getMinStatus: OleVariant;
begin
    result:=mainform.IsMinimized;
end;

function TTBrowserToDelphi.cameraScreen(flag: Integer): OleVariant;
begin
   result:=mainform.jp(flag);
end;

procedure TTBrowserToDelphi.speak(str: OleVariant);
begin
   mainForm.Speak(str);
end;

function TTBrowserToDelphi.uploadToFtp(remoteAddr,
  localPath: OleVariant): OleVariant;
var
  str1,str2:string;
begin
  str1:= remoteAddr;
  str2:= localPath;
  result:=mainForm.uploadToFtp2(pchar(str1),pchar(str2));
end;

initialization
  TAutoObjectFactory.Create(ComServer, TTBrowserToDelphi, Class_TBrowserToDelphi,
    ciMultiInstance, tmApartment);
end.

 

HTML接口代码：

<HTML>
<HEAD>
<TITLE> New Document </TITLE>
<meta http-equiv="Content-Type" content="text/html;charset=gb2312">
<title> New Document </title>
<meta name="Generator" content="EditPlus">
<meta name="Author" content="Neil Chen(木野狐)">
<meta name="keywords" content="">
<meta name="description" content="">
<script>
  function pop(arg)
  {
   //返回值说明：6：点击yes  7：点击no 2:点击cancel  1：点击ok  4：点击retry  5：点击ignore
   var ret=window.external.showMessage(1,'询问1',arg);
   alert(ret);
   var str="pop('"+arg+"')";
   setTimeout(str,3000);
  }
  function isMin()
  {
    var ismin=window.external.getMinStatus();
    alert(ismin);
    setTimeout("isMin()",3000);
  }
  function winFocus()
  {
    setTimeout("aa()",3000);
  }
  function aa()
  {
    window.external.formTitleControl(4);
  }
  function jp(flag)
  {
    var ii=window.external.cameraScreen(flag);
    var str;
    if(ii!="")
        {
          str=window.external.uploadToFtp('/uploadfiles/jt/',ii);
          alert(str);
          //window.open('sendpic.html');
        }
    else
        alert("用户取消操作");
  }
</script>
</HEAD>
<BODY>
<BUTTON ONCLICK="window.external.modifyWndSize(800,600)">调整大小600*400</BUTTON>
<BUTTON ONCLICK="window.external.modifyWndSize(300,200)">调整大小300*200</BUTTON>
<BUTTON ONCLICK="window.external.setWndTitle('我是标题')">标题</BUTTON>
<BUTTON ONCLICK="window.external.flashIcon()">图标闪烁</BUTTON>
<BUTTON ONCLICK="window.external.popHint('我是内容','我是标题')">POP提示</BUTTON>
<BUTTON ONCLICK="window.external.popHintAdv('我是内容','我是标题',0,3)">信息图标POP提示3秒</BUTTON>
<BUTTON ONCLICK="window.external.popHintAdv('我是内容','我是标题',1,4)">错误图标POP提示4秒</BUTTON>
<BUTTON ONCLICK="window.external.popHintAdv('我是内容','我是标题',2,6)">警告图标POP提示6秒</BUTTON>
<BUTTON ONCLICK="window.external.popHintAdv('我是内容','我是标题',3,20)">无图标POP提示20秒</BUTTON>
<BUTTON ONCLICK="window.external.closeWnd()">关闭程序</BUTTON>
<BUTTON ONCLICK="window.external.setIconTitle('我是图标标题哦')">图标标题</BUTTON>
<BUTTON ONCLICK="window.external.setSb(0,'提示信息')">状态栏文字信息1</BUTTON>
<BUTTON ONCLICK="window.external.setSb(1,'设置第一个状态栏文字2222')">状态栏文字信息2</BUTTON>
<BUTTON ONCLICK="window.external.setSbWidth(0,200)">设置状态栏宽度</BUTTON>
<BUTTON ONCLICK="window.external.formTitleControl(0)">窗口无标题栏型</BUTTON>
<BUTTON ONCLICK="window.external.formTitleControl(3)">窗口普通型</BUTTON>
<BUTTON ONCLICK="window.external.formTitleControl(2)">窗口对话框型</BUTTON>

<BUTTON ONCLICK="window.external.showMessage(0,'提示1',2)">无返回值提示对话框警告图标</BUTTON>
<BUTTON ONCLICK="window.external.showMessage(0,'提示2',1)">无返回值提示对话框错误图标</BUTTON>
<BUTTON ONCLICK="window.external.showMessage(0,'提示3',0)">无返回值提示对话框信息图标</BUTTON>
<BUTTON ONCLICK="pop(0)">yes+no询问对话框</BUTTON>
<BUTTON ONCLICK="pop(1)">yes+no+cancel询问对话框</BUTTON>
<BUTTON ONCLICK="pop(2)">ok+cancel询问对话框</BUTTON>
<BUTTON ONCLICK="pop(3)">ignore+retry+cancel询问对话框</BUTTON>

<BUTTON ONCLICK="window.external.minTotray()">窗口最小化到托盘</BUTTON>

<BUTTON ONCLICK="isMin()">获取最小化状态</BUTTON>

<BUTTON ONCLICK="winFocus()">窗口获取焦点</BUTTON>

<BUTTON ONCLICK="window.external.formTitleControl(5)">托盘图标停止闪烁</BUTTON>

<BUTTON ONCLICK="window.external.formTitleControl(6)">任务栏闪烁</BUTTON>


<BUTTON ONCLICK="jp(0)">普通截屏</BUTTON>
<BUTTON ONCLICK="jp(1)">屏幕截屏</BUTTON>
<BUTTON ONCLICK="jp(2)">软件截屏</BUTTON>

<BUTTON ONCLICK="window.external.speak('Welcome to you!')">我要说话（英文提示语）</BUTTON>
<BUTTON ONCLICK="window.external.speak('欢迎您使用!')">我要说话（中文提示语）</BUTTON>

<BUTTON ONCLICK="window.external.speak('欢迎您使用!')">我要说话（中文提示语）</BUTTON>

</BODY>
</HTML>