批处理之家 » VBS求助&讨论 » VBS封装HTML控件，调用IE，搞一套GUI库

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

返回列表发帖

Rank: 1

帖子: 31
积分: 42
技术: 1
捐助: 0
注册时间: 2011-7-27

1楼 跳转到 » 倒序看帖

字体大小: tT

发表于 2012-12-8 14:57 | 只看该作者

[技术讨论] VBS封装HTML控件，调用IE，搞一套GUI库

本帖最后由 wrove 于 2012-12-8 20:00 编辑

如题，这是我的设想

Rank: 1

帖子: 31
积分: 42
技术: 1
捐助: 0
注册时间: 2011-7-27

2楼

发表于 2012-12-8 18:52 | 只看该作者

本帖最后由 wrove 于 2012-12-8 18:53 编辑

Set hw=New HtmlWindow
hw.Title="Hello world"
hw.SetGeometry 500,200,300,200
hw.Show
hw.Text="Yes,it's a test!"
MsgBox hw.Text,vbOKOnly,"Text:"
MsgBox hw.Title,vbOKOnly,"Title:"
hw.Close False
Class HtmlWindow
	Private ws,fso,file,codes,ie,doc
	
   	Private Sub Class_Initialize   ' 设置 Initialize 事件。
    	Set ws=WScript.CreateObject("WScript.Shell")
    	Set fso=CreateObject("Scripting.FileSystemObject")
    	file=fso.GetAbsolutePathName(fso.GetTempName&".htm")
    	Set codes=fso.CreateTextFile(file,True)
		HtmlWindow_Init()
    	Set ie=WScript.CreateObject("InternetExplorer.Application")
    	ie.AddressBar=False
    	ie.ToolBar=False
    	codes.Close
   		Me.Open file  	
   	End Sub
   	
   	Private Sub HtmlWindow_Init()
   	   	codes.Write "<HTML>"
    	codes.Write "<HEAD>"
    	codes.Write "<TITLE id="&Chr(34)&"Title"&Chr(34)&"></TITLE>"
    	codes.Write "</HEAD>"
    	codes.Write "<BODY>"
    	codes.Write "<TEXT id="&Chr(34)&"Text"&Chr(34)&"><TEXT>"
    	codes.Write "<BODY>"
    	codes.Write "</BODY>"
   	End Sub
   	
   	Public Sub Show()
   		ie.Visible=True
   	End Sub
   	
   	Public Sub Refresh()
		codes.Close
		Me.Open file
	End Sub
   	
    Public Sub Open(path)
    	ie.Navigate fso.GetAbsolutePathName(path)
    	Set doc=ie.Document
    End Sub
   	
   	Public Sub Close(keepHtml)
   		Set ws=Nothing
   		Set codes=Nothing
   		If Not keepHtml Then fso.DeleteFile file
   		Set fso=Nothing
   		ie.Quit
   	End Sub

   	Public Property Get Left()
   		Left=ie.Left
   	End Property
   	Public Property Let Left(value)
	   	If TypeName(value)="Long" Or TypeName(value)="Integer" Then 
	   		ie.Left=value
	   	End If
   	End Property
   	
   	Public Property Get Top()
   		Top=ie.Top
   	End Property
   	Public Property Let Top(value)
	   	If TypeName(value)="Long" Or TypeName(value)="Integer" Then
	   		ie.Top=value
	   	End If
   	End Property
   	
   	Public Property Get Width()
   		Width=ie.Width
   	End Property
   	Public Property Let Width(value)
	   	If TypeName(value)="Long" Or TypeName(value)="Integer" Then
	   		ie.Width=value
	   	End If
   	End Property
   	
   	Public Property Get Height()
   		Height=ie.Height
   	End Property
   	Public Property Let Height(value)
	   	If TypeName(value)="Long" Or TypeName(value)="Integer" Then
	   		ie.Height=value
	   	End If
   	End Property 
   	
   	Public Sub SetPosition(Left,top)
   		Me.Left=Left
   		Me.Top=top
   	End Sub
   	
   	Public Sub SetSize(width,height)
   		Me.Width=width
   		Me.Height=height
   	End Sub
   	
   	Public Sub SetGeometry(Left,top,width,height)
   		Me.SetPosition Left,top
   		Me.SetSize width,height
   	End Sub
   	
   	Public Sub Move(Left,top)
   		Me.SetPosition Left,top
   	End Sub
   	
   	Public Property Get Text()
   		Text=doc.getElementById("Text").InnerText
   	End Property
   	
   	Public Property Let Text(value)
   		doc.getElementById("Text").InnerText=CStr(value)
   	End Property
   	
   	Public Property Get Title()
   		Title=doc.getElementById("Title").InnerText
   	End Property
   	Public Property Let Title(value)
   		doc.getElementById("Title").InnerText=CStr(value)
   	End Property
   	
End Class
复制代码

不过，好像源文件并没有改变，最好的方式是对codes重构，而后Refresh

Rank: 1

帖子: 31
积分: 42
技术: 1
捐助: 0
注册时间: 2011-7-27

3楼

发表于 2012-12-8 19:53 | 只看该作者

可以用Xml组件，修改一次Refresh一次

Rank: 6 Rank: 6

帖子: 1048
积分: 1549
技术: 112
捐助: 0
注册时间: 2010-4-30

4楼

发表于 2012-12-11 18:30 | 只看该作者

正好在研究这个，学习下

QQ 20147578

Rank: 1

帖子: 31
积分: 42
技术: 1
捐助: 0
注册时间: 2011-7-27

5楼

发表于 2012-12-16 21:44 | 只看该作者

还是用HTA吧，HTA内置的支持Javascript和VBScript

Rank: 1

帖子: 31
积分: 42
技术: 1
捐助: 0
注册时间: 2011-7-27

6楼

发表于 2012-12-16 23:29 | 只看该作者

<Html>
<Head>
<Title>My HTML Application</Title>
<HTA:APPLICATION
  APPLICATIONNAME="My HTML Application"
  ID="MyHTMLApplication"
  VERSION="1.0"/>
</Head>
<Script Language="VBScript">

Sub Window_OnLoad
	SetGeometry 400,200,500,300
	MsgBox "Window Loaded!"
End Sub

Sub Window_OnHelp
	MsgBox "Did you need Help?"
End Sub

Sub Window_OnResize
	'ListFolders
	'这个执行会出问题，因为Scripting.FileSystemObject是不允许的操作
	MsgBox "Window Resized!"
End Sub

Sub Window_OnUnload
	MsgBox "Window Unloaded!"
End Sub

Sub ListFolders
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set folder = fso.GetFolder("E:\")
	Set folders = folder.SubFolders
	foldersStr="Folders</br>"
	For Each folder In folders
		foldersStr=foldersStr&folder.Name&"</br>"
	Next
	document.getElementById("Folders").innerText=foldersStr
End Sub

Sub SetPosition(Left,Top)
	Window.MoveTo Left,Top
End Sub

Sub SetSize(Width,Height)
	Window.ResizeTo Width,Height
End Sub

Sub SetGeometry(Left,Top,Width,Height)
	Window.MoveTo Left,Top
	Window.ResizeTo Width,Height
End Sub

Sub MoveToCenter
	strComputer = "."
	Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
	For Each objItem in colItems
		intHorizontal = objItem.ScreenWidth
		intVertical = objItem.ScreenHeight
	Next
	intLeft = (intHorizontal - 800) / 2
	intTop = (intVertical - 600) / 2
	Window.ResizeTo 800,600
	Window.MoveTo intLeft, intTop
End Sub 

Sub Body_Load
	MsgBox "Html body loaded!"
End Sub

Sub Body_BeforeUnload
	MsgBox "Event Before Html body unload"
End Sub
</Script>
<Body bgcolor="Green" OnLoad="Body_Load" OnBeforeUnload="Body_BeforeUnload">
<Center>
<p id="Folders"></p>
<p>
HTA程序设计</br></br>
良好滴结合HTML和VBS或JavaScript脚本</br></br>
也即脱离浏览器的Html可执行程序</br></br>
可以用这个来做VBS和JS本地脚本的GUI</br></br>
</p>
<Button OnClick="self.close()" Style="Font-Size:18">退出</Button> 
</Center>
</Body>
</Html>
复制代码