VB6.0 基于ewededitor4.8商业版扩展功能——屏幕截图自动保存功能开发笔记

制作思路：

　　编写一个截图控件，通过javascript在网页中调用这个控件，完成截图后，将保存在本地的截图的本地地址传给Ewebeditor,再调用ewebeditor的本地上传功能，实现自动上传。

一、截图控件的开发 Activex Dll

本控件是选用从CSDN下载的“VB模拟QQ截屏”修改而来的

以下是开发步骤：

第一步，新建一个ActiveX dll 工程 名为 "WebCapture"

第二步，将下列四个文件拷贝到新建工程目录下并添加到新工程里 （以下文件都是“VB模拟QQ截屏”这个工程里的）

Excelpropertybag.cls

模拟QQ截屏.frm

模拟QQ截屏.frx

ModSavePic.bas

第三步，添加一个窗口Form1，添加一个类模块儿Capture

第四步，编写WebCapture类

'添加一个属性 用来返回截图的本地地址

Private mvarTempPath As String '局部复制
Public Property Let TempPath(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.TempPath = 5
mvarTempPath = vData
End Property

Public Property Get TempPath() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.TempPath
TempPath = mvarTempPath
End Property

'添加一个方法 用于启动屏幕截图

Public Sub ShowForm()
Form1.Show vbModal
TempPath = VB模拟QQ截屏.TempPath
End Sub

第五步，设计Form1，并编写代码

'按钮按下开始截图

Private Sub Command1_Click()
VB模拟QQ截屏.Show vbModal 'vbModal一定要加，否则网中调用时会报错无权限

Unload Me

End Sub

第六步，修改VB模拟QQ截屏窗体的代码

'定义一个全局变量用于传递截图的本地地址

Public TempPath As String

'--------------------保存截图-----------------------------------------

'修改 CutdSave()过程，将使用保存对话框保存截图改为按指定路径保存

‘-------------------------------------------------------------------------
Public Function CutdSave()
Dim sFile As String
Dim PicType As String
'Dim SaveOpen As OPENFILENAME
'SaveOpen.lStructSize = Len(SaveOpen)
'SaveOpen.hwndOwner = 0&
'SaveOpen.lpstrFile = String$(255,0)
'SaveOpen.nMaxFile = 255
'SaveOpen.lpstrInitialDir = App.Path
'SaveOpen.lpstrFilter = "PNG文件(*.PNG)" + Chr$(0) + "*.PNG" + Chr$(0) + "JPEG文件(*.jpg;*.jpeg)" + Chr$(0) + "*.jpg" + Chr$(0) + "位图文件(*.bmp)" + Chr$(0) + "*.bmp" + Chr$(0) + "GIF文件(*.gif)" + Chr$(0) + "*.gif" + Chr$(0) + "TIFF文件(*.TIFF)" + Chr$(0) + "*.tiff" + Chr$(0) + "所有文件(*.*)" + Chr$(0) + "*.*" + Chr$(0)
' SaveOpen.lpstrTitle = "保存为"
'SaveOpen.nFilterIndex = 1 '设置默认选择扩展类型
'SaveOpen.lpstrDefExt = "PNG" '初始化扩展名
'SaveOpen.lpstrFile = FileName '保存文件名称
'If GetSaveFileName(SaveOpen) <> 0 Then
'sFile = Left(SaveOpen.lpstrFile,InStr(SaveOpen.lpstrFile,Chr$(0)) - 1)
'Else
' Exit Function
'End If
'SavePicture Clipboard.GetData(),sFile
sFile = "c:/" & Replace(Date,"-","") & Replace(Time,":","") & ".png"
PicType = Right(sFile,Len(sFile) - InStrRev(sFile,"."))
VB模拟QQ截屏.TempPath = sFile
SavePic Clipboard.GetData(),sFile,PicType
Clipboard.Clear ' 清除剪贴板
End Function

第七步，生成 WebCapture.dll 文件

第八步，注册 WebCapture.dll 文件

将WebCapture.dll文件复制到 System32 文件夹

开始->运行->regsvr32 WebCapture.dll

二，在网页中调用测试

<script type="text/javascript">
function cp()
{

'
var O = new ActiveXObject("WebCapture.Capture");O.ShowForm();var p = O.TempPath;eWebeditor1.insertHTML("<img src="+p+">");}</script><textarea id="content" style="display:none">sdsdsd</textarea><IFRAME ID="eWebeditor1" src="ewebeditor.htm?id=content&style=mini" frameborder="0" scrolling="no" width="550" height="350"></IFRAME>

原文地址：https://www.jb51.cc/vb/262160.html