Private Sub Form_Load()
k = 600
doflag = False
End Sub
Private Sub Timer1_Timer() '时钟控件随时检测,如果没有点击
If doflag Then 'Command1(停止),则继续调用动画程序
fly_direction
End If
End Sub
七 报表
用数据库控件产生简单的数据报表
放置控件: Form1:Data1,Command1
属性设置: 〖Data1.DatabseName〗="Nwind.mdb",〖Data1.Recordsource〗=categories
说明:1.Data1中可设置任何普通数据库
2.输出报表到一个.txt文件,可以在WORD或其它编辑软件中编辑.
3.编辑时设行距为零(WORD中设固定值=10磅).
代码:
Option Explicit
Dim f1 As Field '字段变量
Dim fi As Integer '字段数
Dim pagerow As Integer '每页行数
Dim rptcaption As String '报表标题字符串
Dim repage As Integer '报表页数
Dim repfield() As Integer '字段宽度数组
Dim maxwidth as integer '最大字段宽度
Dim repwidth As Integer '报表总宽
Dim leftspace As Integer '报表左边起始位置
Dim chi As Integer '中文字符数
Function len1(str1 As String) As Integer
'返回字符串绝对长度(如len1("你好!")=5)
Dim l1 As String
Dim i, ln1 As Integer
len1 = 0
For i = 1 To Len(str1)
l1 = Mid$(str1, i, 1)
If Asc(l1) < 0 Then '中文字符
ln1 = 2
Else
ln1 = 1
End If
len1 = len1 + ln1
Next i
End Function
Sub CreateRptField()
'比较字段名和字段长度,决定字段宽度并计算报表总宽
ReDim repfield(fi) As Integer '使用变长数组
Dim fname, fsize As Integer
Dim fi1 As Integer
repwidth = leftspace + 2
For fi1 = 0 To fi - 1
Set f1 = Data1.Recordset.Fields(fi1)
fname = Int((len1(f1.Name) + 1) / 2 + 0.5) * 2
fsize = Int((f1.Size + 1) / 2 + 0.5) * 2
If fsize > maxwidth Then fsize = maxwidth '限定字段宽度
If fname > fsize Then
repfield(fi1) = fname
Else
repfield(fi1) = fsize
End If
repwidth = repwidth + repfield(fi1) + 2
Next fi1
End Sub
Sub repline(str1, str2, str3, str4 As String) '打印表线
Dim fi1, fi2 As Integer
Dim rl As Integer
For fi1 = 1 To leftspace
Print #1, " ";
Next fi1
Print #1, str1;
For fi2 = 1 To Int(repfield(0) / 2)
Print #1, str2;
Next fi2
For fi1 = 1 To fi - 1
Print #1, str3;
For fi2 = 1 To Int(repfield(fi1) / 2)
Print #1, str2;
Next fi2
Next fi1
Print #1, str4
End Sub
Sub rptheadline(str1 As String) '打印标题和页码
Dim start, fi1 As Integer
Print #1,
If Int(repwidth / 2) - Int(len1(str1) / 2) > 10 + leftspace Then
start = Int(repwidth / 2) - Int(len1(str1) / 2) + leftspace
For fi1 = 1 To start
Print #1, " ";
Next fi1
Print #1, str1, " -"; repage; "-"
Else
For fi1 = 1 To leftspace
Print #1, " ";
Next fi1
Print #1, str1, " -"; repage; "-"
End If
Print #1,
End Sub
Function leftstr(str1 As String, fsize As Integer) As String
'返回字符串str1左边fsize(绝对长度)长子串
If len1(str1) <= fsize Then
leftstr = str1
Else
Do While len1(str1) > fsize
str1 = Left$(str1, Len(str1) - 1)
Loop
leftstr = str1
End If
End Function
Function checkfield(str1 As Variant, int1 As Integer) As String
'检查记录变量str1的类型,并使它的绝对长度不超过int1
Dim str2 As String
If IsNull(Data1.Recordset(f1.SourceField)) Then '处理空记录
checkfield = ""
ElseIf f1.Type = 11 Then '处理binary类型记录
checkfield = ""
Else
str2 = str1 '强制转换为string
checkfield = leftstr(str2, int1)
End If
End Function
Sub rpthead() '打印表头
Dim fi1, ti, chi As Integer
Call repline("┏", "━", "┳", "┓")
For fi1 = 1 To leftspace
Print #1, " ";
Next fi1
ti = leftspace + 1
For fi1 = 0 To fi - 1
Print #1, "┃";
Set f1 = Data1.Recordset.Fields(fi1) '取出当前字段
ti = ti + repfield(fi1) + 2
chi = len1(f1.SourceField) - Len(f1.SourceField) '设置打印变换
ti = ti - chi - 1 '设置打印变换
Print #1, f1.SourceField; Tab(ti); '打印当前字段名
Next fi1
Print #1, "┃"
Call repline("┣", "━", "╇", "┫")
End Sub
Sub rptrecord() '打印记录行
Dim fi1, ti As Integer
Dim temp As String '记录内容
For fi1 = 1 To leftspace '以下先打印第一字段
Print #1, " ";
Next fi1
Print #1, "┃";
ti = leftspace + 3
Set f1 = Data1.Recordset.Fields(0) '取出第一个字段
ti = ti + repfield(0)
temp = checkfield(Data1.Recordset(f1.SourceField), repfield(0))
chi = len1(temp) - Len(temp) '设置打印变换
ti = ti - chi - 1 '设置打印变换
Print #1, temp; Tab(ti); '打印记录内容
For fi1 = 1 To fi - 1 '以下打印其余字段
Print #1, "│";
Set f1 = Data1.Recordset.Fields(fi1)
ti = ti + repfield(fi1) + 2
temp = checkfield(Data1.Recordset(f1.SourceField), repfield(fi1))
chi = len1(temp) - Len(temp) '设置打印变换
ti = ti - chi - 1 '设置打印变换
Print #1, temp; Tab(ti);
Next fi1
Print #1, "┃"
End Sub
Sub repform() '打印报表
Dim li As Integer '报表行数变量
Dim pbl As Boolean '表行类型标记
repage = 1
li = 1
pbl = True
Do While Not Data1.Recordset.EOF
If pbl Then '表行为起始行,要打印表头
Call rptheadline(rptcaption)
Call rpthead
pbl = False
Else '表行为普通记录
Call repline("┠", "─", "┼", "┨")
End If
Call rptrecord
li = li + 1
If li = pagerow Then '到达页尾
Call repline("┗", "━", "┷", "┛")
Print #1,
repage = repage + 1
li = 1
pbl = True '设置起始行标记
End If
Data1.Recordset.MoveNext '移动到下一记录
Loop
If Not pbl Then '全报表完时打印表底线
Call repline("┗", "━", "┷", "┛")
Print #1,
End If
End Sub
Private Sub Command1_Click() '主程序
Open "test.txt" For Output As #1 '打开报表文件
leftspace = 0 '设置报表左边距
fi = Data1.Recordset.Fields.Count '找到当前记录集的字段数
Call CreateRptField '决定每个字段宽度
rptcaption = "报 表 示 例" '给出标题
maxwidth=10 '给出最大字段宽度
pagerow = 20 '给出每页行数
Call repform '打印报表
Close #1 '关闭报表文件
End Sub
用数据库打印报表
放置控件: Form1:Command1,Command2
说明：读mdb数据库rst1打印表格，表格参数在daima数组中。
代码：
Option Explicit
Dim pw, ph '纸宽和纸高的坐标
Dim px, py
Dim ti '报表字段数
Dim wh, ww '字宽和字高
Dim table1 '第一页表格开始高度
Dim daima(100, 3) as String
Sub finput()
ti = 7
daima(1, 1) = "序号"
daima(1, 2) = 6 '表格宽度
daima(1, 3) = "序号"
daima(2, 1) = "代码"
daima(2, 2) = 8
daima(2, 3) = "scode" '字段名
daima(3, 1) = "库位号"
daima(3, 2) = 8
daima(3, 3) = "skwh"
daima(4, 1) = "书名"
daima(4, 2) = 36
daima(4, 3) = "sname"
daima(5, 1) = "单价"
daima(5, 2) = 8
daima(5, 3) = "sdanjia"
daima(6, 1) = "出版日期"
daima(6, 2) = 10
daima(6, 3) = "syear"
daima(7, 1) = "备注"
daima(7, 2) = 10
daima(7, 3) = "空白"
End Sub
Sub printhead()
Printer.CurrentX = 150: Printer.CurrentY = 30
Printer.FontSize = 19: Printer.FontBold = True
Printer.Print "中国水利水电出版社业务清单"
table1 = 50
End Sub
Sub printframe(ByVal pp1 As Integer, pp2 As Integer, pp3 As Integer)
Dim py1 As Integer
Dim pxm, pxi, px1, bi
Dim daim1, daim2 As String
pxm = 0 '计算报表宽度
For pxi = 1 To ti
pxm = pxm + daima(pxi, 2) * ww
Next
Printer.DrawWidth = 3
Printer.FontSize = 11
Printer.FontBold = True
py = pp1 + (pp3 + 2 - pp2) * wh '计算报表高度
Printer.Line (0, pp1)-(pxm, pp1) '打印边框
Printer.Line (pxm, pp1)-(pxm, py)
Printer.Line (pxm, py)-(0, py)
Printer.Line (0, py)-(0, pp1)
Printer.DrawWidth = 1 '打印表头
px = 0
For pxi = 1 To ti
daim2 = daima(pxi, 1)
px1 = Int((daima(pxi, 2) - len1(daim2)) / 2)
Printer.CurrentX = px + px1 * ww
Printer.CurrentY = pp1 + Int(0.2 * wh)
Printer.Print daima(pxi, 1) '打印字段名
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)
Select Case daim1
Case "序号": daim2 = bi '打印序号
Case "空白": daim2 = "" '打印空白字段
Case Else: daim2 = rst1(daim1)
End Select
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 '第二页记录数
Dim table2 '第二页起始位置
p2y = 37
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
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
用数据库转数组打印报表
放置控件: Form1:Command1,Command3
说明：读mdb数据库转数组打印表格，daima数组放表格参数,dai1数组放纪录参数。
代码：
Option Explicit
Dim pw, ph, px, py As Integer
Dim ti '报表字段数
Dim wh, ww 'word height and width
Dim table1 '第一页表格起始位置
Dim dai1(400, 8) As String
Sub finput()
ti = 7
daima(1, 1) = "序号"
daima(1, 2) = 6
daima(1, 3) = 0
daima(2, 1) = "代码"
daima(2, 2) = 8
daima(2, 3) = 1
daima(3, 1) = "库位号"
daima(3, 2) = 8
daima(3, 3) = 2
daima(4, 1) = "书名"
daima(4, 2) = 36
daima(4, 3) = 3
daima(5, 1) = "单价"
daima(5, 2) = 8
daima(5, 3) = 4
daima(6, 1) = "出版日期"
daima(6, 2) = 10
daima(6, 3) = 5
daima(7, 1) = "备注"
daima(7, 2) = 10
daima(7, 3) = 6
End Sub
Sub finput2()
Dim di
di = 0
rst1.MoveFirst
Do While Not rst1.EOF
di = di + 1
dai1(di, 0) = di
dai1(di, 1) = rst1!scode
dai1(di, 2) = rst1!skwh
dai1(di, 3) = rst1!sname
dai1(di, 4) = rst1!sdanjia
dai1(di, 5) = rst1!syear
dai1(di, 6) = ""
rst1.MoveNext
Loop
End Sub
Sub printhead()
Dim x1, x2, x3
Printer.CurrentX = 150: Printer.CurrentY = 30
Printer.FontSize = 19: Printer.FontBold = True
Printer.Print "中国水利水电出版社业务清单"
table1 = 50
clh = "k0405"
x1 = 20: x2 = 270: x3 = 520
Printer.CurrentX = x1: Printer.CurrentY = table1
Printer.FontSize = 9: Printer.FontBold = False
Printer.Print "处理单号: " & clh
Printer.CurrentX = x2: Printer.CurrentY = table1
Printer.Print "制单日期: 20" & Now
Printer.CurrentX = x3: Printer.CurrentY = table1
Printer.Print "制单人 : "
table1 = table1 + wh
End Sub
Sub printframe(ByVal pp1 As Integer, pp2 As Integer, pp3 As Integer)
Dim py1 As Integer
Dim pxm, pxi, px1, bi
Dim daim1, daim2 As String
pxm = 0
For pxi = 1 To ti
pxm = pxm + daima(pxi, 2) * ww
Next
Printer.DrawWidth = 3
Printer.FontSize = 11
Printer.FontBold = True
py = pp1 + (pp3 + 2 - pp2) * wh
Printer.Line (0, pp1)-(pxm, pp1)
Printer.Line (pxm, pp1)-(pxm, py)
Printer.Line (pxm, py)-(0, py)
Printer.Line (0, py)-(0, pp1)
Printer.DrawWidth = 1
px = 0
For pxi = 1 To ti
daim2 = daima(pxi, 1)
px1 = Int((daima(pxi, 2) - len1(daim2)) / 2)
Printer.CurrentX = px + px1 * ww
Printer.CurrentY = pp1 + Int(0.2 * wh)
Printer.Print daima(pxi, 1)
