⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 flpnew.frm

📁 为个人用户开发的车险秘书系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
Attribute VB_Name = "FlpNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub addmenu_Click()
    Call isButton3_Click
End Sub

Private Sub Cbo_KeyPress(KeyAscii As Integer)
    Call Tinsert_KeyPress(13)
End Sub

Private Sub changemenu_Click()
    Call MSFzy_DblClick
End Sub

Private Sub delmenu_Click()

    Call MSFzyDelMsg(MSFzy.TextMatrix(MSFzy.Row, 0))

    Call vsqlshow("")
End Sub

Private Sub Form_Load()
    Dim ssql As String
    Dim vda As String
    
    Dim c As cTab
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    
    With vTab
      Set c = .Tabs.Add("SOLUTION", , "理赔管理")
      c.IconIndex = 0
      c.Panel = Pickl
   End With
    vTab.ShowCloseButton = False
    
   
    Call Form_Resize
    'Call showTital
    vda = DateAdd("m", -1, Date)
    ssql = "where vdate > #" & vda & "#"
    
    Call vsqlshow(ssql)
End Sub

Private Sub Form_Resize()
    Me.Width = Fmain.Width
    Me.Height = Fmain.Height
    Me.Left = 0
    Me.Top = Fmain.Top
    
    vTab.Height = Me.ScaleHeight - Frame1.Height
    Pickl.Width = Me.Width
    Frame1.Width = Me.ScaleWidth
    MSFzy.Width = Pickl.Width
    MSFzy.Height = Pickl.Height
End Sub

Private Sub showTital()
    'MSFzy.Cols = 11
    InitSingleCol FlpNew.MSFzy, "", 0, 0, 0
    InitSingleCol FlpNew.MSFzy, "报案日期", 1, 0, 1600
    InitSingleCol FlpNew.MSFzy, "保险单编号", 2, 0, 2200
    InitSingleCol FlpNew.MSFzy, "被保险人", 3, 0, 1500
    InitSingleCol FlpNew.MSFzy, "行驶证车主", 4, 0, 1500
    InitSingleCol FlpNew.MSFzy, "被保人手机", 5, 0, 1900
    InitSingleCol FlpNew.MSFzy, "推荐人", 6, 0, 1500
    InitSingleCol FlpNew.MSFzy, "推荐人电话", 7, 0, 1900
    InitSingleCol FlpNew.MSFzy, "厂牌型号", 8, 0, 1500
    InitSingleCol FlpNew.MSFzy, "车 牌 号", 9, 0, 1500
    InitSingleCol FlpNew.MSFzy, "修理厂家", 10, 0, 1800
    InitSingleCol FlpNew.MSFzy, "修理厂电话", 11, 0, 1800
    InitSingleCol FlpNew.MSFzy, "损失金额", 12, 0, 1500
    InitSingleCol FlpNew.MSFzy, "实际赔付", 13, 0, 2540
    InitSingleCol FlpNew.MSFzy, "备    注", 14, 0, 2000
    InitSingleCol FlpNew.MSFzy, "结    案", 15, 0, 800
    InitSingleCol FlpNew.MSFzy, "满 意 度", 16, 0, 800
    InitSingleCol FlpNew.MSFzy, "其    它", 17, 0, 2000
    
    MSFzy.Rows = 1
End Sub

Private Sub vsqlshow(ByVal Osel As String)
        Dim sql, vstring As String
        Dim c As ListItem
        Dim vdb As Boolean
        Dim rs As Recordset
        Dim vda As String
        
        If Trim$(Osel) = "" Then
                vda = DateAdd("m", -2, Date)
                Osel = "where c.vdate > #" & vda & "#"
        End If
        
        MSFzy.Clear
        Call showTital
        sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
        ",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
        "insurance_info as a,car_info as b,lp as c " & Osel & " and a.serial=b.serial and a.serial=c.id order by c.vdate desc"
        '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
                    
                vstring = rs("d19") & "◆◆" & rs("d10") & "◆◆" & rs("d19") & "◆◆" & rs("d2") & "◆◆" & rs("d3") & "◆◆" _
                & rs("d4") & "◆◆" & rs("d5") & "◆◆" & rs("d6") & "◆◆" & rs("d8") & "◆◆" & rs("d9") & "◆◆" _
                & rs("d11") & "◆◆" & rs("d12") & "◆◆" & rs("d13") & "◆◆" & rs("d14") & "◆◆" & rs("d17") & "◆◆" _
                & rs("d16") & "◆◆" & rs("d15") & "◆◆" & rs("d18") & "◆◆"
                
                
                
                
               ' vstring = rs("id") & "◆◆" & rs("name") & "◆◆" & rs("tel") & "◆◆" & rs("bbx") & "◆◆" _
               ' & rs("btel") & "◆◆" & rs("carn") & "◆◆" & rs("changn") & "◆◆" & rs("vdate") & "◆◆" & rs("xname") & "◆◆" _
               ' & rs("sfee") & "◆◆" & rs("pfee") & "◆◆" & rs("myd") & "◆◆" & rs("ja") & "◆◆"

                Call AddRowInFlex(FlpNew.MSFzy, vstring)
                rs.MoveNext
                Loop
            End If
            rs.Close
            Set rs = Nothing
        End If
        Timer1.Enabled = False
        Call Form_Resize
End Sub

Private Sub isButton11_Click()
    Call printDate(FlpNew.MSFzy)
End Sub

Private Sub isButton12_Click()
    Unload Me
End Sub

Private Sub isButton3_Click()
    Load FlpAdd
    'FlpAdd.SetFocus
    FlpAdd.Show
End Sub

Private Sub isButton4_Click()
    Call MSFzyDelMsg(MSFzy.TextMatrix(MSFzy.Row, 0))
    Call vsqlshow("")
    Call Form_Resize
End Sub

Private Sub isButton8_Click()
        Dim sql, vstring As String
        Dim vdb As Boolean
        Dim rs As Recordset
        
        MSFzy.Clear
        Call showTital
        'sql = "select * from lp where name='" & Trim$(Tselmsg.Text) & "'"
        sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
        ",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
        "insurance_info as a,car_info as b,lp as c where b.serial=c.id and a.serial=c.id and a.bpeo='" & 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) & "'"
            sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
        ",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
        "insurance_info as a,car_info as b,lp as c where b.serial=c.id and a.serial=c.id and a.email='" & 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) & "'"
            sql = "select a.serial as d1,a.bpeo as d2,a.xsz as d3,a.email as d4,a.Tpeo as d5,a.agio as d6,b.serial as d7,b.cpxh as d8" & _
        ",b.cph as d9,c.id as d19,c.vdate as d10,c.xname as d11,c.xltel as d12,c.sfee as d13,c.pfee as d14,c.myd as d15,c.ja as d16,c.mark as d17,c.other as d18 from " & _
        "insurance_info as a,car_info as b,lp as c where b.serial=c.id and a.serial=c.id and b.cph='" & 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
                    vstring = rs("d19") & "◆◆" & rs("d10") & "◆◆" & rs("d19") & "◆◆" & rs("d2") & "◆◆" & rs("d3") & "◆◆" _
                & rs("d4") & "◆◆" & rs("d5") & "◆◆" & rs("d6") & "◆◆" & rs("d8") & "◆◆" & rs("d9") & "◆◆" _
                & rs("d11") & "◆◆" & rs("d12") & "◆◆" & rs("d13") & "◆◆" & rs("d14") & "◆◆" & rs("d17") & "◆◆" _
                & rs("d16") & "◆◆" & rs("d15") & "◆◆" & rs("d18") & "◆◆"
                
                    Call AddRowInFlex(FlpNew.MSFzy, vstring)
                rs.MoveNext
                Loop
                rs.Close
                Set rs = Nothing
                Call Form_Resize
End Sub

Private Sub MSFzy_DblClick()
    Select Case MSFzy.Col
    
    Case 16
        Call showCombox(FlpNew.Cbo, 4)
        Call MSFDblClicksel(FlpNew.MSFzy, FlpNew.Cbo)
        
    Case 15
        Call showCombox(FlpNew.Cbo, 5)
        Call MSFDblClicksel(FlpNew.MSFzy, FlpNew.Cbo)

    Case 1
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case 10
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case 11
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case 12
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case 13
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case 14
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case 17
        Call MSFDblClick(FlpNew.MSFzy, FlpNew.Tinsert)
    Case Else
        Exit Sub
    End Select
    TS.Text = MSFzy.TextMatrix(MSFzy.Row, MSFzy.Col)
    Ts1.Text = MSFzy.Row
    Ts2.Text = MSFzy.Col
End Sub

Private Sub MSFzy_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        PopupMenu pu1
    Else
    '    If ((Cbo.Visible = True) Or (Tinsert.Visible = True)) Then
    '
    '        MSFzy.Row = Ts1.Text
    '        MSFzy.Col = Ts2.Text
    '
    '        Select Case Ts2.Text
    '        Case 15
    '            If Trim$(Cbo.Text) <> TS.Text Then
    '            Call Tinsert_KeyPress(13)
    '        End If
    '        Case 16
    '        If Trim$(Cbo.Text) <> TS.Text Then
    '            Call Tinsert_KeyPress(13)
    '        End If
    '        Case Else
    '           ' MsgBox Tinsert.Text
    '            If Trim$(Tinsert.Text) <> TS.Text Then
    '                Call Tinsert_KeyPress(13)
    '
    '            End If
    '        End Select
            Call MSFMouseDown(FlpNew.Tinsert)
            Call MSFMouseDownSel(FlpNew.Cbo)
    '    End If
            
    End If
End Sub

Private Sub Timer1_Timer()
    Call vsqlshow("")
End Sub

Private Sub MSFzy_KeyPress(KeyAscii As Integer)
    Select Case MSFzy.Col
    Case 15
        Call MSFKeyPresssel(KeyAscii, FlpNew.MSFzy, FlpNew.Cbo)
    Case 16
        Call MSFKeyPresssel(KeyAscii, FlpNew.MSFzy, FlpNew.Cbo)
    Case Else
        Call MSFKeyPress(KeyAscii, FlpNew.MSFzy, FlpNew.Tinsert)
    End Select
    
End Sub

Private Sub MSFzy_RowColChange()
    If MSFzy.Col = 15 Or MSFzy.Col = 16 Then
        Call MSFRowColChangeSel(FlpNew.MSFzy, FlpNew.Cbo)
    Else
        Call MSFRowColChange(FlpNew.MSFzy, FlpNew.Tinsert)
    End If
End Sub

Private Sub MSFzy_LeaveCell()
    Call MSFLeaveCell(FlpNew.MSFzy)
End Sub

Private Sub Tinsert_KeyPress(KeyAscii As Integer)
     '文本框起输入编辑框的作用,模拟网格单元,输入到文本框的内容,经过处理送到网格中,
    '当输入完后按回车键可以自动到下一列,若为最后一列,跳转到下一行的第一列等待输入。
    Dim sql, vmsg As String
    Dim Tablef As String
    
    On err GoTo vnextgo:
    
    If KeyAscii = 13 Then
            Select Case MSFzy.Col
            Case 1
                Tablef = "vdate"
                vmsg = Tinsert.Text
            Case 10
                Tablef = "xname"
                vmsg = Tinsert.Text
            Case 11
                Tablef = "xltel"
                vmsg = Tinsert.Text
            Case 12
                Tablef = "sfee"
                vmsg = Tinsert.Text
            Case 13
                Tablef = "pfee"
                vmsg = Tinsert.Text
            Case 14
                Tablef = "mark"
                vmsg = Tinsert.Text
            Case 15
                Tablef = "ja"
                vmsg = Cbo.Text
            Case 16
                Tablef = "myd"
                vmsg = Cbo.Text
            Case 17
                Tablef = "other"
                vmsg = Tinsert.Text
            Case Else
                'MsgBox "非法的操作方法,请查看帮助系统!"
                Exit Sub
            End Select
            
            If MSFzy.Col = 1 Or MSFzy.Col = 10 Or MSFzy.Col = 11 Or MSFzy.Col = 12 Or MSFzy.Col = 13 Or MSFzy.Col = 14 Or MSFzy.Col = 15 Or MSFzy.Col = 16 Or MSFzy.Col = 17 Then
            If MsgBox("你确定将" & MSFzy.Text & "修改为:<< " & vmsg & " >> 么?", vbYesNo, "确认提示") = vbYes Then
                    sql = "update lp set " & Tablef & "='" & vmsg & "' where id='" & MSFzy.TextMatrix(MSFzy.Row, 0) & "'"
                    'MsgBox sql
                    Call ExcSqlCZ(sql)
            Else
                    GoTo vnextgo
            End If
            Else
                Exit Sub
            End If
            
            If MSFzy.Col = 15 Or MSFzy.Col = 16 Then
                MSFzy.Text = Cbo.Text
            Else
                MSFzy.Text = Tinsert.Text
            End If
vnextgo:
            Tinsert.Visible = False
            MSFzy.SetFocus
            If MSFzy.Col < (MSFzy.Cols - 1) Then
                 MSFzy.Col = MSFzy.Col + 1
            ElseIf MSFzy.Row < MSFzy.Rows - 1 Then
                 MSFzy.Row = MSFzy.Row + 1
                 MSFzy.Col = 0
            End If
            KeyAscii = 0
         End If
End Sub

Private Sub MSFzyDelMsg(keyCheck As String)
        Dim sql As String
        If MsgBox("你确定将" & MSFzy.TextMatrix(MSFzy.Row, 2) & "的所有信息都删除么?", vbYesNo, "确认提示") = vbYes Then
                    sql = "delete from lp where id='" & MSFzy.TextMatrix(MSFzy.Row, 0) & "'"
                    Call ExcSqlCZ(sql)
                    Call vsqlshow("")
        End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -