gdhtemplate.frm

齐鲁石化某分公司的数据采集管理系统

VERSION 5.00
Begin VB.Form gdhTemplate 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "模板设置"
   ClientHeight    =   4170
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6435
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4170
   ScaleWidth      =   6435
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame4 
      Caption         =   "打印模板"
      Height          =   4095
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   6255
      Begin VB.CommandButton Command2 
         Caption         =   "退出"
         Height          =   375
         Left            =   4560
         TabIndex        =   7
         Top             =   3480
         Width           =   1335
      End
      Begin VB.CommandButton Command1 
         Caption         =   "保存设置"
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   3480
         Width           =   1935
      End
      Begin Gdhsystem.UserTemplate UserTemplate1 
         Height          =   615
         Index           =   0
         Left            =   120
         TabIndex        =   2
         Top             =   480
         Width           =   1695
         _ExtentX        =   2778
         _ExtentY        =   1085
      End
      Begin Gdhsystem.UserTemplate UserTemplate1 
         Height          =   615
         Index           =   1
         Left            =   120
         TabIndex        =   3
         Top             =   1560
         Width           =   1695
         _ExtentX        =   2778
         _ExtentY        =   1085
      End
      Begin Gdhsystem.UserTemplate UserTemplate1 
         Height          =   615
         Index           =   2
         Left            =   120
         TabIndex        =   4
         Top             =   2520
         Width           =   1695
         _ExtentX        =   2778
         _ExtentY        =   1085
      End
      Begin Gdhsystem.UserTemplate UserTemplate1 
         Height          =   615
         Index           =   3
         Left            =   2520
         TabIndex        =   5
         Top             =   3360
         Width           =   1695
         _ExtentX        =   2778
         _ExtentY        =   1085
      End
      Begin VB.Label Label6 
         BackColor       =   &H8000000E&
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   2775
         Left            =   2520
         TabIndex        =   1
         Top             =   480
         Width           =   3375
      End
   End
End
Attribute VB_Name = "gdhTemplate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const UserControlName = "usertemplate1"
Private Sub Command1_Click()
    Dim db As New Adodb.Connection
    Dim i As Integer
    On Error GoTo ok
    If Checking = False Then
        Exit Sub
    End If
    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 Sub
    End If
    
    For i = 0 To UserTemplate1.Count - 1
        Call Save_Template(db, UserControlName & i, UserTemplate1(i))
    Next i
    
    MsgBox "OK"
    Exit Sub
ok:
    MsgBox Err.Number
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    
    Call setCenter
    Call setUserTemplateValue
    UserTemplate1(3).sCaption = "启用打印模板"
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

Function getTemplateSet(cdb As Adodb.Connection, FieldName As String, UT As UserTemplate)
    Dim rs As New Adodb.Recordset
    Dim Query As String
    On Error GoTo ok
    
    Query = "select * from template where sname='" & FieldName & "'"
    rs.Open Query, cdb, adOpenDynamic, adLockOptimistic
    
    If rs.State <> 1 Then
        Exit Function
    End If
    
    If Not rs.BOF And Not rs.EOF Then
        If Not IsNull(rs.Fields("svalue")) Then
            UT.Value = rs.Fields("svalue")
        End If
        
        If Not IsNull(rs.Fields("scaption")) Then
            UT.sCaption = Trim(rs.Fields("scaption"))
        Else
            UT.sCaption = ""
        End If
    Else
        UT.Value = 0
        UT.sCaption = ""
    End If
    
    rs.Close
ok:
End Function

Function setUserTemplateValue()
    Dim db As New Adodb.Connection
    Dim i 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 UserTemplate1.Count - 1
        Call getTemplateSet(db, UserControlName & i, UserTemplate1(i))
    Next i
ok:
End Function
Function Initialize_()
    
    Label6.Caption = "如果选择了模板打印,打印时将按照 所选条件字段+表单 的样式打印数据"

End Function

Function Checking() As Boolean
    Dim SelectedCheck As Integer
    Dim i As Integer
    On Error GoTo ok
    
    If UserTemplate1(3).Value = 1 Then
    
        For i = 0 To 2
            If UserTemplate1(i).Value = 1 And UserTemplate1(i).sCaption = "" Then
                MsgBox "第" & (i + 1) & "个条件值不能为空"
                Exit Function
            ElseIf UserTemplate1(i).Value = 1 And UserTemplate1(i).sCaption <> "" Then
                SelectedCheck = SelectedCheck + 1
            Else
            End If
        Next i
        
        If SelectedCheck = 0 Then
            MsgBox "请选择分组字段"
            Exit Function
        End If
    Else
        For i = 0 To 2
            If UserTemplate1(i).Value = 1 And UserTemplate1(i).sCaption = "" Then
                MsgBox "第" & (i + 1) & "个条件值不能为空"
                Exit Function
            End If
        Next i
    End If
    Checking = True
ok:
End Function

Function Save_Template(cdb As Adodb.Connection, FieldName As String, UT As UserTemplate)
    
    Dim rs As New Adodb.Recordset
    Dim Query As String
    
    On Error GoTo ok
    Query = "delete from template where sname='" & FieldName & "'"
    cdb.Execute Query
    
'    Query = "update template set cvalue=" & check.Value & ",cenable=" & check.Enabled & ""
'    Query = Query + ",comboenable=" & Combo.Enabled & ",combotext='" & Combo.text & "'"
'    Query = Query + " where sname='" & FieldName & "'"
    Query = "insert into template(sname,svalue,scaption)Values('" & FieldName & "'," & UT.Value & ",'" & UT.sCaption & "')"
    cdb.Execute Query
ok:
End Function

Private Sub Form_Unload(Cancel As Integer)
    gdhMain.Enabled = True
End Sub