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

前端之家收集整理的这篇文章主要介绍了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.f2er.com/vb/262160.html

猜你在找的VB相关文章