fgzrz.frm

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

            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            =   3360
         TabIndex        =   1
         Top             =   240
         Width           =   900
      End
   End
   Begin VB.Menu pop 
      Caption         =   "popmenu"
      Visible         =   0   'False
      Begin VB.Menu madd 
         Caption         =   "增加客户资料"
      End
      Begin VB.Menu mdel 
         Caption         =   "删除客户资料"
      End
   End
End
Attribute VB_Name = "Fgzrz"
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.Width = Me.ScaleWidth
    
    Ptop.Top = Frame1.Height
    Ptop.Width = Me.ScaleWidth
    
    Frame2.Width = Me.ScaleWidth
    Frame2.Top = Frame1.Height + Ptop.Height
    Twork.Width = Frame2.Width - Frame3.Width - 200
    
    Frame5.Width = Me.ScaleWidth
    Frame5.Top = Me.ScaleHeight - Frame5.Height
    Tmark.Width = Frame5.Width - 200
    
    Frame4.Width = Me.ScaleWidth
    Frame4.Top = Frame2.Top + Frame2.Height
    Frame4.Height = Me.ScaleHeight - Frame1.Height - Ptop.Height - Frame2.Height - Frame5.Height
    Frame6.Width = Frame4.Width - 200
    ListView1.Width = Frame4.Width - 200
    ListView1.Height = Frame4.Height - 300
    Frame6.Top = ListView1.Height - Frame6.Height
    
    Label1.Left = (Ptop.Width - Label1.Width) / 2
End Sub

Private Sub Form_Load()
    Call Fresize
    Odate.Text = Date
End Sub

Private Sub isButton10_Click()
    Call sqlsel(Odate.Text)
End Sub

Private Sub isButton1_Click()
    Dim vdat1 As String
    
    vdat1 = DateAdd("d", -1, Odate.Text)
    Odate.Text = vdat1
End Sub

Private Sub isButton12_Click()
    Unload Me
    
End Sub


Private Sub isButton2_Click()
    Dim vdat1 As String
    vdat1 = DateAdd("d", 1, Odate.Text)
    Odate.Text = vdat1
End Sub

Private Sub isButton3_Click()
    Dim sql As String
    Dim vdb As Boolean
    Dim vnum As Integer
    
    sql = " select count(id) from workmark where wdate= # " & Date & "#"
    vdb = ExcSql
    If vdb = True Then
        vnum = conn.Execute(sql)(0)
    End If
    If vnum = 0 Then
        Twork.Text = ""
        Tmark.Text = ""
        ListView1.ListItems.Clear
        Odate.Text = Date
        Tid.Text = "add"
    Else
        MsgBox "今日的工作日志已经存在！请修改。"
    End If
End Sub

Private Sub isButton4_Click()
    Dim sql As String
    Dim vdb As Boolean
    
    sql = "delete from workmark where id=" & Tsid.Text
    Call exsql(sql)
    sql = "delete from workr where id=" & Tsid.Text
    Call exsql(sql)
    Call sqlsel(Odate.Text)
End Sub

Private Sub isButton5_Click()
    Dim sql As String, vda As String
    Dim vdb As Boolean, vnum As Integer
    'If Tid.Text = "add" Then
        vda = Odate.Text
        If Twork.Text = "" Then
            MsgBox "信息不完整"
            Exit Sub
        End If
        
        vdb = ExcSql
        If vdb = True Then
            sql = "select count(id) from workmark where wdate= #" & vda & "#"
            vnum = conn.Execute(sql)(0)
            If vnum = 0 Then
                sql = "insert into workmark(worka,mark,wdate) values('" & Twork.Text & "','" & Tmark.Text & "','" & vda & "')"
                conn.Execute (sql)
            Else
                sql = "update workmark set worka='" & Twork.Text & "',mark='" & Tmark.Text & "' where wdate=#" & Odate.Text & "#"
                conn.Execute (sql)
            End If
        End If
   ' Else
   '     If Twork.Text = "" Then
   '         MsgBox "信息不完整"
   '         Exit Sub
   '     End If
   '
   '     vdb = ExcSql
   '     If vdb = True Then
   '         sql = "select count(id) from workmark where wdate= #" & Odate.Text & "#"
   '         vnum = conn.Execute(sql)(0)
   '         If vnum > 0 Then
   '             sql = "update workmark set worka='" & Twork.Text & "',mark='" & Tmark.Text & "' where wdate=#" & Odate.Text & "#"
   '             conn.Execute (sql)
   '         Else
   '             MsgBox "记录已经存在！"
   '             Exit Sub
   '         End If
   '     End If
   ' End If
    Call sqlsel(Odate.Text)
End Sub

Private Sub isButton6_Click()
    Frame6.Visible = False
    Frame6.Enabled = False
    ListView1.Height = Frame4.Height - 150
End Sub

Private Sub isButton7_Click()
    Dim sql As String
    Dim vdb As Boolean
    
    If Trim$(Text1(0).Text) = "" Then
        MsgBox "信息不完整！"
        Exit Sub
    End If
    
    If Tsid.Text = "" Then
        MsgBox "请先添加工作安排信息。"
    Else
        sql = "insert into workr(id,name,tel,workaddr) values('" & Tsid.Text & "','" & Trim$(Text1(0).Text) & "','" & Trim$(Text1(1).Text) & "','" & Trim$(Text1(2).Text) & "')"
        Call exsql(sql)
        Call sqlsel(Odate.Text)
        Call isButton6_Click
    End If
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button = vbRightButton Then
        If Twork = "" Then
            madd.Enabled = False
            mdel.Enabled = False
        Else
            madd.Enabled = True
        End If
        PopupMenu pop
    End If
End Sub

Private Sub madd_Click()
    Frame6.Visible = True
    Frame6.Enabled = True
    ListView1.Height = Frame4.Height - Frame6.Height
    Text1(0).Text = ""
    Text1(1).Text = ""
    Text1(2).Text = ""
End Sub

Private Sub mdel_Click()
    Dim sql As String

    sql = "delete from workr where name='" & Trim$(ListView1.SelectedItem.Text) & "' and tel ='" & Trim$(ListView1.SelectedItem.ListSubItems(1).Text) & "' and workaddr ='" & Trim$(ListView1.SelectedItem.ListSubItems(2).Text) & "'"
    
    Call exsql(sql)
    Call sqlsel(Odate.Text)
    
End Sub

Private Sub Odate_Change()
    Dim vda, vy, vm, vd, vweek As String
    
    vda = Odate.Text
    vy = Year(vda)
    vm = Month(vda)
    vd = Day(vda)
    vweek = vweekshow(CStr(vda))
    
    Label1.Caption = vy & "年" & vm & "月" & vd & "日 星期" & vweek
    
    Call sqlsel(Odate.Text)
End Sub

Private Function vweekshow(ByVal vwe As String)
    Dim vwee As String
    
    vwee = Weekday(vwe, vbUseSystemDayOfWeek)
    Select Case vwee
    Case "1"
        vweekshow = "日"
    Case "2"
        vweekshow = "一"
    Case "3"
        vweekshow = "二"
    Case "4"
        vweekshow = "三"
    Case "5"
        vweekshow = "四"
    Case "6"
        vweekshow = "五"
    Case "7"
        vweekshow = "六"
    End Select
End Function

Private Sub sqlsel(ByVal vda As String)
    Dim sql As String, vdb As Boolean
    Dim rs As Recordset, c As ListItem
    
    ListView1.ListItems.Clear
    sql = "select * from workmark where wdate=#" & vda & "#"
    vdb = ExcSql
    If vdb = True Then
        Set rs = conn.Execute(sql)
        If Not rs.EOF Then
            Tmark.Text = rs("mark")
            Twork.Text = rs("worka")
            Tid.Text = "change"
            Tsid.Text = rs("id")
            
        Else
            Tmark.Text = ""
            Twork.Text = ""
            Tid.Text = ""
            Tsid.Text = ""
            
        End If
        rs.Close
        Set rs = Nothing
        
        If Trim(Tsid.Text) <> "" Then
            sql = "select * from workr where id=" & Tsid.Text
            Set rs = conn.Execute(sql)
            If Not rs.EOF Then
                mdel.Enabled = True
                Do While Not rs.EOF
                     Set c = ListView1.ListItems.Add(, , rs("name") & "")
                     c.SubItems(1) = rs("name") & ""
                     c.SubItems(2) = rs("tel") & ""
                     c.SubItems(3) = rs("workaddr") & ""
                rs.MoveNext
                Loop
            Else
                mdel.Enabled = False
            End If
            rs.Close
            Set rs = Nothing
        End If
    End If
End Sub