📄 setpage.frm
字号:
Top = 360
Width = 240
_ExtentX = 450
_ExtentY = 476
_Version = 393216
BuddyControl = "Text1(2)"
BuddyDispid = 196628
BuddyIndex = 2
OrigLeft = 1680
OrigTop = 360
OrigRight = 1920
OrigBottom = 630
Increment = 10
Max = 99999
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown2
Height = 270
Index = 3
Left = 1920
TabIndex = 5
Top = 720
Width = 240
_ExtentX = 450
_ExtentY = 476
_Version = 393216
BuddyControl = "Text1(3)"
BuddyDispid = 196628
BuddyIndex = 3
OrigLeft = 1696
OrigTop = 720
OrigRight = 1936
OrigBottom = 990
Increment = 10
Max = 99999
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown2
Height = 270
Index = 4
Left = 1920
TabIndex = 6
Top = 1080
Width = 240
_ExtentX = 450
_ExtentY = 476
_Version = 393216
BuddyControl = "Text1(4)"
BuddyDispid = 196628
BuddyIndex = 4
OrigLeft = 1680
OrigTop = 1080
OrigRight = 1920
OrigBottom = 1350
Increment = 10
Max = 99999
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown2
Height = 270
Index = 5
Left = 1920
TabIndex = 7
Top = 1440
Width = 240
_ExtentX = 450
_ExtentY = 476
_Version = 393216
BuddyControl = "Text1(5)"
BuddyDispid = 196628
BuddyIndex = 5
OrigLeft = 1680
OrigTop = 1440
OrigRight = 1920
OrigBottom = 1710
Increment = 10
Max = 99999
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin VB.Label Label1
Caption = "&T.上:"
Height = 255
Index = 3
Left = 120
TabIndex = 11
Top = 360
Width = 615
End
Begin VB.Label Label1
Caption = "&B.下:"
Height = 255
Index = 4
Left = 120
TabIndex = 10
Top = 720
Width = 615
End
Begin VB.Label Label1
Caption = "&L.左:"
Height = 255
Index = 5
Left = 120
TabIndex = 9
Top = 1080
Width = 615
End
Begin VB.Label Label1
Caption = "&R.右:"
Height = 255
Index = 6
Left = 120
TabIndex = 8
Top = 1440
Width = 615
End
End
Begin VB.Frame Frame3
Caption = "纸张方向"
Height = 1095
Left = -74880
TabIndex = 1
Top = 2400
Width = 5055
Begin VB.OptionButton Option1
Caption = "&O.横向"
Height = 375
Index = 1
Left = 3240
TabIndex = 74
Top = 480
Width = 855
End
Begin VB.OptionButton Option1
Caption = "&V.纵向"
Height = 375
Index = 0
Left = 1800
TabIndex = 2
Top = 480
Width = 855
End
Begin MSComctlLib.ImageList ImageList1
Left = 600
Top = 360
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "SetPage.frx":09F9
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "SetPage.frx":114B
Key = ""
EndProperty
EndProperty
End
Begin VB.Image Image1
Height = 615
Left = 600
Top = 360
Width = 735
End
End
End
End
Attribute VB_Name = "SetPage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TemDataSet As New MDD_Data
Private Sub Combo1_Click()
'根据所选的纸张，取得纸张类型编号，并设置打印机。
On Error Resume Next
OutPaperInfo.PaperListIndex = Combo1.ListIndex + 1
GetPaperInfo OutPaperInfo
If OutPaperInfo.GetPaperErr = False Then
Text1(Abs(Me.Option1(1).Value)).Text = OutPaperInfo.PaperWidth / 10
Text1(1 - Abs(Me.Option1(1).Value)).Text = OutPaperInfo.PaperHeight / 10
End If
TemDataSet.Tables(7).Rows(0).Items(5).Value = OutPaperInfo.PaperSize '保存纸张编号。
End Sub
Private Sub Combo1_GotFocus()
If Combo1.ListCount < 1 Then
MsgBox "由于打印机错误，无法获取可用纸张列表！" & Chr(13) & "请确认是否已经安装并设置好打印机！", vbOKOnly, "错误..."
Exit Sub
End If
End Sub
Private Sub Combo2_Click(Index As Integer)
TemDataSet.Tables(7).Rows(0).Items(Index + 19).Value = Combo2(Index).ListIndex '纸张索引。
End Sub
Private Sub Combo3_Click(Index As Integer)
TemDataSet.Tables(7).Rows(0).Items(Index + 29).Value = Combo3(Index).ListIndex '对齐索引。
End Sub
Private Sub Command1_Click(Index As Integer)
Dim ForIndex As Long
Select Case Index
Case 0: '确定。
'将公用数据集指向修改后的数据.
If MyDataSet.Tables(7).RowCount <= 0 Then
MyDataSet.Tables(7).AddRow TemDataSet.Tables(7).Rows(0)
Else
For ForIndex = 0 To MyDataSet.Tables(7).Fields.FieldCount - 1
MyDataSet.Tables(7).Rows(0).Items(ForIndex).Value = TemDataSet.Tables(7).Rows(0).Items(ForIndex).Value
Next
End If
MyDataSet.Updatable = True '表示数据已经修改。
Unload Me
Case 1: '取消。
Unload Me
Case 2: '预览。
End Select
End Sub
Private Sub Command2_Click(Index As Integer)
On Error GoTo SetFontErr
'字体设置。
SefFontDialog.Flags = cdlCFBoth Or cdlCFEffects Or cdlCFANSIOnly
SefFontDialog.FontName = TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 32).Value
SefFontDialog.FontSize = TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 33).Value
SefFontDialog.FontBold = TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 34).Value \ 1000
SefFontDialog.FontItalic = (TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 34).Value Mod 1000) \ 100
SefFontDialog.FontStrikethru = (TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 34).Value Mod 100) \ 10
SefFontDialog.FontUnderline = (TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 34).Value Mod 10) \ 1
SefFontDialog.Color = TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 35).Value
SefFontDialog.CancelError = True
SefFontDialog.ShowFont
TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 32).Value = SefFontDialog.FontName
TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 33).Value = SefFontDialog.FontSize
TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 34).Value = Abs(SefFontDialog.FontBold) * 1000 + Abs(SefFontDialog.FontItalic) * 100 + Abs(SefFontDialog.FontStrikethru) * 10 + Abs(SefFontDialog.FontUnderline)
TemDataSet.Tables(7).Rows(0).Items(Index * 4 + 35).Value = SefFontDialog.Color
Exit Sub
SetFontErr:
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim ColIndex As Long
Dim ForIndex As Integer
Dim TemNum As Integer
'窗口标题设置。
Me.Caption = App.ProductName & " <页面设置>"
'备份数据库。
Set TemDataSet = New MDD_Data
For ForIndex = 0 To MyDataSet.TableCount - 1
TemDataSet.AddTable MyDataSet.Tables(ForIndex)
Next
TemDataSet.DatabaseName = MyDataSet.DatabaseName '数据库存名称.
TemDataSet.DataFileName = MyDataSet.DataFileName '文件名.
TemDataSet.PassStr = MyDataSet.PassStr '密码文本.
'使打印方向显示与打印机设置一致.
Me.Option1(Abs(CBool(TemDataSet.Tables(7).Rows(0).Items(6).Value - 1))).Value = True
'更新纸张列表。
Combo1.Clear
GetPaperInfo OutPaperInfo '第一次调用是为了取得纸张种类数。
TemNum = OutPaperInfo.PaperListCount
For ForIndex = 1 To TemNum '通过多次调用取得纸张名称列表。
OutPaperInfo.PaperListIndex = ForIndex
GetPaperInfo OutPaperInfo
If OutPaperInfo.GetPaperErr = True Then Exit For '如果出错，则跳出(此错误标志由被调用的函数重置)。
Me.Combo1.AddItem OutPaperInfo.PaperName '保存纸张名称到列表。
If TemDataSet.Tables(7).Rows(0).Items(5).Value = OutPaperInfo.PaperSize Then Combo1.ListIndex = ForIndex - 1 '表示与打印机中的纸张设置一致，则将该项作为当前选择项。
Next
'窗口显示位置。
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
For ColIndex = 9 To 12 '边距.
Text1(ColIndex - 7).Text = TemDataSet.Tables(7).Rows(0).Items(ColIndex).Value
Next
'页眉页脚.
For ColIndex = 0 To 5
Text3(ColIndex).Text = TemDataSet.Tables(7).Rows(0).Items(ColIndex + 13).Value
Next
Me.Combo2(0).ListIndex = TemDataSet.Tables(7).Rows(0).Items(19).Value '页眉对齐方式。
Me.Combo2(1).ListIndex = TemDataSet.Tables(7).Rows(0).Items(20).Value '页脚对齐方式。
'表格设置。
For ColIndex = 0 To 7
Text2(ColIndex).Text = TemDataSet.Tables(7).Rows(0).Items(ColIndex + 21).Value
Next
For ColIndex = 0 To 2
Combo3(ColIndex).ListIndex = TemDataSet.Tables(7).Rows(0).Items(ColIndex + 29).Value
Next
Me.SSTab1.Tab = 0
End Sub
Private Sub Option1_Click(Index As Integer)
On Error Resume Next
Me.Image1.Picture = Me.ImageList1.ListImages.Item(Index + 1).Picture '设置纸张方向显示的图片表示。
OutPaperInfo.PaperListIndex = Combo1.ListIndex + 1
GetPaperInfo OutPaperInfo
If OutPaperInfo.GetPaperErr = False Then
Text1(Abs(Me.Option1(1).Value)).Text = OutPaperInfo.PaperWidth / 10
Text1(1 - Abs(Me.Option1(1).Value)).Text = OutPaperInfo.PaperHeight / 10
End If
TemDataSet.Tables(7).Rows(0).Items(6).Value = Index + 1 '保存打印方向。
End Sub
Private Sub Text1_Change(Index As Integer)
If Index < 2 Then Exit Sub
TemDataSet.Tables(7).Rows(0).Items(Index + 7).Value = Text1(Index).Text
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub Text2_Change(Index As Integer)
TemDataSet.Tables(7).Rows(0).Items(Index + 21).Value = Text2(Index).Text
End Sub
Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
If Index >= 6 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub Text3_Change(Index As Integer)
TemDataSet.Tables(7).Rows(0).Items(Index + 13).Value = Text3(Index).Text
End Sub
Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
If Index >= 4 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -