xingzhi.frm

软件用到的技巧：透明窗体

      Appearance      =   2
   End
End
Attribute VB_Name = "xingzhi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描    述：商务名片及客户资料管理系统 Ver 1.73
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit

Private Sub Command1_Click()
    If Len(Trim(Text2.Text)) > 700 Then
        MsgBox "备注信息文字内容过长，请保持在700字范围之内。", vbInformation, "文字内容过长"
        Text2.SetFocus
        Exit Sub
    End If

    If Trim(Text1.Text) = "" Then
        Text1.Text = ""
        Text1.SetFocus
        Exit Sub
    End If
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("urlxingzhi")
    rs.AddNew
        rs!网站性质 = Trim(Text1.Text)
        rs!备注信息 = Trim(Text2.Text)
    rs.Update
    MsgBox "添加成功！", vbInformation, "添加"
    Text1.Text = ""
    Text2.Text = ""
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    showallxingzhi
    Me.MSFlexGrid1.Refresh
End Sub

Private Sub Command2_Click()
    If Len(Trim(Text4.Text)) > 700 Then
        MsgBox "备注信息文字内容过长，请保持在700字范围之内。", vbInformation, "文字内容过长"
        Text4.SetFocus
        Exit Sub
    End If

        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select * from urlxingzhi where id =" & Trim(Me.Text5.Text))
        If rs.RecordCount > 0 Then rs.MoveLast
        If rs.RecordCount = 0 Then
            MsgBox "修改操作执行失败,原因：没有在数据库中找到目标数据。ID为" & Trim(Me.Text5.Text) & "的记录集返回为空。", vbInformation, "修改"
            Exit Sub
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        ElseIf rs.RecordCount > 1 Then
            MsgBox "修改操作执行失败,原因：在数据库中找到目标数据不唯一。ID为" & Trim(Me.Text5.Text) & "的记录集返回多个，无法确定要删除的数据，可能数据库已经紊乱。", vbInformation, "修改"
            Exit Sub
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        ElseIf rs.RecordCount = 1 Then
            rs.Edit
                rs!网站性质 = Trim(Text3.Text)
                rs!备注信息 = Trim(Text4.Text)
            rs.Update
            MsgBox "修改数据的操作已经执行完毕,成功修改数据。", vbInformation, " 修改完毕"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        End If
    showallxingzhi
    Me.MSFlexGrid1.Refresh
End Sub

Private Sub Command3_Click()
    If MsgBox("你将要删除名为：" & Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1) & " 的性质定义（ID为：" & Trim(Me.Text5.Text) & "）吗？这个删除操作是不可恢复的，并且如果数据库中其他用到这个性质的网址将被标记为无标志的网址。", vbYesNo + vbInformation + vbDefaultButton2, "删除操作") = vbYes Then
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select * from urlxingzhi where id =" & Trim(Me.Text5.Text))
        If rs.RecordCount > 0 Then rs.MoveLast
        If rs.RecordCount = 0 Then
            MsgBox "删除操作执行失败,原因：没有在数据库中找到目标数据。ID为" & Trim(Me.Text5.Text) & "的记录集返回为空。", vbInformation, " 删除"
            Exit Sub
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        ElseIf rs.RecordCount > 1 Then
            MsgBox "删除操作执行失败,原因：在数据库中找到目标数据不唯一。ID为" & Trim(Me.Text5.Text) & "的记录集返回多个，无法确定要删除的数据，可能数据库已经紊乱。", vbInformation, " 删除"
            Exit Sub
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        ElseIf rs.RecordCount = 1 Then
            rs.Delete
            MsgBox "删除数据的操作已经执行完毕,成功删除数据。", vbInformation, " 删除完毕"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        End If
    Else
    End If
    showallxingzhi
    Me.MSFlexGrid1.Refresh
End Sub

Private Sub Form_Load()
FrmUrlsEdit.Enabled = False
HookWheel Me.hwnd '用于支持鼠标滚轮
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    showallxingzhi
    Me.Height = 6315
    Me.Width = 6600
    Me.MSFlexGrid1.BackColorFixed = 16777178
    Me.MSFlexGrid1.BackColorBkg = MsFlexGridBackColorBkgValue
        Me.BackColor = FormBackColor: Me.Frame1.BackColor = Me.BackColor: Me.Frame2.BackColor = Me.BackColor: Me.Frame3.BackColor = Me.BackColor
End Sub

Private Sub Form_LostFocus()
    Me.SetFocus
End Sub

Private Sub Form_Resize()
On Error GoTo ee
    Me.Height = 6315
    Me.Width = 6600
ee:
End Sub
Private Sub Form_Unload(Cancel As Integer)
    AllBaiFangShow = False
    FrmUrlsEdit.Enabled = True
End Sub
Private Sub MSFlexGrid1_GotFocus()
Set CtlWheel = MSFlexGrid1 '用于设定支持鼠标滚轮
End Sub
Private Sub MSFlexGrid1_LostFocus()
Set CtlWheel = Nothing '用于设定取消鼠标滚轮的支持
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnHookWheel Me.hwnd '卸载鼠标滚轮的支持
End Sub


Private Sub showallxingzhi()
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from urlxingzhi order by id desc")
    If rs.RecordCount = 0 Then
        Exit Sub
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
    ElseIf rs.RecordCount = 1 Then
        rs.MoveLast
        rs.MoveFirst
    End If
    If rs.RecordCount > 0 Then
        Dim i As Long
        Me.MSFlexGrid1.Rows = rs.RecordCount + 1
        Me.MSFlexGrid1.TextMatrix(0, 0) = "ID"
        Me.MSFlexGrid1.ColWidth(0) = 400
        Me.MSFlexGrid1.ColWidth(1) = 1500
        Me.MSFlexGrid1.ColWidth(1) = 1500
        Me.MSFlexGrid1.TextMatrix(0, 1) = "性质名称"
        Me.MSFlexGrid1.TextMatrix(0, 2) = "备注信息"
        For i = 1 To rs.RecordCount
            If Not IsNull(rs!id) Then
                Me.MSFlexGrid1.TextMatrix(i, 0) = rs!id
            Else
                Me.MSFlexGrid1.TextMatrix(i, 0) = "-"
            End If
            
            If Not IsNull(rs!网站性质) Then
                Me.MSFlexGrid1.TextMatrix(i, 1) = rs!网站性质
            Else
                Me.MSFlexGrid1.TextMatrix(i, 1) = ""
            End If
            
            If Not IsNull(rs!备注信息) Then
                Me.MSFlexGrid1.TextMatrix(i, 2) = rs!备注信息
            Else
                Me.MSFlexGrid1.TextMatrix(i, 2) = ""
            End If
            rs.MoveNext
        Next i
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing

    End If

End Sub
Private Sub MSFlexGrid1_Click()
    If Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)) = "" Then
        Exit Sub
    Else
        If IsNull(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)) = True Then
            Text5.Text = ""
            Text6.Text = ""
            Command3.Enabled = False
            Command2.Enabled = False
            
        Else
            Text5.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0))
            Text6.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0))
            Command3.Enabled = True
            Command2.Enabled = True
        End If
        
        If IsNull(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1)) = True Then
            Text3.Text = ""
        Else
            Text3.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1))
        End If
        
        If IsNull(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 2)) = True Then
            Text4.Text = ""
        Else
            Text4.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 2))
        End If
    End If
End Sub

Private Sub MSFlexGrid1_DblClick()
    FrmUrlsEdit.Text9.Text = Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)
    FrmUrlsEdit.Text7.Text = Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1)
    Unload Me
End Sub