frmcus.frm

用VB6.0编写的关于车辆运输调度的系统

            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1680
         TabIndex        =   8
         Top             =   2115
         Width           =   975
      End
      Begin VB.Label Label6 
         Alignment       =   1  'Right Justify
         Caption         =   "Address1:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1680
         TabIndex        =   7
         Top             =   1740
         Width           =   975
      End
      Begin VB.Label Label5 
         Alignment       =   1  'Right Justify
         Caption         =   "Customer Mail Name:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   600
         TabIndex        =   6
         Top             =   1365
         Width           =   2055
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         Caption         =   "Customer Alternate Name:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   990
         Width           =   2535
      End
      Begin VB.Label Label3 
         Alignment       =   1  'Right Justify
         Caption         =   "Customer Description:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   360
         TabIndex        =   4
         Top             =   615
         Width           =   2295
      End
      Begin VB.Label Label2 
         Caption         =   "Customer Code:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   5640
         TabIndex        =   3
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "Entity Code:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1320
         TabIndex        =   2
         Top             =   240
         Width           =   1335
      End
   End
   Begin PrjLDS.UserControl1 UserControl1 
      Height          =   615
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9855
      _ExtentX        =   17383
      _ExtentY        =   1085
   End
   Begin VB.Label lblstatus 
      Height          =   135
      Left            =   2280
      TabIndex        =   29
      Top             =   4200
      Width           =   255
   End
End
Attribute VB_Name = "frmcus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mkey As String
Private lCurRow As Long      '当前SPD的行
Private lCurCol As Long      '当前SPD的列

Private Enum cusdetail
        IsSelect = 1
        Entcode
        cuscode
        Cusdesc
        Altname
        Mainame
        Addres1
        Addres2
        Addres3
        Addres4
        Citcode
        Astatus
        
    MaxCols = Astatus
    
End Enum

Private Type Cusrc
   Entcode As String
   cuscode As String
   Cusdesc As String
   Altname As String
   Mainame As String
   Addres1 As String
   Addres2 As String
   Addres3 As String
   Addres4 As String
   Citcode As String
   Astatus As String
End Type
Private Cusrc() As Cusrc



Private Sub cmdall_Click()
Dim i As Long
    
    With vascus
        .Col = cusdetail.IsSelect
        For i = 1 To vascus.DataRowCnt
            .Row = i
            .Value = 1
        Next i
    End With
    
End Sub

Private Sub cmdnone_Click()
Dim i As Long
    
    With vascus
        .Col = cusdetail.IsSelect
        For i = 1 To vascus.DataRowCnt
            .Row = i
            .Value = 0
        Next i
    End With
End Sub

Private Sub Form_Load()
vascus.Width = SpreadW
vascus.Height = SpreadH
Cmd_ok.Visible = False
Cmd_no.Visible = False
PrBar1.Visible = False
Call InitToolBar
Call initcombobox
Call initspread

lCurRow = 1
lCurCol = 1


Call vasshow

frmcus.Height = 7500
frmcus.Width = 9100

End Sub

Private Sub initcombobox()
    cbostatus.AddItem "Y"
    cbostatus.AddItem "N"

End Sub
Private Sub initspread()
 
     With vascus
            .MaxRows = 0
            .MaxCols = 12 'enuDetailCols.MaxCols
            .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
            .Row = -1: .Col = -1
            .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
            .GridColor = vbBlack
     End With
    
     Call InitColHead
     
     lockspread vascus, True
                
End Sub

Private Sub InitColHead()

    With vascus
    SetColHead vascus, cusdetail.IsSelect, "Is Select", 10, True
    SetColHead vascus, cusdetail.Entcode, "Entity Code", 10
    SetColHead vascus, cusdetail.cuscode, "Customer Code", 11
    SetColHead vascus, cusdetail.Cusdesc, "Customer Desc", 16
    SetColHead vascus, cusdetail.Altname, "Customer Alternate Name", 24
    SetColHead vascus, cusdetail.Mainame, "Customer Mail Name", 16
    SetColHead vascus, cusdetail.Addres1, "Address1", 12, True
    SetColHead vascus, cusdetail.Addres2, "Address2", 12, True
    SetColHead vascus, cusdetail.Addres3, "Address3", 12, True
    SetColHead vascus, cusdetail.Addres4, "Address4", 12, True
    SetColHead vascus, cusdetail.Citcode, "City Code", 12, True
    SetColHead vascus, cusdetail.Astatus, "Active Status", 8, True
        
    End With
    
    
    Call SetBooleanType(vascus, -1, cusdetail.IsSelect)
End Sub


Private Sub InitToolBar()
    With UserControl1
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        '.DisplayButton "Redo", "Redo", False, , "Redo"
        .DisplayButton "Upload", "Upload", True, , "Upload"
        .DisplayButton "Find", "Find", True, , "Find"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        '.DisplayButton "Print", "Print", True, , "Print"
        .DisplayButton "Close", "Close", True, , "Close"
    End With

End Sub

Private Sub vasshow()
Dim rstcus As Recordset
Dim sSQL As String
Dim lrow As Integer

sSQL = "select * from appcus order by entcode,cuscode"
Set rstcus = Acs_cnt.Execute(sSQL)

With rstcus
vascus.MaxRows = 0
lrow = 0
Do While Not .EOF
    vascus.MaxRows = vascus.MaxRows + 1
    lrow = lrow + 1
    SetValue vascus, lrow, cusdetail.Entcode, gsEntCode
    SetValue vascus, lrow, cusdetail.cuscode, rstcus!cuscode
    SetValue vascus, lrow, cusdetail.Cusdesc, "" & rstcus!Cusdesc
    SetValue vascus, lrow, cusdetail.Altname, "" & rstcus!Altname
    SetValue vascus, lrow, cusdetail.Mainame, "" & rstcus!Mainame
    SetValue vascus, lrow, cusdetail.Addres1, "" & rstcus!Addres1
    SetValue vascus, lrow, cusdetail.Addres2, "" & rstcus!Addres2
    SetValue vascus, lrow, cusdetail.Addres3, "" & rstcus!Addres3
    SetValue vascus, lrow, cusdetail.Addres4, "" & rstcus!Addres4
    SetValue vascus, lrow, cusdetail.Citcode, "" & rstcus!Citcode
    SetValue vascus, lrow, cusdetail.Astatus, "" & rstcus!Astatus
    
    
.MoveNext
Loop
End With
rstcus.Close
Set rstcus = Nothing
Call vascus_Click(lCurCol, lCurRow)

End Sub




Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
  
    Dim cuscode As Long
Dim sSQL As String
Dim rstcus As Recordset
    
      If IsNumeric(Text1.Text) Then
         cuscode = CLng(Text1.Text)
         sSQL = "select * from appcus where cuscode = " & cuscode & ""
         Set rstcus = Acs_cnt.Execute(sSQL)
         With rstcus
         If Not .EOF Then
             txtentc.Text = gsEntCode
             Text1.Text = rstcus!cuscode
             
             txtcusd.Text = rstcus!Cusdesc
             txtaltn.Text = rstcus!Altname
             txtmain.Text = rstcus!Mainame
             txtadd1.Text = rstcus!Addres1
             txtadd2.Text = rstcus!Addres2
             txtadd3.Text = rstcus!Addres3
             txtadd4.Text = rstcus!Addres4
             txtcitc.Text = rstcus!Citcode
             cbostatus.Text = rstcus!Astatus
         Else
         MsgBox "The record does not exist!", vbExclamation, "Information"

         End If
         End With
         rstcus.Close
         Set rstcus = Nothing

     Else
         MsgBox "The input must be numeric!", vbOKOnly, "Error"
    
     End If
       End If
End Sub


Private Sub Text1_LostFocus()
'Dim Cuscode As Long
'Dim sSQL As String
'Dim rstcus As Recordset
'
'      If IsNumeric(Text1.Text) Then
'         Cuscode = CLng(Text1.Text)
'         sSQL = "select * from appcus where cuscode = " & Cuscode & ""
'         Set rstcus = Acs_cnt.Execute(sSQL)
'         With rstcus
'         If Not .EOF Then
'             txtentc.Text = gsEntCode
'             txtcusc.Text = rstcus!Cuscode
'             txtcusd.Text = rstcus!Cusdesc
'             txtaltn.Text = rstcus!Altname
'             txtmain.Text = rstcus!Mainame
'             txtadd1.Text = rstcus!Addres1
'             txtadd2.Text = rstcus!Addres2
'             txtadd3.Text = rstcus!Addres3
'             txtadd4.Text = rstcus!Addres4
'             txtcitc.Text = rstcus!Citcode
'             cbostatus.Text = rstcus!Astatus
'         Else
'         MsgBox "There haven't this record!", vbExclamation, "Information"
'
'         End If
'         End With
'         rstcus.Close
'         Set rstcus = Nothing
'
'     Else
'         MsgBox "The input must be numeric!", vbOKOnly, "Error"
'
'     End If

End Sub