📄 fzdkh.frm

📁 为个人用户开发的车险秘书系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      Visible         =   0   'False
      Begin VB.Menu addmenu 
         Caption         =   "添加"
      End
      Begin VB.Menu changemenu 
         Caption         =   "修改"
      End
      Begin VB.Menu delmenu 
         Caption         =   "删除"
      End
   End
End
Attribute VB_Name = "Fzdkh"
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 changemenu_Click()
    Call MSFzy_DblClick
End Sub

Private Sub delmenu_Click()
    Call MSFzyDelMsg(MSFzy.TextMatrix(MSFzy.Row, 0))
    Call sqlsel
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
    Pickl.Height = vTab.Height - 400
    Frame1.Width = Me.Width
    MSFzy.Width = Pickl.Width
    MSFzy.Height = Pickl.Height
   
End Sub

Private Sub Form_Load()
    Dim c As cTab
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    
    Call Form_Resize
    
    With vTab
      Set c = .Tabs.Add("SOLUTION", , "重点客户列表显示")
      c.IconIndex = 0
      c.Panel = Pickl
   End With

   vTab.ShowCloseButton = False
    
    Call sqlsel
    Call Form_Resize
End Sub

Private Sub showTital()
    MSFzy.Cols = 12
    InitSingleCol Fzdkh.MSFzy, "序号", 0, 0, 0
    InitSingleCol Fzdkh.MSFzy, "序号", 1, 0, 600
    InitSingleCol Fzdkh.MSFzy, "单位名称", 2, 0, 2400
    InitSingleCol Fzdkh.MSFzy, "联系人", 3, 0, 1500
    InitSingleCol Fzdkh.MSFzy, "职务", 4, 0, 1200
    InitSingleCol Fzdkh.MSFzy, "手机或电话", 5, 0, 2000
    InitSingleCol Fzdkh.MSFzy, "生日提醒", 6, 0, 1500
    InitSingleCol Fzdkh.MSFzy, "单位主要领导人", 7, 0, 1600
    InitSingleCol Fzdkh.MSFzy, "联系方式", 8, 0, 1800
    InitSingleCol Fzdkh.MSFzy, "推荐险种", 9, 0, 1500
    InitSingleCol Fzdkh.MSFzy, "单位地址", 10, 0, 2540
    InitSingleCol Fzdkh.MSFzy, "备注", 11, 0, 2540
    MSFzy.Rows = 1
End Sub

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

Private Sub isButton12_Click()
    Unload Me
End Sub

Private Sub isButton3_Click()
    Load Fzdkhadd
    Fzdkhadd.SetFocus
    Fzdkhadd.Show
End Sub

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

Private Sub sqlsel()
    Dim sql As String
    Dim rs As Recordset
    Dim vdb As Boolean
    Dim vdate, vstring As String
    Dim c As ListItem
    Dim i As Integer
    
    vdate = DateAdd("m", -1, Date)
     MSFzy.Clear
    Call showTital
    sql = "select * from zpeo where do_time>#" & vdate & "# order by month(do_time) asc"
    vdb = ExcSql
    If vdb = True Then
        Set rs = conn.Execute(sql)
        If Not rs.EOF Then
            i = 0
            Do While Not rs.EOF
               i = i + 1
                vstring = rs("id") & "◆◆" & i & "◆◆" & rs("name") & "◆◆" & rs("dw") & "◆◆" & rs("zw") & "◆◆" _
                & rs("tel") & "◆◆" & rs("br") & "◆◆" & rs("ld") & "◆◆" & rs("lx") & "◆◆" & rs("xz") & "◆◆" _
                & rs("addr") & "◆◆" & rs("mark") & "◆◆"
                'MsgBox vstring
                Call AddRowInFlex(Fzdkh.MSFzy, vstring)
            rs.MoveNext
            Loop
        End If
        rs.Close
        Set rs = Nothing
    End If
    Timer1.Enabled = False
    Call Form_Resize
End Sub


Private Sub MSFzy_DblClick()
        Call MSFDblClick(Fzdkh.MSFzy, Fzdkh.Tinsert)
        TS.Text = MSFzy.TextMatrix(MSFzy.Row, MSFzy.Col)
        Ts1.Text = MSFzy.Row
        Ts2.Text = MSFzy.Col
End Sub

Private Sub MSFzy_KeyPress(KeyAscii As Integer)
        Call MSFKeyPress(KeyAscii, Fzdkh.MSFzy, Fzdkh.Tinsert)
End Sub


Private Sub MSFzy_LeaveCell()
    Call MSFLeaveCell(Fzdkh.MSFzy)
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 (Tinsert.Visible = True) Then
            
            MSFzy.Row = Ts1.Text
            MSFzy.Col = Ts2.Text
            
            'MsgBox Tinsert.Text & "<>" & TS.Text & "<>" & Ts2.Text
            If Trim$(Tinsert.Text) <> TS.Text Then
                Call Tinsert_KeyPress(13)
                    
            End If
            Call MSFMouseDown(Fzdkh.Tinsert)
            Call MSFMouseDownSel(Fzdkh.Cbo)
        End If
        
    End If
End Sub

Private Sub MSFzy_RowColChange()
        Call MSFRowColChange(Fzdkh.MSFzy, Fzdkh.Tinsert)
End Sub

Private Sub Timer1_Timer()
    Call sqlsel
    Call Form_Resize
End Sub

Private Sub Tinsert_KeyPress(KeyAscii As Integer)
     '文本框起输入编辑框的作用，模拟网格单元，输入到文本框的内容，经过处理送到网格中，
    '当输入完后按回车键可以自动到下一列，若为最后一列，跳转到下一行的第一列等待输入。
    Dim sql As String
    Dim Tablef, vmsg As String
    Dim TSql As String
    
    On err GoTo vnextgo:

    If KeyAscii = 13 Then
            Select Case MSFzy.Col
            'Case 1
            '    Tablef = "id=" & Tinsert.Text
            '    vmsg = Tinsert.Text
            Case 2
                Tablef = "name='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 3
                Tablef = "dw='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 4
                Tablef = "zw='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 5
                Tablef = "tel='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 6
                Tablef = "br='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 7
                Tablef = "ld='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 8
                Tablef = "lx='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 19
                Tablef = "xz='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 10
                Tablef = "addr='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case 11
                Tablef = "addr='" & Tinsert.Text & "'"
                vmsg = Tinsert.Text
            Case Else
                'MsgBox "非法的操作方法，请查看帮助系统！"
                Exit Sub
            End Select
            
            If MsgBox("你确定将" & MSFzy.Text & "修改为：<< " & vmsg & " >> 么？", vbYesNo, "确认提示") = vbYes Then
                    sql = "update zpeo set " & Tablef & " where id=" & MSFzy.TextMatrix(MSFzy.Row, 0)
                    'MsgBox sql
                    Call ExcSqlCZ(sql)
            Else
                    GoTo vnextgo
            End If
            MSFzy.Text = Tinsert.Text
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 zpeo where id=" & MSFzy.TextMatrix(MSFzy.Row, 0)
                    Call ExcSqlCZ(sql)
                    Call sqlsel
        End If
End Sub

Private Sub isButton8_Click()
    Dim sql, vstring As String
    Dim rs As Recordset
    Dim vdb As Boolean
    Dim c As ListItem
    Dim i As Integer
    
    MSFzy.Clear
     Call showTital
     
    If Trim$(Tsel.Text) = "" Then
        Call sqlsel
        Exit Sub
    End If
     
    sql = "select * from zpeo where name='" & Trim$(Tsel.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 zpeo where tel='" & Trim$(Tsel.Text) & "'"
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
               GoTo showmsg
               Exit Sub
            End If
            
            sql = "select * from zpeo where dw='" & Trim$(Tsel.Text) & "'"
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
               GoTo showmsg
               Exit Sub
            Else
                MsgBox "您搜寻的信息不存在！"
                Call sqlsel
            End If
            
        End If
        Exit Sub
showmsg:
               i = 0
                Do While Not rs.EOF
                   i = i + 1
                    vstring = rs("id") & "◆◆" & i & "◆◆" & rs("name") & "◆◆" & rs("dw") & "◆◆" & rs("zw") & "◆◆" _
                    & rs("tel") & "◆◆" & rs("br") & "◆◆" & rs("ld") & "◆◆" & rs("lx") & "◆◆" & rs("xz") & "◆◆" _
                    & rs("addr") & "◆◆" & rs("mark") & "◆◆"
                    Call AddRowInFlex(Fzdkh.MSFzy, vstring)
                rs.MoveNext
                Loop
                rs.Close
                Set rs = Nothing
                Call Form_Resize
End Sub
上一页 12
⌨️ 快捷键说明

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