frmphcustomin.frm

这是用Visual Basic6开发的大型喷绘业务管理系统,数据库采用Access数据库

      Top             =   3780
      Width           =   1005
   End
   Begin VB.Label Label1 
      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          =   285
      Index           =   8
      Left            =   1740
      TabIndex        =   10
      Top             =   4170
      Width           =   1005
   End
   Begin VB.Image Image2 
      Height          =   375
      Left            =   5460
      Picture         =   "frmPHcustomIn.frx":8411E
      Top             =   210
      Width           =   390
   End
   Begin VB.Image Image1 
      Height          =   330
      Left            =   5880
      Picture         =   "frmPHcustomIn.frx":84930
      Top             =   210
      Width           =   330
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "客户资料录入"
      ForeColor       =   &H0000FFFF&
      Height          =   315
      Index           =   0
      Left            =   900
      TabIndex        =   9
      Top             =   300
      Width           =   1185
   End
End
Attribute VB_Name = "frmPHcustomIn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim n As Integer
Dim jframe As New dframe
Dim env As rdoEnvironment
Dim cn As rdoConnection
Dim result As rdoResultset
Dim sql As String
Dim d_conn As String
Dim i As Integer
Dim hrecord As Integer

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Form_Load()
     rgn1 = 0
   n = 0
   Dim Ma As Dat
   Show
   Open App.Path & "\customin.dat" For Random As #1 Len = Len(Ma)
   Do While Not EOF(1)
      n = n + 1
      Get #1, n, Ma
      If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
      If rgn1 <> 0 Then
            rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
            CombineRgn rgn1, rgn1, rgn2, 2
                  '释放系统资源
            DeleteObject rgn2
      End If
  Loop
'关闭文件
    Close #1
    SetWindowRgn hwnd, rgn1, True
    DeleteObject rgn1
      ''''''''''连接远程数据库SQL SERVER''''
    Set env = rdoEnvironments(0)
    env.CursorDriver = rdUseOdbc
    d_conn = "uid=sa;pwd=;driver={SQL SERVER};SERVER=ntserver;database=phdatabase;"
    Set cn = env.OpenConnection(dsname:="odbc_api_demo", Prompt:="rdodriverprompt", ReadOnly:=False, Connect:=d_conn)
    If CustomInFlag = 2 Then
       Combo1.Text = Trim(CUSTOMSelectText(0))
       Text1.Text = Trim(CUSTOMSelectText(1))
       Text2.Text = Trim(CUSTOMSelectText(2))
       Text3.Text = Trim(CUSTOMSelectText(3))
       Text4.Text = Trim(CUSTOMSelectText(4))
       Text5.Text = Trim(CUSTOMSelectText(5))
       Text6.Text = Trim(CUSTOMSelectText(6))
       
    End If
    ''''''''''
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       mX = X
       mY = Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       frmPHcustomIn.Move frmPHcustomIn.Left - mX + X, frmPHcustomIn.Top - mY + Y
    End If
    Picture1.Cls
    Picture2.Cls
End Sub

Private Sub Form_Paint()
      '''''商品编号'''
    jframe.danum = 3
    jframe.rtop = 50
    jframe.rleft = 35
    jframe.rright = 409
    jframe.rbottom = 380
    jframe.ddraw frmPHcustomIn
    ''''''''
'    jframe.danum = 3
'    jframe.rtop = 102
'    jframe.rleft = 35
'    jframe.rright = 339
'    jframe.rbottom = 290
'    jframe.ddraw frmPHcustom
End Sub

Private Sub Image1_Click()
    Unload Me
End Sub

Private Sub Image2_Click()
    frmPHcustomIn.WindowState = 1
End Sub

Private Sub Picture1_Click()
   If CustomInFlag = 1 Then
     If MsgBox("确定是否存盘？", 36, "存盘！！") = 6 Then
       sql = "insert into  CustomTable(客户类别,客户名称,联系人,联系电话,传真,地址,电子邮件,网址,银行帐号)  values('" & Trim(Combo1.Text) & "','" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "','" & Trim(Text3.Text) & "','" & Trim(Text4.Text) & "','" & Trim(Text5.Text) & "','" & Trim(Text6.Text) & "','" & Trim(Text7.Text) & "','" & Trim(Text8.Text) & "')"
       Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
       MsgBox "存盘结束！！"
       '''''''
        sql = "select  *  from  customtable  where  客户类别='" & Trim(Combo1.Text) & "'"
        Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
            frmPHcustom.ListView1.ListItems.Clear
            If result.RowCount <> 0 Then
               Do While Not result.EOF()
                    Set itm = frmPHcustom.ListView1.ListItems.Add(, , result("客户类别"))
                    itm.SubItems(1) = Trim(result("客户名称"))
                    itm.SubItems(2) = Trim(result("联系人"))
                    itm.SubItems(3) = Trim(result("联系电话"))
                    itm.SubItems(4) = Trim(result("传真"))
                    itm.SubItems(5) = Trim(result("电子邮件"))
                    result.MoveNext
               Loop
            End If
       End If
    End If
    If CustomInFlag = 2 Then
       
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Picture2.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 80
    jframe.rbottom = 23
    jframe.ddrawc Picture1
End Sub

Private Sub Picture2_Click()
    Unload Me
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Picture1.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 80
    jframe.rbottom = 23
    jframe.ddrawc Picture2
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub

Private Sub Text8_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub