套帐选择.frm

煤炭销售管理系统.完成煤炭销售的日常管理工作,和重车计量系统空车计量系统配合使用.

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form tzxz 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择套帐"
   ClientHeight    =   1785
   ClientLeft      =   1845
   ClientTop       =   3960
   ClientWidth     =   4350
   Icon            =   "套帐选择.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1785
   ScaleWidth      =   4350
   Begin VB.ComboBox Combo1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1800
      TabIndex        =   4
      Text            =   "01"
      Top             =   360
      Width           =   2055
   End
   Begin VB.PictureBox picButtons 
      Align           =   2  'Align Bottom
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   420
      Left            =   0
      ScaleHeight     =   420
      ScaleWidth      =   4350
      TabIndex        =   1
      Top             =   1365
      Width           =   4344
      Begin VB.CommandButton Command1 
         Caption         =   "确定"
         Height          =   255
         Left            =   1080
         TabIndex        =   3
         Top             =   120
         Width           =   975
      End
      Begin VB.CommandButton cmdClose 
         Caption         =   "关闭(&C)"
         Height          =   255
         Left            =   2520
         TabIndex        =   2
         Top             =   120
         Width           =   975
      End
   End
   Begin MSAdodcLib.Adodc datPrimaryRS 
      Align           =   2  'Align Bottom
      Height          =   336
      Left            =   0
      Top             =   1032
      Visible         =   0   'False
      Width           =   4344
      _ExtentX        =   7673
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "PROVIDER=MSDASQL;dsn=dzqch;uid=sa;pwd=;"
      OLEDBString     =   "PROVIDER=MSDASQL;dsn=dzqch;uid=sa;pwd=;"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "select tzsy from tzsy"
      Caption         =   " "
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H0000FFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "选择套帐："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   1455
   End
End
Attribute VB_Name = "tzxz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
jl_tzsy = Me.Combo1.Text
jl_sqlstr = "jlk"
jl_sqlstr = Trim(jl_sqlstr)
'Debug.Print jl_sqlstr
Unload Me
'Form1.Show
frmLogin.Show
End Sub

Private Sub Form_Load()
'On Error GoTo errt
Dim conn As Boolean
conn = connet()
If conn = True Then
'***********************

'**************************
Set cn = New ADODB.Connection
cn.ConnectionString = connetstr
cn.Open
cn.Execute "update htk set jcje=(wfl*dj)/1000 "


Me.datPrimaryRS.ConnectionString = connetstr
Me.datPrimaryRS.refresh
End If


Dim recc As Long
recc = Me.datPrimaryRS.Recordset.RecordCount
For jj = 0 To recc - 1
Me.Combo1.AddItem Me.datPrimaryRS.Recordset.Fields("tzsy"), jj
Me.datPrimaryRS.Recordset.MoveNext
Next jj

Exit Sub
errt:
MsgBox "数据库配置不正确，请重新配置", , "数据库配置检测"
frmODBCLogon.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '错误处理程序代码置于此处
  '想要忽略错误，注释掉下一行
  '想要捕获它们，在此添加代码以处理它们
  MsgBox "Data error event hit err:" & Description
End Sub

Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  '为这个 recordset 显示当前记录位置
  datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub

Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  '验证代码置于此处
  '下列动作发生时该事件被调用
  Dim bCancel As Boolean

  Select Case adReason
  Case adRsnAddNew
  Case adRsnClose
  Case adRsnDelete
  Case adRsnFirstChange
  Case adRsnMove
  Case adRsnRequery
  Case adRsnResynch
  Case adRsnUndoAddNew
  Case adRsnUndoDelete
  Case adRsnUndoUpdate
  Case adRsnUpdate
  End Select

  If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub