📄 frmsetformat.frm
字号:
TabIndex = 108
Top = 870
Width = 375
End
Begin VB.Label LblTitle
Caption = "毫米"
Height = 195
Index = 30
Left = -72810
TabIndex = 107
Top = 510
Width = 375
End
Begin VB.Label LblTitle
Caption = "页脚(&O)"
Height = 195
Index = 21
Left = -74670
TabIndex = 40
Top = 3060
Width = 645
End
Begin VB.Label LblTitle
Caption = "页眉(&A)"
Height = 195
Index = 20
Left = -74670
TabIndex = 38
Top = 600
Width = 645
End
Begin VB.Label LblFooter
BackColor = &H80000005&
Height = 435
Index = 2
Left = -70890
TabIndex = 85
Top = 2280
Width = 1905
End
Begin VB.Label LblFooter
BackColor = &H80000005&
Height = 435
Index = 1
Left = -72780
TabIndex = 84
Top = 2280
Width = 1905
End
Begin VB.Label LblFooter
BackColor = &H80000005&
Height = 435
Index = 0
Left = -74670
TabIndex = 83
Top = 2280
Width = 1905
End
Begin VB.Label LblMiddle
BackColor = &H80000005&
Height = 735
Index = 0
Left = -74670
TabIndex = 82
Top = 1560
Width = 5685
End
Begin VB.Label LblHeader
BackColor = &H80000005&
Height = 435
Index = 2
Left = -70890
TabIndex = 81
Top = 1140
Width = 1905
End
Begin VB.Label LblHeader
BackColor = &H80000005&
Height = 435
Index = 1
Left = -72780
TabIndex = 80
Top = 1140
Width = 1905
End
Begin VB.Label LblHeader
BackColor = &H80000005&
Height = 435
Index = 0
Left = -74670
TabIndex = 79
Top = 1140
Width = 1905
End
Begin VB.Label LblTitle
Caption = "上(&T)"
Height = 195
Index = 19
Left = -74730
TabIndex = 20
Top = 510
Width = 465
End
Begin VB.Label LblTitle
Caption = "下(&B)"
Height = 195
Index = 18
Left = -74730
TabIndex = 22
Top = 840
Width = 465
End
Begin VB.Label LblTitle
Caption = "左(&L)"
Height = 195
Index = 17
Left = -74730
TabIndex = 24
Top = 1170
Width = 465
End
Begin VB.Label LblTitle
Caption = "右(&R)"
Height = 195
Index = 16
Left = -74730
TabIndex = 26
Top = 1500
Width = 465
End
Begin VB.Label LblTitle
Caption = "装订线(&U)"
Height = 195
Index = 13
Left = -74730
TabIndex = 28
Top = 1830
Width = 825
End
Begin VB.Label LblTitle
Caption = "高度(&H)"
Height = 165
Index = 12
Left = -74610
TabIndex = 16
Top = 1740
Width = 645
End
Begin VB.Label LblTitle
Caption = "宽度(&W)"
Height = 195
Index = 11
Left = -74610
TabIndex = 14
Top = 1320
Width = 645
End
Begin VB.Label LblTitle
Caption = "纸张(&Z)"
Height = 195
Index = 10
Left = -74610
TabIndex = 12
Top = 570
Width = 1005
End
Begin VB.Label LblTitle
Caption = "行加一分隔线"
Height = 165
Index = 1
Left = 1650
TabIndex = 57
Top = 3120
Width = 1095
End
Begin VB.Label LblTitle
Caption = "每隔"
Height = 165
Index = 0
Left = 360
TabIndex = 56
Top = 3120
Width = 375
End
Begin VB.Label LblMiddle
BackColor = &H80000007&
Height = 1575
Index = 1
Left = -74580
TabIndex = 86
Top = 1230
Width = 5685
End
End
End
Attribute VB_Name = "FrmFormatSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'功能:报表和帐册打印设置窗体
'作者:李鹏
'日期:1998年8月
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'窗体类型1 帐册 2 多栏帐 3 标准表 4 交叉表 5 列表 6 帐龄分析 7 财务分析 8 汇总表 9 余额表 10 工资配款表
Option Explicit
Private mArrayPapersize(1 To 56) As String
Private strX(0 To 56) As String
Private strY(0 To 56) As String
Private mclsFset As ClsFormatset '格式设置类
Private fontDig As StdFont '对话框的字体
Private fontLastTitle As New StdFont '标题的字体
Private frmFH As FrmFHDeFineSelf '页眉页脚自定义窗体
Private mfntSetup(0 To 4) As New StdFont '字体
Private mlngFontColor(0 To 4) As Long '字体颜色
Private mlngFontBKColor(0 To 4) As Long '字体背景颜色
Private mintCurrenPage As Long '当前页
Private mintTotalPage As Long '总页数
Private mlngHeaderHeight As Long '表头高度 0.1毫米
Private mlngHeightDiff As Long '纸张高度误差(Bottom高度) 0.1毫米
Private mintRowCount As Integer '传入的总行数
Private mstrOld As String
Private mblnLoaded As Boolean '是否已加载窗体
Private mblnChanged As Boolean '是否已改变
Private mblnOk As Boolean '是否确定
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 公共接口
'
Public Function ShowFrmFormatSet(ClsFormatset As ClsFormatset, ByVal intRowCount As Integer, ByVal intCurrenPageCode As Long, ByVal intTotalPage As Long, Optional ByVal lngHeaderHeight As Long = 0) As Boolean
'参数说明：TypeIndex(1-报表，2-帐册)
Set mclsFset = ClsFormatset
mintRowCount = intRowCount '总行数
mintCurrenPage = intCurrenPageCode '当前页数
mintTotalPage = intTotalPage '总页数
mlngHeaderHeight = lngHeaderHeight / 5.67 * Screen.TwipsPerPixelY '头距
Me.Show vbModal
ShowFrmFormatSet = mblnOk
Set mclsFset = Nothing
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 事件过程
'
Private Sub CboFormatSet_Click(Index As Integer)
If Not mblnLoaded Then Exit Sub
Select Case Index
Case 0
OptMM.Value = True
PaperSize CboFormatSet(0).ItemData(CboFormatSet(0).ListIndex)
RefreshPaper
Case 5
If CboFormatSet(5).Text = CboFormatSet(5).list(1) Then '如果为粗线,则把线型自动置成单线
CboFormatSet(7).Text = CboFormatSet(7).list(0)
End If
Case 7
If CboFormatSet(7).Text = CboFormatSet(7).list(1) Then '如果为双线型,则自动把粗细置成细线
CboFormatSet(5).Text = CboFormatSet(5).list(0)
End If
Case Else
End Select
mblnChanged = True
End Sub
Private Sub ChkFormatSet_Click(Index As Integer)
If Not mblnLoaded Then Exit Sub
Select Case Index
Case 0, 1, 3, 4 '0需要行分隔线 1 '页末空行补齐
Case 2 '显示金额线
If ChkFormatSet(2).Value = 1 Then
ChkFormatSet(4).Enabled = False
OptFormatset(5).Enabled = False
OptFormatset(6).Value = True
OptFormatset(7).Enabled = False
Else
ChkFormatSet(4).Enabled = True
OptFormatset(5).Enabled = True
OptFormatset(7).Enabled = True
End If
Case 5, 6 '居中
RefreshBoder
End Select
mblnChanged = True
End Sub
Private Sub Cmd2Default_Click()
If Utility.ShowMsg(Me.hWnd, "你是否恢复缺省值?", vbQuestion + vbOKCancel, "格式设置") = vbOK Then
mclsFset.InitPropertyByDataBase mclsFset.ReportType, , , True
InitForm
mblnChanged = True
End If
End Sub
Private Sub CmdCancel_Click()
mblnOk = False
Unload Me
End Sub
Private Sub cmdOK_Click()
Select Case TabSetFormat.Tab
Case 2, 3, 6
CalcuRow
Case Else
End Select
RedefineProperty
mclsFset.IsSaveToDB = mblnChanged
mblnOk = True
Unload Me
End Sub
Private Sub CmdFont_Click()
Dim fntTemp As New StdFont
Dim intCount As Integer
DlgFormat.Flags = cdlCFPrinterFonts '演示用
intCount = LstSetupFont.ListIndex
If intCount < 0 Then
Utility.ShowMsg Me.hWnd, "请在字体设置中选择", vbInformation, "提示"
Exit Sub
ElseIf intCount = 2 And Not mclsFset.IsReport Then
intCount = 3
End If
DlgFormat.FontName = mfntSetup(intCount).Name
DlgFormat.FontSize = mfntSetup(intCount).Size
DlgFormat.FontBold = mfntSetup(intCount).Bold
DlgFormat.FontItalic = mfntSetup(intCount).Italic
DlgFormat.FontStrikethru = mfntSetup(intCount).Strikethrough
DlgFormat.FontUnderline = mfntSetup(intCount).UnderLine
DlgFormat.ShowFont
If DlgFormat.FontSize < 0 Or DlgFormat.FontSize > 100 Then
Utility.ShowMsg Me.hWnd, "无效值!", vbInformation + vbOKOnly, "格式设置"
Exit Sub
End If
mfntSetup(intCount).Name = DlgFormat.FontName
mfntSetup(intCount).Size = DlgFormat.FontSize
mfntSetup(intCount).Bold = DlgFormat.FontBold
mfntSetup(intCount).Italic = DlgFormat.FontItalic
mfntSetup(intCount).Strikethrough = DlgFormat.FontStrikethru
mfntSetup(intCount).UnderLine = DlgFormat.FontUnderline
RefreshFont intCount
mblnChanged = True
End Sub
Private Sub CmdBackColor_Click()
Dim lngTemp As Long
Dim intCount As Integer
intCount = LstSetupFont.ListIndex
If intCount < 0 Then
Utility.ShowMsg Me.hWnd, "请在字体设置中选择", vbInformation, "格式设置"
Exit Sub
ElseIf intCount = 2 And Not mclsFset.IsReport Then
intCount = 3
End If
lngTemp = DlgFormat.Color
DlgFormat.Color = mlngFontBKColor(intCount)
DlgFormat.ShowColor
mlngFontBKColor(intCount) = DlgFormat.Color
LblExample.BackColor = DlgFormat.Color
FraFormatSet(13).BackColor = DlgFormat.Color
CmdBackColor.SetFocus
mblnChanged = True
End Sub
Private Sub CmdFontColor_Click()
Dim lngTemp As Long
Dim intCount As Integer
intCount = LstSetupFont.ListIndex
If intCount < 0 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -