<form method="POST" action="" name="form1">
带参数打印示例<p>
<OBJECT ID="Uxue33"
CLASSID="CLSID:8083B900-B2AD-11D5-9C19-0010D70B5752"
CODEBASE="gxue33/Gxue33.CAB#version=1,0,0,0" width="82" height="34">
<param name="_ExtentX" value="2170">
<param name="_ExtentY" value="900">
<param name="Tname" value="0">
<param name="Thead" value="0">
<param name="Tarray" value="0">
</OBJECT>
文件打印
ActiveX控件制作步骤同上，增加Thead属性（传递文件标题）和Tarray属性（传递文件内容，第一个分解元素为文件内容行数）。
代码：
Option Explicit
Dim pw, ph '纸宽和纸高的坐标
Dim px, py
Dim sp '左边距
Dim table1 '正文开始高度
Dim tax(100, 2) As String
Private Function len1(str As String) As Integer
Dim si, i As Integer
Dim str1 As String
si = 0
For i = 1 To Len(str)
str1 = Mid(str, i, 1)
If Asc(str1) < 0 Then
si = si + 2
Else
si = si + 1
End If
Next
len1 = si
End Function
Private Function midx(taa) As String
Dim ii As Integer
Dim char1 As String
char1 = Mid(taa, 1, 1)
midx = ""
ii = 1
Do While char1 <> "{" And ii <= Len(taa) + 1
midx = midx & char1
ii = ii + 1
char1 = Mid(taa, ii, 1)
Loop
End Function
Private Sub toarray(tt)
Dim ii As Integer
Dim tt0
tax(0, 0) = midx(tt)
tt0 = Mid(tt, Len(tax(0, 0)) + 2, Len(tt))
If tax(0, 0) > 0 Then
For ii = 1 To tax(0, 0)
tax(ii, 1) = midx(tt0)
tt0 = Mid(tt0, Len(tax(ii, 1)) + 2, Len(tt0))
tax(ii, 2) = midx(tt0)
tt0 = Mid(tt0, Len(tax(ii, 2)) + 2, Len(tt0))
'MsgBox tax(ii, 1)
Next ii
End If
End Sub
Private Sub printhead()
Dim pp0, tpp, i
Printer.CurrentX = 150: Printer.CurrentY = 30
Printer.FontSize = 19: Printer.FontBold = True
pp0 = 20 - (len1(Thead))
tpp = ""
For i = 1 To pp0
tpp = tpp + " "
Next i
Printer.Print tpp & Thead
table1 = 70
End Sub
Private Sub printbody() '打印文字
Dim i
Printer.FontSize = 12: Printer.FontBold = False
px = sp: py = table1
For i = 1 To tax(0, 0)
Printer.CurrentX = px: Printer.CurrentY = py
Printer.Print tax(i, 1)
py = py + 20
Next i
End Sub
Private Sub printp()
pw = 850: ph = 600
sp = 40
Printer.Scale (-sp, 0)-(pw, ph)
printhead
printbody
Printer.EndDoc
End Sub
Private Sub Command1_Click()
toarray (Tarray)
printp
MsgBox "打印完毕"
Command1.Enabled = False
End Sub
网页程序为：
<script language="vbscript">
<!--
Option Explicit
Dim Ta0(100, 2)
Private Function len1(str)
Dim si, i
Dim str1
si = 0
For i = 1 To Len(str)
str1 = Mid(str, i, 1)
If Asc(str1) < 0 Then
si = si + 2
Else
si = si + 1
End If
Next
len1 = si
End Function
Private Function tostring()
Dim ii
tostring = Ta0(0, 0) & "{"
For ii = 1 To Ta0(0, 0)
If IsNull(Ta0(ii, 1)) Then Ta0(ii, 1) = ""
tostring = tostring & Ta0(ii, 1) & "{"
tostring = tostring & " {"
Next
End Function
Private Sub window_onload()
form1.Uxue34.Thead = "取水许可证通知书"
Ta0(0, 0) = 8
Ta0(1, 1) = "北京市第9水厂："
Ta0(2, 1) = " 你的取水许可证申请已经通过，请于近期前来我局领取取水许可证。"
Ta0(3, 1) = " "
Ta0(4, 1) = " "
Ta0(5, 1) = " 北京市水利局水资源处"
Ta0(6, 1) = " "
Ta0(7, 1) = "电话：66666666 EMAIL ：ziyuan@jwcb.gov.cn"
Ta0(8, 1) = "地址：海淀区翠微路甲3号 经办人：孟虹"
'Ta0(9, 1) = ""
'Ta0(10, 1) = ""
form1.Uxue34.Tarray = tostring
'MsgBox Uxue34.Tarray
End Sub
-->
</script>
<form method="POST" action="" name="form1">
<OBJECT ID="Uxue34"
CLASSID="CLSID:6502D511-B37F-11D5-9C19-0010D70B5752"
CODEBASE="Gxue34.CAB#version=1,0,0,0" width="82" height="34">
<param name="_ExtentX" value="2170">
<param name="_ExtentY" value="900">
<param name="Tarray" value="0">
<param name="Thead" value="0">
</OBJECT>
十九 编程实例
数据库冗余记录删除
'操作步骤：
'1.运行本程序，输入数据库组名、数据库名；
'2.输入判断冗余的主键的字段序号，第一个为0；
'3.输入表名；
'4.点击“删除”，可以在数据表中删除所有冗余的记录。
如图添加控件：
Option Explicit
Dim cnn As ADODB.Connection '数据库连接
Dim Rst1 As ADODB.Recordset
Dim Rst2 As ADODB.Recordset
Private Sub Command1_Click()
Dim i As Long 'delete records number
Dim j As Long 'records series number
Dim si As String
Dim ts As String 'mast key value
Dim ti As Integer 'mast key position
Dim pi As Long 'progressBar value
Dim ri As Long 'records number
Dim rj As Long
Set cnn = New ADODB.Connection
si = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & _
Text5.Text & ";Data Source=" & Text4.Text
cnn.Open si
Set Rst2 = New ADODB.Recordset
si = "select * from " & Text3.Text
Rst2.Open si, cnn, adOpenDynamic, adLockOptimistic
ti = Text1.Text
ri = 0
While Not Rst2.EOF
Rst2.MoveNext
ri = ri + 1
Wend
i = 0
j = 1
pi = 0
rj = 0
ProgressBar1.Max = ri + 1
ProgressBar1.Min = 0
Rst2.MoveFirst
While Not Rst2.EOF
ts = Rst2.Fields(ti)
If tfind(ts, ti, j, Rst2) Then
Rst2.Delete
i = i + 1
j = j - 1
End If
Rst2.MoveNext
j = j + 1
rj = rj + 1
ProgressBar1.Value = rj
Wend
MsgBox "一共删除了" & i & "条记录。"
End Sub
Function tfind(ii As String, tti As Integer, jj As Long, rst As ADODB.Recordset) As Boolean
Dim bll As Boolean
Dim i As Long
tfind = False
bll = True
i = 0
rst.MoveNext
While Not rst.EOF And bll
If rst.Fields(tti) = ii Then
tfind = True
bll = False
End If
rst.MoveNext
Wend
rst.MoveFirst
For i = 0 To jj - 2
rst.MoveNext
Next i
End Function
Private Sub Command2_Click()
End
End Sub
Private Sub Command3_Click()
Dim si As String
si = "数据库冗余数据删除工具,by xuewei,04/20/2003"
frmSplash.Show
End Sub
Private Sub Form_Load()
Text1.Text = 0
Text3.Text = "biao2"
Text4.Text = "temp"
Text5.Text = "xue01"
End Sub