📄 系统_打印基本模块.bas
字号:
Btzgd = 0
.FontBold = True
.FontName = Btfontname
.FontSize = Btfontsize
.CalcText = Bbzbt
Btzgd = Btzgd + .TextHei + 2 * Xhsjg
.FontBold = False
.FontName = Sjfontname
.FontSize = Sjfontsize
.CalcText = "测试"
Btzgd = Btzgd + Xbths * .TextHei + (Xbths + 1) * Xbthjg + Zdxsjg
'计算表头+n行数据行高度(如果指定每页报表行数则n=zdbbhs 否则 n=1)
Btsjhgd = 0
Btsjhgd = Btsjhgd + DY_Tybbyldy.DyylGrid.FixedRows * Bbgdhgd
If Zdbbhs <> 0 Then
Btsjhgd = Btsjhgd + Zdbbhs * Bbsjhgd
Else
Btsjhgd = Btsjhgd + Bbsjhgd
End If
'计算表尾高度(表尾行之间无间隔)
Bwzgd = Xbthjg + Bwhs * .TextHei + Bjjghs * .TextHei
'计算每页报表满页打印行数及报表总页数
If zdxwz = 1 Then
Zdxsjg = zdxgd
End If
Mybbhs = Int((.PageHeight - .MarginTop - Zdxsjg - Btzgd - .MarginBottom - Bwzgd - DY_Tybbyldy.DyylGrid.FixedRows * Bbgdhgd) / Bbsjhgd)
'解决由于纸张高度太小出现死循环
If Mybbhs < 1 Then
Tsxx = "纸张高度不足以输出一行有效数据行,请重新设置!"
Call Xtxxts(Tsxx, 0, 4)
Unload DY_Tybbyldy
Exit Sub
End If
If Zdhs Then
If Zdbbhs < Mybbhs Then
Mybbhs = Zdbbhs
End If
End If
'循环前初始化值
bbQslz = bbscQslz
Bbynfyh = 1
bbynbz = "1"
Bbhsjsqte = Bbhsjsq
Do While sfsckb Or Bbhsjsq <= DY_Tybbyldy.DyylGrid.Rows - 1
'打印公司标志
'.DrawPicture DY_Tybbyldy.Image1.Picture, .MarginLeft, .MarginTop
'显示打印状态
Call Sub_SetOperStatus("正在输出打印信息...第" & Trim(str(Pagecount)) & "页")
'输 出 报 表 装 订 线
Zdxsjg = 0
Zdxzjg = 0
Call Scbbzdx(zdxwz, zdxgd, Zdxsjg, Zdxzjg)
'计 算 报 表 总 宽 度 及 报 表 起 始 X
Bbzkd = 0
'1.计 算 报 表 有 效 区 宽 度(即报表不能超出.marginleft .marginright)
Yxbbkd = .PageWidth - .MarginLeft - .MarginRight - Zdxzjg
'2.计算报表真正宽度及本页报表起始终止列值(*固定输出列宽<报表有效宽度)
If sfscgdl Then
For Coljsq = Bbgdscqsl To Bbgdsczzl
Bbzkd = Bbzkd + DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) * Kdfdbl
Next Coljsq
End If
For Coljsq = bbQslz To bbsczzlz
Bbzkd = Bbzkd + DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) * Kdfdbl
If Bbzkd <= Yxbbkd Then
bbzkdte = Bbzkd
bbzzlz = Coljsq
Else
Sfdyfyh = True
Exit For
End If
Next Coljsq
Bbzkd = bbzkdte
'计 算 报 表 起 始 X 坐 标
Select Case Bbalign
Case "1"
Bbqsx = .MarginLeft + Zdxzjg
Case "2"
If Zdxzjg = 0 Then
If .PageWidth > Bbzkd Then
Bbqsx = (.PageWidth - Bbzkd) / 2
Else
Bbqsx = .MarginLeft
End If
Else
If .PageWidth - Zdxzjg - .MarginLeft > Bbzkd Then
Bbqsx = (.PageWidth - Bbzkd - Zdxzjg - .MarginLeft) / 2 + Zdxzjg + .MarginLeft
Else
Bbqsx = .MarginLeft + Zdxzjg
End If
End If
End Select
'本页报表初始动态X,Y坐标(原则:内容输出完毕紧接着移动坐标为下一次输出作准备)
Bbydx = Bbqsx
Bbydy = .MarginTop + Zdxsjg
Do While (Bbydy <= .PageHeight - .MarginBottom - Bwzgd - Bbsjhgd And Bbhsjsq <= DY_Tybbyldy.DyylGrid.Rows - 1) Or sfsckb '直至整个网格输出完毕
'生 成 报 表 标 题
.FontBold = True
.FontName = Btfontname
.FontSize = Btfontsize
.CalcText = Bbzbt
bbzbty = Bbydy
bbzbtx = Bbzkd / 2 - .TextWid / 2 + Bbydx
.TextBox Bbzbt, bbzbtx, bbzbty, .TextWid, .TextHei, False
'非套打方式输出
If Not Sftdfssc Then
.DrawLine bbzbtx - Sckd, bbzbty + .TextHei + Xhsjg, bbzbtx + .TextWid + Sckd, bbzbty + .TextHei + Xhsjg
.DrawLine bbzbtx - Sckd, bbzbty + .TextHei + 2 * Xhsjg, bbzbtx + .TextWid + Sckd, bbzbty + .TextHei + 2 * Xhsjg
End If
Bbydy = Bbydy + .TextHei + 2 * Xhsjg + Xbthjg
.FontBold = False
.FontName = Sjfontname
.FontSize = Sjfontsize
Xbtmaxlen = 0
For jsqte = 1 To Bbxbtgs
.CalcText = Bbxbt(jsqte)
If .TextWid > Xbtmaxlen Then
Xbtmaxlen = .TextWid
End If
Next jsqte
'生成报表小标题同时在最后小标题行加页号
For jsqte = 1 To Bbxbtgs
.CalcText = Bbxbt(jsqte)
Select Case bbxbtzzxs(jsqte)
Case 0 '居左
.TextBox Bbxbt(jsqte), Bbydx, Bbydy, .TextWid, .TextHei, False
Case 1 '居中
.TextBox Bbxbt(jsqte), Bbzkd / 2 - Xbtmaxlen / 2 + Bbydx, Bbydy, .TextWid, .TextHei, False
Case 2 '居右
.TextBox Bbxbt(jsqte), Bbydx + Bbzkd - .TextWid, Bbydy, .TextWid, .TextHei, False
End Select
'输出页号且居右
If jsqte = Bbxbtgs Then
If Sfdyfyh Then
Bbpage = "第" + Trim(str(Pagecount)) + "-" + Trim(str(Bbynfyh)) + "页 "
Else
Bbpage = "第" + Trim(str(Pagecount)) + "页 "
End If
.CalcText = Bbpage
.TextBox Bbpage, Bbydx + Bbzkd - .TextWid, Bbydy, .TextWid, .TextHei, False
End If
Bbydy = Bbydy + .TextHei + Xbthjg
Next jsqte
'生 成 报 表 表 头
Btkdte = 0
If sfscgdl <> 0 Then
Call scbbbt(DY_Tybbyldy.DyylGrid, Bbgdscqsl, Bbgdsczzl, Kdfdbl, Bbgdhgd, Bbydy, Bbydx, Bbqsx, Sftdfssc)
For Coljsq = Bbgdscqsl To Bbgdsczzl
Btkdte = Btkdte + DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) * Kdfdbl
Next Coljsq
End If
Call scbbbt(DY_Tybbyldy.DyylGrid, bbQslz, bbzzlz, Kdfdbl, Bbgdhgd, Bbydy, Bbydx + Btkdte, Bbqsx + Btkdte, Sftdfssc)
Bbydy = Bbydy + DY_Tybbyldy.DyylGrid.FixedRows * Bbgdhgd
'生 成 报 表 表 体(包括各列列宽,数据内容)
.CurrentY = Bbydy
'报表是否套打方式输出
If Sftdfssc Then
.TableBorder = tbNone
Else
If Bbbxjg > 1 Then
.TableBorder = tbBoxColumns
End If
End If
.StartTable
Bbbtkd = ""
Bbbody = ""
'填 充 列 宽
If sfscgdl Then
For Coljsq = Bbgdscqsl To Bbgdsczzl
If DY_Tybbyldy.DyylGrid.ColAlignment(Coljsq) = flexAlignRightTop Then
Zzf = "+>"
Else
Zzf = "+"
End If
Bbbtkd = Bbbtkd + Zzf + Trim(str(DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) * Kdfdbl)) + "|"
Next Coljsq
End If
For Coljsq = bbQslz To bbzzlz
If DY_Tybbyldy.DyylGrid.ColAlignment(Coljsq) = flexAlignRightTop Then
Zzf = "+>"
Else
Zzf = "+"
End If
If Coljsq = bbzzlz Then
Bbbtkd = Bbbtkd + Zzf + Trim(str(DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) * Kdfdbl)) + ";"
Else
Bbbtkd = Bbbtkd + Zzf + Trim(str(DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) * Kdfdbl)) + "|"
End If
Next Coljsq
'填 充 数 据 内 容
Bybbhs = 0
Do While Bybbhs <= Mybbhs And Bbhsjsq <= DY_Tybbyldy.DyylGrid.Rows - 1
If Zdhs Then
If Bybbhs >= Zdbbhs Then
Exit Do
End If
End If
Rowjsq = Bbhsjsq
If sfscgdl Then
For Coljsq = Bbgdscqsl To Bbgdsczzl
If DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) >= Ztkd2 / 2 Then
DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq) = Thwxzf(DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq))
If Len(DY_Tybbyldy.DyylGrid.ColFormat(Coljsq)) <> 0 Then
Bbbody = Bbbody + Format(DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq), DY_Tybbyldy.DyylGrid.ColFormat(Coljsq)) + "|"
Else
Bbbody = Bbbody + DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq) + "|"
End If
Else
Bbbody = Bbbody + "|"
End If
Next Coljsq
End If
For Coljsq = bbQslz To bbzzlz
If DY_Tybbyldy.DyylGrid.ColWidth(Coljsq) >= Ztkd2 / 2 Then
If Coljsq = bbzzlz Then
DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq) = Thwxzf(DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq))
If Len(DY_Tybbyldy.DyylGrid.ColFormat(Coljsq)) <> 0 Then
Bbbody = Bbbody + Format(DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq), DY_Tybbyldy.DyylGrid.ColFormat(Coljsq)) + ";"
Else
Bbbody = Bbbody + DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq) + ";"
End If
Else
DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq) = Thwxzf(DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq))
If Len(DY_Tybbyldy.DyylGrid.ColFormat(Coljsq)) <> 0 Then
Bbbody = Bbbody + Format(DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq), DY_Tybbyldy.DyylGrid.ColFormat(Coljsq)) + "|"
Else
Bbbody = Bbbody + DY_Tybbyldy.DyylGrid.TextMatrix(Rowjsq, Coljsq) + "|"
End If
End If
Else
If Coljsq = bbzzlz Then
Bbbody = Bbbody + ";"
Else
Bbbody = Bbbody + "|"
End If
End If
Next Coljsq
Bybbhs = Bybbhs + 1
Bbhsjsq = Bbhsjsq + 1
Loop
.AddTable Bbbtkd, "", Bbbody
'如果指定报表行数,则不进行满页打印
If Sfmy And Bybbhs < Mybbhs Then
Bbbody = ""
For Rowjsq = 1 To Mybbhs - Bybbhs
If Bbgdsczzl <> 0 Then
For Coljsq = Bbgdscqsl To Bbgdsczzl
Bbbody = Bbbody + "|"
Next Coljsq
End If
For Coljsq = bbQslz To bbzzlz
If Coljsq = bbzzlz Then
Bbbody = Bbbody + ";"
Else
Bbbody = Bbbody + "|"
End If
Next Coljsq
.AddTable Bbbtkd, "", Bbbody
Bbbody = ""
Bybbhs = Bybbhs + 1
Next Rowjsq
End If
'设置报表行高度
For Rowjsq = 1 To Bybbhs
.TableCell(tcRowHeight, Rowjsq) = Bbsjhgd
Bbydy = Bbydy + Bbsjhgd
If Bbbxjg > 1 Then
If Rowjsq Mod Bbbxjg = 0 And Rowjsq <> Bybbhs Then
If Not Sftdfssc Then
.DrawLine Bbqsx, Bbydy, Bbqsx + Bbzkd, Bbydy
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -