px = px + daima(pxi, 2) * ww
Printer.Line (px, pp1)-(px, py)
Next
Printer.FontBold = False
py = pp1 + wh
For bi = pp2 To pp3
px = 0
For pxi = 1 To ti
Printer.CurrentX = px + 2
Printer.CurrentY = py + Int(0.2 * wh)
daim1 = daima(pxi, 3)
daim2 = dai1(bi, daim1)
Printer.Print len2(daim2, Int(daima(pxi, 2)))
px = px + daima(pxi, 2) * ww
Next pxi
Printer.Line (0, py)-(pxm, py)
py = py + wh
rst1.MoveNext
Next bi
End Sub
Sub printfoot(pp1 As Integer, pp2 As Integer)
px = pw - 300: py = ph - 5 * wh
Printer.CurrentX = px: Printer.CurrentY = py
Printer.Print "总页数:" & pp2 & " 当前页数:" & pp1
End Sub
Sub printail(ByVal p1 As Integer, p2 As Integer, p3 As Integer, p4 As Integer, p5 As Integer)
Call printframe(p1, p2, p3)
Call printfoot(p4, p5)
End Sub
Sub printbody()
Dim page As Integer
Dim pi As Integer
Dim p1y As Integer
Dim p2y As Integer 'first page lines and other page lines
Dim table2
p2y = 37 '44
table2 = 20
table1 = table1 + wh
p1y = (ph - table1 - 100) / wh
rst1.MoveFirst
If bnum < p1y + 1 Then
Call printail(table1, 1, bnum, 1, 1)
Else
page = Int(((bnum - p1y) / p2y) + 1.9999)
Call printail(table1, 1, p1y, 1, page)
If page > 2 Then
For pi = 1 To page - 2
Printer.NewPage
Call printail(table2, p1y + (pi - 1) * p2y + 1, p1y + pi * p2y, pi + 1, page)
Next pi
Printer.NewPage
Call printail(table2, p1y + (page - 2) * p2y + 1, bnum, page, page)
Else
Printer.NewPage
Call printail(table2, p1y + 1, bnum, page, page)
End If
End If
End Sub
Sub printp()
Dim sp
pw = 850: ph = 600
wh = 13
ww = 9
sp = 40
Printer.Scale (-sp, 0)-(pw, ph)
printhead
printbody
Printer.EndDoc
End Sub
Private Sub Command1_Click()
bnum = rst1.RecordCount
finput
finput2
printp
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim str1, strcnn
strcnn = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;" & _
"Data Source=" & fpath1 & "shukux.mdb"
Set cnn2 = New ADODB.Connection
cnn2.Open strcnn
Set rst1 = New ADODB.Recordset
rst1.CursorType = adOpenKeyset
rst1.LockType = adLockOptimistic
rst1.Open "shu00", cnn2, , , adCmdTable
End Sub
用数组打印报表
建立模块Module1：
Dim wh, ww 'word height and width
Dim pw, ph, px, py As Integer
Dim table1 '第一页表格起始位置
Dim pxm '表宽
Sub printhead()
Dim i
'计算表宽
pxm = 0
For i = 0 To txI - 1
pxm = pxm + tx(i, 2) * ww
Next
'打印标题
table1 = 0
For i = 0 To tyI - 1
Printer.FontName = ty(i, 0)
Printer.FontSize = ty(i, 1)
Printer.FontBold = ty(i, 2)
Printer.CurrentX = ty(i, 3)
Printer.CurrentY = ty(i, 4)
Printer.Print ty(i, 5)
table1 = ty(i, 4)
'画下划线
If ty(i, 6) = 1 Then
Printer.DrawWidth = 2
Printer.Line (0, table1 + 10)-(pxm, table1 + 10)
End If
Next
End Sub
Sub printa(ByVal p1 As Integer, p2 As Integer, p3 As Integer, p4 As Integer, p5 As Integer)
Dim py1 As Integer
Dim pxi, px1, bi
Dim daim1, daim2 As String
'打印表格线
Printer.DrawWidth = 3
py = p1 + (p3 + 2 - p2) * wh
Printer.Line (0, p1)-(pxm, p1)
Printer.Line (pxm, p1)-(pxm, py)
Printer.Line (pxm, py)-(0, py)
Printer.Line (0, py)-(0, p1)
'打印表头
Printer.DrawWidth = 1
Printer.FontSize = 11
Printer.FontBold = True
px = 0
For pxi = 0 To txI - 1
daim2 = tx(pxi, 1)
px1 = Int((tx(pxi, 2) - len1(daim2)) / 2)
Printer.CurrentX = px + px1 * ww
Printer.CurrentY = p1 + Int(0.2 * wh)
Printer.Print tx(pxi, 1)
px = px + tx(pxi, 2) * ww
Printer.Line (px, p1)-(px, py)
Next
'打印表格内容
Printer.FontBold = False
py = p1 + wh
For bi = p2 To p3
px = 0
For pxi = 0 To txI - 1
Printer.CurrentX = px + 2
Printer.CurrentY = py + Int(0.2 * wh)
daim1 = tx(pxi, 3)
daim2 = tz(bi - 1, daim1)
Printer.Print daim2 'len2(daim2, Int(tx(pxi, 2)))
px = px + tx(pxi, 2) * ww
Next pxi
Printer.Line (0, py)-(pxm, py)
py = py + wh
Next bi
'打印页码
px = Int(0.6 * pw): py = ph - 7 * wh
Printer.CurrentX = px: Printer.CurrentY = py
Printer.Print "总页数:" & p5 & " 当前页数:" & p4
End Sub
Sub printbody()
Dim page As Integer
Dim pi As Integer
Dim p1y As Integer
Dim p2y As Integer 'first page lines and other page lines
Dim table2
'p2y = 38
table2 = 0
table1 = table1 + wh
p1y = (ph - table1 - 115) / wh
p2y = (ph - 115) / wh
MsgBox p2y
If tzI < p1y + 1 Then
Call printa(table1, 1, tzI, 1, 1)
Else
page = Int(((tzI - p1y) / p2y) + 1.9999)
Call printa(table1, 1, p1y, 1, page)
If page > 2 Then
For pi = 1 To page - 2
Printer.NewPage
Call printa(table2, p1y + (pi - 1) * p2y + 1, p1y + pi * p2y, pi + 1, page)
Next pi
Printer.NewPage
Call printa(table2, p1y + (page - 2) * p2y + 1, tzI, page, page)
Else
Printer.NewPage
Call printa(table2, p1y + 1, tzI, page, page)
End If
End If
End Sub
Sub printp()
Dim sp
If tzI < 1 Then Exit Sub
pw = 850: ph = 600
wh = 13
ww = 9
sp = 40
Printer.Scale (0, 0)-(pw, ph)
printhead
printbody
Printer.EndDoc
End Sub
在其它模块中调用时，只要先给出tx，ty，tz数组值和txI，tyI，tzI，再调用Module1.printp即可。例如：
Sub tabledatax()
txI = 10 ‘10列
tx(0, 1) = "序号" ‘表标题
tx(0, 2) = 4 ‘表宽(4个字)
tx(0, 3) = 0 ‘序号
tx(1, 1) = "代码"
tx(1, 2) = 8
tx(1, 3) = 1
tx(2, 1) = "库位号"
tx(2, 2) = 8
tx(2, 3) = 2
tx(3, 1) = "单价"
tx(3, 2) = 7
tx(3, 3) = 3
tx(4, 1) = "书 名"
tx(4, 2) = 33
tx(4, 3) = 4
tx(5, 1) = "册数"
tx(5, 2) = 6
tx(5, 3) = 5
tx(6, 1) = "码洋"
tx(6, 2) = 7
tx(6, 3) = 6
tx(7, 1) = "折扣"
tx(7, 2) = 5
tx(7, 3) = 7
tx(8, 1) = "实洋"
tx(8, 2) = 7
tx(8, 3) = 8
tx(9, 1) = "包+册"
tx(9, 2) = 8
tx(9, 3) = 9
End Sub
Sub tabledatay()
Dim px1, px2, px3, py
Dim wh0
wh0 = 10
tyI = 10
px1 = 20
px2 = 370
px3 = 620
ty(0, 0) = "宋体" ‘字体
ty(0, 1) = 17 ‘字号
ty(0, 2) = 1 ‘加粗
ty(0, 3) = 180 ‘Current X
ty(0, 4) = 10 ‘Current Y
ty(0, 5) = "中国水利水电出版社批销业务清单"
ty(0, 6) = 0 ‘是否加线
py = 30
ty(1, 0) = "宋体"
ty(1, 1) = 10
ty(1, 2) = 0
ty(1, 3) = px1
ty(1, 4) = py
ty(1, 5) = "处理单号: " & clh
ty(1, 6) = 0
ty(2, 0) = "宋体"
ty(2, 1) = 10
ty(2, 2) = 0
ty(2, 3) = px2
ty(2, 4) = py
ty(2, 5) = "制单日期: 20" & ddate
ty(2, 6) = 0
ty(3, 0) = "宋体"
ty(3, 1) = 10
ty(3, 2) = 0
ty(3, 3) = px3
ty(3, 4) = py
ty(3, 5) = "提书单编号: " & numb
ty(3, 6) = 1 ‘加下划线
py = py + 20
ty(4, 0) = "宋体"
ty(4, 1) = 10
ty(4, 2) = 0
ty(4, 3) = px1
ty(4, 4) = py
ty(4, 5) = "购货单位: " & len2(uname, 36)
ty(4, 6) = 0
ty(5, 0) = "宋体"
ty(5, 1) = 10
ty(5, 2) = 0
ty(5, 3) = px2
ty(5, 4) = py
ty(5, 5) = "总册数: " & zce
ty(5, 6) = 0
ty(6, 0) = "宋体"
ty(6, 1) = 10
ty(6, 2) = 0
ty(6, 3) = px3
ty(6, 4) = py
ty(6, 5) = "制单人: "
ty(6, 6) = 0
py = py + wh0
ty(7, 0) = "宋体"
ty(7, 1) = 10
ty(7, 2) = 0
ty(7, 3) = px1
ty(7, 4) = py
ty(7, 5) = "地址: " & add
ty(7, 6) = 0
ty(8, 0) = "宋体"
ty(8, 1) = 10
ty(8, 2) = 0
ty(8, 3) = px2
ty(8, 4) = py
ty(8, 5) = "总码洋: " & zma
ty(8, 6) = 0
ty(9, 0) = "宋体"
ty(9, 1) = 10
ty(9, 2) = 0
ty(9, 3) = px3
ty(9, 4) = py
ty(9, 5) = "计算件数: " & zl
ty(9, 6) = 0
End Sub
Sub tabledataz()
Dim i, bb As Integer, dd1 As Single
tzI = bnum
For i = 0 To tzI - 1
tz(i, 0) = i + 1
tz(i, 1) = code(i)
tz(i, 2) = kwh(i)
tz(i, 3) = Xiao2(danjia(i))
tz(i, 4) = len2(bname(i), 35)
tz(i, 5) = " " & shice(i)
dd1 = danjia(i) * shice(i)
tz(i, 6) = Xiao2(dd1)
tz(i, 7) = "0" & bzhe(i)
dd1 = danjia(i) * shice(i) * bzhe(i)
tz(i, 8) = Xiao2(dd1)
bb = Int(shice(i) / bag(i))
tz(i, 9) = bb & "+" & shice(i) - bb * bag(i) & "(" & bag(i) & ")"
Next
End Sub
Sub print_pxd()
tabledatax
tabledatay
tabledataz
Module1.printp ‘调用打印表格模块
End Sub
用REPORT产生报表
1．新建标准工程1；
2．添加数据环境：选择菜单【工程】/【更多ActiveX设计器】/【DataEnvironment】，添加DataEnvironment1；
3．建立ODBC连接：
（1）在【控制面板】/【ODBC数据源】/【系统DNS】中设置数据库连接，如test0；
（2）右击【Connection1】，选择【属性】，出现“数据链接”对话框：
（3）在“提供者”属性页中选择【…for ODBC Drivers】；
（4）在“连接”属性页中选择【使用连接字符串】，单击【编译】/【机器数据源】，选中需要的数据连接，如test0，单击【确定】；
（5）单击【测试连接】，如通过，可以进行下一步；
4．添加连接命令：右击【Connection1】，选择【添加命令】，出现“Command1”;
5．设置连接命令：右击【Command1】，选择【属性】，出现“属性”对话框，设【数据库对象】为【表】，【对象名称】为所需要的表名，如“取水户基本信息表”，单击+号，可以展开表，如图所示：
6．添加报表：选择菜单【工程】/【添加DataReport】，添加DataReport1；
7．设置报表连接：在右边的属性面板中设【DataSource】为【DataEnvironment1】，【DataMember】为【Command1】；
8．设置报表数据：把各字段从DataEnvironment1拖到DataReport1，再加以排列；注意：拖动的字段有2块，左边是字段名（可以放在“页标头”栏中），右边是字段值（要放在“细节”栏中）；
9．设置报表标题：右击报表，选择【插入控件】/【标签】，在报表标头栏中放置；还可以在“页注脚”栏中插入页码；
10．设置报表边框：右击报表，选择【插入控件】/【形状】，调整矩形大小，在每个字段和字段名上放置一个复制控件（Shape）；
11．显示报表：在工程的Form1（或UserControl1）中添加一个按钮，在其上添加代码：
DataReport1.Show
然后就可以运行了。运行时既可以显示，也可以打印报表。
如建立ActiveX控件，要先建立一个标准EXE工程（用于调试），再建立一个ActiveX控件，在其上如上操作。
八 数据库控件
用数据库控件实现数据库浏览
放置控件: Form1:Data1,Combo1,Text1,Text2,Lbel1,Label2,Label3
属性设置: 〖Combo1.Datasource〗=data1
〖Text1.Datasource〗=data1
〖Text2.Datasource〗=data1
其余Text1,Text2,Label1,Label2,Label3的属性见图8.4
Data1的RecordsetType属性为0（table）
代码:
Private Sub Form_Load()
Data1.DatabaseName = "biblio.mdb" '调入"图书管理数据库"
Data1.RecordSource = "select distinct STATE from publishers "
Data1.Refresh
Do While Not Data1.Recordset.EOF '给Combo1赋值
temp = Data1.Recordset("State")
If IsNull(temp) Then temp = ""
Combo1.AddItem CStr(temp)
Data1.Recordset.MoveNext
Loop
Data1.RecordSource = "publishers" '改变Recordset为全表
Data1.Refresh
Text1.DataField = "name"
Text2.DataField = "city"
Combo1.DataField = "state"
End Sub
在控件DATAI中显示总记录和当前记录
先设置全局变量firstflag，并在FormLoad中设为True，
Private Sub Data1_Reposition() '重新定位记录时显示记录号
If firstflag Then '如果是首次使用
Data1.Caption = "" 'data1标题框显示空白
firstflag = False
Else '如果不是首次使用，则在
' data1标题框显示记录号
Data1.Caption = "总记录数:" & Data1.Recordset.RecordCount _
& " 当前记录:" & Data1.Recordset.AbsolutePosition + 1
End If
用数据库控件实现数据录入/删除
放置控件: Form1:Data1;Text1,2;Lbel1,2;Command1,2,3,4,5;Frame1
属性设置:
Data1:〖DatabseName〗="Nwind.mdb",〖Recordsource〗=products
Text1:〖Datasource〗=data1,〖Datafield〗=produtID,〖TabIndex〗=0
Text2:〖Datasource〗=data1,〖Datafield〗=produtName,〖TabIndex〗=1
Command1:〖Name〗=Cmdadd,〖Caption〗=增加
Command2:〖Name〗=Cmddelete,〖Caption〗=删除
Command3:〖Name〗=Cmdexit,〖Caption〗=退出
Command4:〖Name〗=Cmdupdate,〖Caption〗=确定
Command5:〖Name〗=Cmdcancel,〖Caption〗=放弃
Frame1中包含Command4,5
其余Text1,2,Label1,2和Command1,2,3,4,5的位置属性见图8.5
代码:
Option Explicit
Dim firstflag As Boolean '首次使用标记
Private Sub Cmdadd_Click() '增加记录
Data1.Recordset.AddNew
Frame1.Visible = True '使主按钮组不可见
Data1.Caption = "记录:" & Data1.Recordset.RecordCount + 1
Text1.SetFocus
End Sub
Private Sub Cmdcancel_Click() '放弃录入的记录
Data1.Recordset.CancelUpdate
Frame1.Visible = False '使主按钮组可见
Data1.Recordset.MoveLast '回到最后一个记录
End Sub
Private Sub Cmdupdate_Click() '确定录入的记录有效
Data1.Recordset.Update
Frame1.Visible = False '使主按钮组可见
Data1.Recordset.MoveLast '显示录入内容
End Sub
Private Sub Data1_Reposition() '重新定位记录时显示记录号
If firstflag Then '如果是首次使用
Data1.Caption = "" 'data1标题框显示空白
firstflag = False
Else '如果不是首次使用，则在
' data1标题框显示记录号
Data1.Caption = "总记录数:" & Data1.Recordset.RecordCount _
& " 当前记录:" & Data1.Recordset.AbsolutePosition + 1
End If
End Sub
