flp.frm

为个人用户开发的车险秘书系统

         HighlightColor  =   10658385
         Tooltiptitle    =   ""
         ToolTipIcon     =   0
         ToolTipType     =   0
         ttForeColor     =   0
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Verdana"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "查询条件："
         Height          =   180
         Left            =   3960
         TabIndex        =   28
         Top             =   240
         Width           =   900
      End
   End
End
Attribute VB_Name = "Flp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub Fresize()
    Me.Width = Fmain.Width
    Me.Height = Fmain.Height
    Me.Left = 0
    Me.Top = Fmain.Top
    
    Frame1.Top = 0
    Frame1.Width = Me.ScaleWidth
    Frame2.Width = Me.ScaleWidth
    Frame3.Width = Frame2.Width / 2
    Frame4.Width = Frame2.Width / 2 - 100
    Frame3.Left = 0
    Frame4.Left = Frame3.Width + 100
    Fshow.Width = Me.ScaleWidth
    Lvlp.Width = Fshow.Width - 50
    
    Frame5.Left = (Frame2.Width - Frame5.Width) / 2
    
    If Frame5.Visible = False Then
        Frame2.Height = Frame3.Height + 100
        Frame3.Top = 100
        Frame4.Top = 100
    Else
        Frame2.Height = Frame3.Height + Frame5.Height + 100
        Frame3.Top = Frame5.Height + 100
        Frame4.Top = Frame5.Height + 100
    End If
    Frame2.Top = Me.ScaleHeight - Frame2.Height - 100
    Fshow.Height = Me.ScaleHeight - Frame1.Height - Frame2.Height - 200
    Lvlp.Height = Fshow.Height - 250
    Tmark.Width = Frame3.Width - 50
    Tother.Width = Frame4.Width - 50
    
End Sub

Private Sub Form_Load()
    Dim ssql As String
    Dim vda As String
    
    Call Fresize
    
    With Omy
        .AddItem "满意"
        .AddItem "不满意"
        .ListIndex = 0
    End With
    
    With Oja
        .AddItem "已结案"
        .AddItem "未结案"
        .ListIndex = 0
    End With
    
    vda = DateAdd("m", -1, Date)
    ssql = "where vdate > #" & vda & "#"
    
    Call vsqlshow(ssql)
End Sub

Private Sub isButton10_Click()
    'vda = DateAdd("m", -1, Date)
    'ssql = "where vdate > #" & vda & "#"
    Call vsqlshow("")

End Sub

Private Sub isButton11_Click()
    If Lvlp.ListItems.Count > 0 Then
        gPrintListView Lvlp, "理赔资料"
    Else
        MsgBox "没有需要打印的内容"
    End If
End Sub

Private Sub isButton12_Click()
    Unload Me
End Sub

Private Sub isButton3_Click()
    Dim i As Integer
    
    If Frame5.Visible = False Then
        Frame5.Visible = True
        Frame5.Enabled = True
        Call Fresize
        
        For i = 0 To 10
                Tmsg(i).Text = ""
        Next i
        Tmark.Text = ""
        Tother.Text = ""
        Tadd.Text = "add"
    Else
        Frame5.Visible = False
        Frame5.Enabled = False
        Call Fresize
        Tmark.Text = ""
        Tother.Text = ""
        Tadd.Text = ""
    End If
End Sub

Private Sub isButton4_Click()
    Dim sql As String
    
    sql = "delete from lp where id= '" & Lvlp.SelectedItem.Text & "'"
    Call exsql(sql)
    Call vsqlshow("")
End Sub

Private Sub isButton5_Click()
    Frame5.Visible = False
    Frame5.Enabled = False
    Call Fresize
    
    If Tadd.Text = "add" Then
        Call vsqlinsert
    Else
        Call vsqlupdate
    End If
    Call vsqlshow("")
End Sub

Private Sub vsqlupdate()
    Dim vid, sql As String
    Dim vdb As Boolean
    Dim vnum As Integer
    
    vid = Trim$(Tmsg(0).Text)
    If vid = "" Then
        MsgBox "请填写正确的保单号！"
        Exit Sub
    End If
    
    vdb = ExcSql
    If vdb = True Then
        sql = "select count(id) from lp where id='" & vid & "'"
        vnum = conn.Execute(sql)(0)
        If vnum = 0 Then
            MsgBox "您输入的保单号不存在！"
            Exit Sub
        End If
        
        sql = "update lp set name ='" & Tmsg(1).Text & "',tel='" & Tmsg(2).Text & "',vdate=#" & Oda.Text & "#,carn='" & Tmsg(3).Text & "'," & _
        "changn='" & Tmsg(4).Text & "',xname='" & Tmsg(5).Text & "',sfee='" & Tmsg(7).Text & "',pfee='" & Tmsg(8).Text & "',myd='" & Omy.Text & "',ja='" & Oja.Text & "',mark='" & Tmark.Text & "',other='" & Tother.Text & "',bbx='" & Tmsg(9).Text & "',btel='" & Tmsg(10).Text & "' where id='" & vid & "'"
        Call exsql(sql)
    End If
End Sub

Private Sub vsqlinsert()
    Dim vid, sql As String
    Dim vdb As Boolean
    Dim vnum As Integer
    
    vid = Trim$(Tmsg(0).Text)
    If vid = "" Then
        MsgBox "请填写正确的保单号！"
        Exit Sub
    End If
    
    vdb = ExcSql
    If vdb = True Then
        sql = "select count(id) from orders where id='" & vid & "'"
        vnum = conn.Execute(sql)(0)
        If vnum = 0 Then
            MsgBox "您输入的保单号不存在，请确认后再记录该信息！"
            Exit Sub
        End If
        
        sql = "insert into lp values('" & Tmsg(0).Text & "','" & Tmsg(1).Text & "','" & Tmsg(2).Text & "','" & Oda.Text & "','" & Tmsg(3).Text & "'," & _
        "'" & Tmsg(4).Text & "','" & Tmsg(5).Text & "','" & Tmsg(7).Text & "','" & Tmsg(8).Text & "','" & Omy.Text & "','" & Oja.Text & "','" & Tmark.Text & "','" & Tother.Text & "','" & Tmsg(9).Text & "','" & Tmsg(10).Text & "')"
        Call exsql(sql)
    End If
End Sub

Private Sub vsqlshow(ByVal Osel As String)
        Dim sql As String
        Dim c As ListItem
        Dim vdb As Boolean
        Dim rs As Recordset
        
        Lvlp.ListItems.Clear
        sql = "select * from lp " & Osel & " order by vdate desc"
        vdb = ExcSql
        If vdb = True Then
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
                Do While Not rs.EOF
                    Set c = Lvlp.ListItems.Add(, , rs("id") & "")
                    c.SubItems(1) = rs("id") & ""
                    c.SubItems(2) = rs("name") & ""
                    c.SubItems(3) = rs("tel") & ""
                    c.SubItems(4) = rs("bbx") & ""
                    c.SubItems(5) = rs("btel") & ""
                    c.SubItems(8) = rs("vdate") & ""
                    c.SubItems(6) = rs("carn") & ""
                    c.SubItems(7) = rs("changn") & ""
                    c.SubItems(9) = rs("xname") & ""
                    c.SubItems(10) = rs("sfee") & ""
                    c.SubItems(11) = rs("pfee") & ""
                    c.SubItems(12) = rs("myd") & ""
                    c.SubItems(13) = rs("ja") & ""
                rs.MoveNext
                Loop
            End If
            rs.Close
            Set rs = Nothing
        End If
End Sub


Private Sub isButton6_Click()
    If Frame5.Visible = False Then
        Frame5.Visible = True
        Frame5.Enabled = True
        Call Fresize
        
        Tadd.Text = "change"
        Call vsqlshow("")
    Else
        Frame5.Visible = False
        Frame5.Enabled = False
        Call Fresize
        
        Tadd.Text = ""
        Call vsqlshow(Lvlp.SelectedItem.Text)
    End If
End Sub

Private Sub isButton8_Click()
    Dim sql As String
     Dim c As ListItem
        Dim vdb As Boolean
        Dim rs As Recordset
        
        Lvlp.ListItems.Clear
        sql = "select * from lp where name='" & Trim$(Tselmsg.Text) & "'"
        vdb = ExcSql
        If vdb = True Then
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
               GoTo showmsg
               Exit Sub
            End If
            
            sql = "select * from lp where tel='" & Trim$(Tselmsg.Text) & "'"
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
               GoTo showmsg
               Exit Sub
            End If
            
            sql = "select * from lp where carn='" & Trim$(Tselmsg.Text) & "'"
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
               GoTo showmsg
               Exit Sub
            Else
                MsgBox "您搜寻的信息不存在！"
                Call vsqlshow("")
            End If
            
        End If
        Exit Sub
showmsg:
                Do While Not rs.EOF
                     Set c = Lvlp.ListItems.Add(, , rs("id") & "")
                    c.SubItems(1) = rs("id") & ""
                    c.SubItems(2) = rs("name") & ""
                    c.SubItems(3) = rs("tel") & ""
                    c.SubItems(4) = rs("bbx") & ""
                    c.SubItems(5) = rs("btel") & ""
                    c.SubItems(8) = rs("vdate") & ""
                    c.SubItems(6) = rs("carn") & ""
                    c.SubItems(7) = rs("changn") & ""
                    c.SubItems(9) = rs("xname") & ""
                    c.SubItems(10) = rs("sfee") & ""
                    c.SubItems(11) = rs("pfee") & ""
                    c.SubItems(12) = rs("myd") & ""
                    c.SubItems(13) = rs("ja") & ""
                rs.MoveNext
                Loop
                rs.Close
                Set rs = Nothing
End Sub

Private Sub Lvlp_Click()
    Dim sql As String
    Dim rs As Recordset
    Dim vdb As Boolean
    
    If Lvlp.ListItems.Count > 0 Then
    
    sql = "select * from lp where id='" & Lvlp.SelectedItem.Text & "'"
    vdb = ExcSql
    If vdb = True Then
        Set rs = conn.Execute(sql)
        If Not rs.EOF Then
            Tmsg(0).Text = rs("id") & ""
            Tmsg(1).Text = rs("name") & ""
            Tmsg(2).Text = rs("tel") & ""
            Oda.Text = rs("vdate") & ""
            Tmsg(3).Text = rs("carn") & ""
            Tmsg(4).Text = rs("changn") & ""
            Tmsg(5).Text = rs("xname") & ""
            'Tmsg(6).Text = rs("sfee") & ""
            Tmsg(7).Text = rs("sfee") & ""
            Tmsg(8).Text = rs("pfee") & ""
            Omy.Text = rs("myd") & ""
            Oja.Text = rs("ja") & ""
            Tmark.Text = rs("mark")
            Tother.Text = rs("other")
            Tmsg(9).Text = rs("bbx") & ""
            Tmsg(10).Text = rs("btel") & ""
        End If
        rs.Close
        Set rs = Nothing
        Tadd.Text = "change"
    End If
    
    End If
End Sub