Board logo

标题: [技术讨论] VBS封装HTML控件,调用IE,搞一套GUI库 [打印本页]

作者: wrove    时间: 2012-12-8 14:57     标题: VBS封装HTML控件,调用IE,搞一套GUI库

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

如题,这是我的设想
作者: wrove    时间: 2012-12-8 18:52

本帖最后由 wrove 于 2012-12-8 18:53 编辑
  1. Set hw=New HtmlWindow
  2. hw.Title="Hello world"
  3. hw.SetGeometry 500,200,300,200
  4. hw.Show
  5. hw.Text="Yes,it's a test!"
  6. MsgBox hw.Text,vbOKOnly,"Text:"
  7. MsgBox hw.Title,vbOKOnly,"Title:"
  8. hw.Close False
  9. Class HtmlWindow
  10. Private ws,fso,file,codes,ie,doc
  11.     Private Sub Class_Initialize   ' 设置 Initialize 事件。
  12.     Set ws=WScript.CreateObject("WScript.Shell")
  13.     Set fso=CreateObject("Scripting.FileSystemObject")
  14.     file=fso.GetAbsolutePathName(fso.GetTempName&".htm")
  15.     Set codes=fso.CreateTextFile(file,True)
  16. HtmlWindow_Init()
  17.     Set ie=WScript.CreateObject("InternetExplorer.Application")
  18.     ie.AddressBar=False
  19.     ie.ToolBar=False
  20.     codes.Close
  21.     Me.Open file  
  22.     End Sub
  23.    
  24.     Private Sub HtmlWindow_Init()
  25.         codes.Write "<HTML>"
  26.     codes.Write "<HEAD>"
  27.     codes.Write "<TITLE id="&Chr(34)&"Title"&Chr(34)&"></TITLE>"
  28.     codes.Write "</HEAD>"
  29.     codes.Write "<BODY>"
  30.     codes.Write "<TEXT id="&Chr(34)&"Text"&Chr(34)&"><TEXT>"
  31.     codes.Write "<BODY>"
  32.     codes.Write "</BODY>"
  33.     End Sub
  34.    
  35.     Public Sub Show()
  36.     ie.Visible=True
  37.     End Sub
  38.    
  39.     Public Sub Refresh()
  40. codes.Close
  41. Me.Open file
  42. End Sub
  43.    
  44.     Public Sub Open(path)
  45.     ie.Navigate fso.GetAbsolutePathName(path)
  46.     Set doc=ie.Document
  47.     End Sub
  48.    
  49.     Public Sub Close(keepHtml)
  50.     Set ws=Nothing
  51.     Set codes=Nothing
  52.     If Not keepHtml Then fso.DeleteFile file
  53.     Set fso=Nothing
  54.     ie.Quit
  55.     End Sub
  56.     Public Property Get Left()
  57.     Left=ie.Left
  58.     End Property
  59.     Public Property Let Left(value)
  60.     If TypeName(value)="Long" Or TypeName(value)="Integer" Then
  61.     ie.Left=value
  62.     End If
  63.     End Property
  64.    
  65.     Public Property Get Top()
  66.     Top=ie.Top
  67.     End Property
  68.     Public Property Let Top(value)
  69.     If TypeName(value)="Long" Or TypeName(value)="Integer" Then
  70.     ie.Top=value
  71.     End If
  72.     End Property
  73.    
  74.     Public Property Get Width()
  75.     Width=ie.Width
  76.     End Property
  77.     Public Property Let Width(value)
  78.     If TypeName(value)="Long" Or TypeName(value)="Integer" Then
  79.     ie.Width=value
  80.     End If
  81.     End Property
  82.    
  83.     Public Property Get Height()
  84.     Height=ie.Height
  85.     End Property
  86.     Public Property Let Height(value)
  87.     If TypeName(value)="Long" Or TypeName(value)="Integer" Then
  88.     ie.Height=value
  89.     End If
  90.     End Property
  91.    
  92.     Public Sub SetPosition(Left,top)
  93.     Me.Left=Left
  94.     Me.Top=top
  95.     End Sub
  96.    
  97.     Public Sub SetSize(width,height)
  98.     Me.Width=width
  99.     Me.Height=height
  100.     End Sub
  101.    
  102.     Public Sub SetGeometry(Left,top,width,height)
  103.     Me.SetPosition Left,top
  104.     Me.SetSize width,height
  105.     End Sub
  106.    
  107.     Public Sub Move(Left,top)
  108.     Me.SetPosition Left,top
  109.     End Sub
  110.    
  111.     Public Property Get Text()
  112.     Text=doc.getElementById("Text").InnerText
  113.     End Property
  114.    
  115.     Public Property Let Text(value)
  116.     doc.getElementById("Text").InnerText=CStr(value)
  117.     End Property
  118.    
  119.     Public Property Get Title()
  120.     Title=doc.getElementById("Title").InnerText
  121.     End Property
  122.     Public Property Let Title(value)
  123.     doc.getElementById("Title").InnerText=CStr(value)
  124.     End Property
  125.    
  126. End Class
复制代码
不过,好像源文件并没有改变,最好的方式是对codes重构,而后Refresh
作者: wrove    时间: 2012-12-8 19:53

可以用Xml组件,修改一次Refresh一次
作者: czjt1234    时间: 2012-12-11 18:30

正好在研究这个,学习下
作者: wrove    时间: 2012-12-16 21:44

还是用HTA吧,HTA内置的支持Javascript和VBScript
作者: wrove    时间: 2012-12-16 23:29

  1. <Html>
  2. <Head>
  3. <Title>My HTML Application</Title>
  4. <HTA:APPLICATION
  5.   APPLICATIONNAME="My HTML Application"
  6.   ID="MyHTMLApplication"
  7.   VERSION="1.0"/>
  8. </Head>
  9. <Script Language="VBScript">
  10. Sub Window_OnLoad
  11. SetGeometry 400,200,500,300
  12. MsgBox "Window Loaded!"
  13. End Sub
  14. Sub Window_OnHelp
  15. MsgBox "Did you need Help?"
  16. End Sub
  17. Sub Window_OnResize
  18. 'ListFolders
  19. '这个执行会出问题,因为Scripting.FileSystemObject是不允许的操作
  20. MsgBox "Window Resized!"
  21. End Sub
  22. Sub Window_OnUnload
  23. MsgBox "Window Unloaded!"
  24. End Sub
  25. Sub ListFolders
  26. Set fso = CreateObject("Scripting.FileSystemObject")
  27. Set folder = fso.GetFolder("E:\")
  28. Set folders = folder.SubFolders
  29. foldersStr="Folders</br>"
  30. For Each folder In folders
  31. foldersStr=foldersStr&folder.Name&"</br>"
  32. Next
  33. document.getElementById("Folders").innerText=foldersStr
  34. End Sub
  35. Sub SetPosition(Left,Top)
  36. Window.MoveTo Left,Top
  37. End Sub
  38. Sub SetSize(Width,Height)
  39. Window.ResizeTo Width,Height
  40. End Sub
  41. Sub SetGeometry(Left,Top,Width,Height)
  42. Window.MoveTo Left,Top
  43. Window.ResizeTo Width,Height
  44. End Sub
  45. Sub MoveToCenter
  46. strComputer = "."
  47. Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
  48. Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
  49. For Each objItem in colItems
  50. intHorizontal = objItem.ScreenWidth
  51. intVertical = objItem.ScreenHeight
  52. Next
  53. intLeft = (intHorizontal - 800) / 2
  54. intTop = (intVertical - 600) / 2
  55. Window.ResizeTo 800,600
  56. Window.MoveTo intLeft, intTop
  57. End Sub
  58. Sub Body_Load
  59. MsgBox "Html body loaded!"
  60. End Sub
  61. Sub Body_BeforeUnload
  62. MsgBox "Event Before Html body unload"
  63. End Sub
  64. </Script>
  65. <Body bgcolor="Green" OnLoad="Body_Load" OnBeforeUnload="Body_BeforeUnload">
  66. <Center>
  67. <p id="Folders"></p>
  68. <p>
  69. HTA程序设计</br></br>
  70. 良好滴结合HTML和VBS或JavaScript脚本</br></br>
  71. 也即脱离浏览器的Html可执行程序</br></br>
  72. 可以用这个来做VBS和JS本地脚本的GUI</br></br>
  73. </p>
  74. <Button OnClick="self.close()" Style="Font-Size:18">退出</Button>
  75. </Center>
  76. </Body>
  77. </Html>
复制代码





欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2