📄 gdhprintfield.frm
字号:
VERSION 5.00
Begin VB.Form gdhPrintField
Caption = "打印内容设置"
ClientHeight = 7665
ClientLeft = 60
ClientTop = 450
ClientWidth = 9120
LinkTopic = "Form1"
ScaleHeight = 7665
ScaleWidth = 9120
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame3
Caption = "打印设置"
Height = 7575
Left = 120
TabIndex = 0
Top = 0
Width = 8895
Begin VB.CommandButton Command2
Caption = "退出"
Height = 375
Left = 7440
TabIndex = 23
Top = 6840
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "保存设置"
Height = 375
Left = 4800
TabIndex = 22
Top = 6840
Width = 1215
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 0
Left = 120
TabIndex = 2
Top = 240
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 1
Left = 120
TabIndex = 3
Top = 840
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 2
Left = 120
TabIndex = 4
Top = 1440
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 3
Left = 120
TabIndex = 5
Top = 2040
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 4
Left = 120
TabIndex = 6
Top = 2640
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 5
Left = 120
TabIndex = 7
Top = 3240
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 6
Left = 120
TabIndex = 8
Top = 3840
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 7
Left = 120
TabIndex = 9
Top = 4440
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 8
Left = 120
TabIndex = 10
Top = 5040
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 9
Left = 120
TabIndex = 11
Top = 5640
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 10
Left = 4680
TabIndex = 12
Top = 240
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 11
Left = 4680
TabIndex = 13
Top = 840
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 12
Left = 4680
TabIndex = 14
Top = 1440
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 13
Left = 4680
TabIndex = 15
Top = 2040
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 14
Left = 4680
TabIndex = 16
Top = 2640
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 15
Left = 4680
TabIndex = 17
Top = 3240
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 16
Left = 4680
TabIndex = 18
Top = 3840
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 17
Left = 4680
TabIndex = 19
Top = 4440
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 18
Left = 4680
TabIndex = 20
Top = 5040
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 19
Left = 4680
TabIndex = 21
Top = 5640
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin Gdhsystem.UserLabel UserLabel1
Height = 615
Index = 20
Left = 120
TabIndex = 24
Top = 6840
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
End
Begin VB.Label Label5
BackColor = &H00C0C0C0&
Caption = "1个汉字占2个英文字符的位置"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 120
TabIndex = 1
Top = 6240
Width = 2655
End
End
End
Attribute VB_Name = "gdhPrintField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const UserControlName = "userlabel1"
Function setUserLabelValue(cdb As Adodb.Connection, FieldName As String, UL As UserLabel)
Dim rs As New Adodb.Recordset
Dim Query As String
On Error GoTo ok
Query = "select * from fieldset where sname='" & FieldName & "'"
rs.Open Query, cdb, adOpenDynamic, adLockOptimistic
If rs.State <> 1 Then Exit Function
If Not rs.BOF And Not rs.EOF Then
If Not IsNull(rs.Fields("slenth")) Then '字段长度
Call UL.TextEdit(Trim(rs.Fields("slenth")))
Else
End If
If Not IsNull(rs.Fields("snape")) Then '对齐方式
Call UL.ComboEdit((rs.Fields("snape")))
Else
Call UL.ComboEdit("右对齐")
End If
If Not IsNull(rs.Fields("scheck")) Then '是否选中
Call UL.CheckEdit(Int(Val(Trim(rs.Fields("scheck")))))
Else
Call UL.CheckEdit(0)
End If
If Not IsNull(rs.Fields("scheckcaption")) Then '字段名
Call UL.CheckCaptionEdit(rs.Fields("scheckcaption"))
Else
Call UL.CheckCaptionEdit("")
End If
Else
Call UL.ComboEdit("右对齐")
Call UL.CheckEdit(0)
Call UL.CheckCaptionEdit("")
End If
rs.Close
ok:
End Function
Function setAllUserLabel()
Dim i As Integer
Dim db As New Adodb.Connection
Dim j As Integer
On Error GoTo ok
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\printgrid.mdb;Jet OLEDB:Database Password=dfrwadmin;"
If db.State <> 1 Then
Exit Function
End If
For i = 0 To UserLabel1.Count - 1
Call setUserLabelValue(db, UserControlName & i, UserLabel1(i))
Next i
db.Close
ok:
End Function
Function saveFieldValue(cdb As Adodb.Connection, FieldName As String, check As String, checkCaption As String, text As String, Combo As String)
Dim Query As String
On Error GoTo ok
Query = "delete from fieldset where sname='" & FieldName & "'"
cdb.Execute Query
Query = "insert into fieldset values('" & FieldName & "','" & text & "','" & Combo & "','" & check & "','" & checkCaption & "')"
cdb.Execute Query
Exit Function
ok:
MsgBox "入库时出错：" & Err.Number
End Function
Function saveAllUserLabelValue()
Dim db As New Adodb.Connection
Dim i As Integer
Dim Query As String
On Error GoTo ok
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\printgrid.mdb;Jet OLEDB:Database Password=dfrwadmin;"
If db.State <> 1 Then
Exit Function
End If
For i = 0 To UserLabel1.Count - 1
Call saveFieldValue(db, UserControlName & i, Trim(str(UserLabel1(i).GetCheckValue)), UserLabel1(i).GetCheckCaption _
, UserLabel1(i).GetTextCaption, UserLabel1(i).GetComboCaption)
Next i
db.Close
MsgBox "OK"
ok:
End Function
Private Sub Command1_Click()
Dim db As New Adodb.Connection
On Error GoTo ok
Call saveAllUserLabelValue
Exit Sub
ok:
MsgBox "出错：" & Err.Number
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo ok
Call setCenter
Call setAllUserLabel
Call UserLabel1(20).LabelEdit("缇")
UserLabel1(20).comboVisible = False
ok:
End Sub
Function setCenter()
Dim X0 As Long
Dim Y0 As Long
X0 = Screen.Width
Y0 = Screen.Height
X0 = (X0 - Me.Width) / 2
Y0 = (Y0 - Me.Height) / 2
Me.Move X0, Y0
End Function
Private Sub Form_Unload(Cancel As Integer)
gdhMain.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -