allbaifang.frm

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

'****************************************************************************
Option Explicit

Private Sub Check1_Click()
    If Check1.Value = 0 Then
        Me.DTPicker1.Enabled = False
        Me.DTPicker2.Enabled = False
    Else
        Me.DTPicker1.Enabled = True
        Me.DTPicker2.Enabled = True
    End If
End Sub
Private Sub Command1_Click()
        ShowAllBaiFang ("select * from baifang order by id desc")
End Sub
Private Sub Command2_Click()
    If Check1.Value = 0 Then '不限制日期范围：日期不参与运算
        If Trim(Text1.Text) = "" Then
            Text1.SetFocus
            Exit Sub
        End If
        If Combo1.Text = "" Then
            Combo1.SetFocus
            Exit Sub
        End If
    End If
    
    If Len(Me.Label3.Caption) > 20 Then
        AllBaifangOldSqltext = Trim(Me.Label3.Caption)
    Else
        AllBaifangOldSqltext = ""
    End If

    If Check1.Value = 1 Then '限制日期范围：日期参与运算
        If (Combo1.Text <> "") And (Trim(Text1.Text) <> "") Then
            ShowAllBaiFang ("select * from baifang where " & Combo1.Text & " " & "like '*" & Trim(Text1.Text) & "*' and 拜访时间 between #" & DateValue(Me.DTPicker1) & "# and  #" & DateValue(Me.DTPicker2) & "# " & "  order by 企业ID号")
        ElseIf Combo1.Text = "" Or Trim(Text1.Text) = "" Then
            ShowAllBaiFang ("select * from baifang where " & "拜访时间 between #" & DateValue(Me.DTPicker1) & "# and  #" & DateValue(Me.DTPicker2) & "# " & " order by 企业ID号")
        End If
    ElseIf Check1.Value = 0 Then '不限制日期范围：日期不参与运算
        ShowAllBaiFang ("select * from baifang where " & Combo1.Text & " " & "like '*" & Trim(Text1.Text) & "*' order by 企业ID号")
    End If
    
End Sub

Private Sub Command3_Click()
    If (Me.MSFlexGrid1.Rows - 1) = 0 Then
        Exit Sub
    End If
    If Trim(Me.MSFlexGrid1.TextMatrix(0, 0)) = "" Then
        Exit Sub
    End If
    Load FrmToExcel
    FrmToExcel.Show
    FrmToExcel.Label8.Caption = "3"
    FrmToExcel.Label7.Caption = Me.Label3.Caption
    FrmToExcel.Label6.Caption = Me.MSFlexGrid1.Rows - 1
    FrmToExcel.Label5.Caption = "当前的拜访记录窗体..."
End Sub

Private Sub Command4_Click()
    If Me.MSFlexGrid1.RowSel = 0 Then
        MsgBox "没有选中行，所以不能进行隐藏行的操作。", vbInformation
        Exit Sub
    End If
    If Me.MSFlexGrid1.RowSel > 0 And Me.MSFlexGrid1.RowSel > 1 Then
        If MsgBox("你将要隐藏【" & Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1) & "】的资料吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
            Me.MSFlexGrid1.RemoveItem (Me.MSFlexGrid1.RowSel)
        Else
            Exit Sub
        End If
    Else
        'MsgBox "最后一条信息，不能再删除了，否则就没有什么信息可以供导出的了。", vbInformation
        MsgBox "非常抱歉，由于作者技术能力有限，目前此版本暂时无法删除第一行数据，这个问题后续版本有望解决，请及时关注下一版本。", vbInformation
    End If
End Sub

Private Sub Form_Load()
    HookWheel Me.hwnd '用于支持鼠标滚轮
    Me.Icon = MDIForm1.Icon
    Me.BackColor = FormBackColor
    Me.Frame1.BackColor = Me.BackColor
    Me.Check1.BackColor = Me.BackColor
    Me.MSFlexGrid1.BackColorFixed = 16777178
    Me.MSFlexGrid1.BackColorBkg = MsFlexGridBackColorBkgValue
    AllBaiFangShow = True

    Me.MSFlexGrid1.RowHeight(0) = 300
    Me.Top = (Screen.Height - Me.Height) / 10
    Me.Left = (Screen.Width - Me.Width) / 1.5
    Me.DTPicker2.Value = Date
    Dim d As String
    d = Year(Now) & "-" & Month(Now) & "-1"
    Me.DTPicker1.Value = d
    Me.Height = 8820
    Me.Width = 11600
    'Me.MSFlexGrid1.ColWidth(6) = Me.MSFlexGrid1.Width - Me.MSFlexGrid1.ColWidth(0) - Me.MSFlexGrid1.ColWidth(1) - Me.MSFlexGrid1.ColWidth(2) - Me.MSFlexGrid1.ColWidth(3) - Me.MSFlexGrid1.ColWidth(4) - Me.MSFlexGrid1.ColWidth(5)
    Me.MSFlexGrid1.ColWidth(6) = Me.MSFlexGrid1.Width - 8350
End Sub



Private Sub Form_Resize()
On Error GoTo resized
        Me.MSFlexGrid1.Height = Me.Height - 1600
        Command4.Top = Me.MSFlexGrid1.Top + Me.MSFlexGrid1.Height + 100
        Me.Command3.Top = Me.Command4.Top
        Me.Frame1.Top = Me.Command4.Top - 85
        Me.Label7.Top = Me.Command4.Top + 20
        Me.Label6.Top = Me.Label7.Top + 20
    
        Me.MSFlexGrid1.Width = Me.Width - 300
        Me.Label6.Left = Me.Width - 800
        Me.Label7.Left = Me.Width - 800 - Me.Label6.Width
        If Me.MSFlexGrid1.Width - Me.MSFlexGrid1.ColWidth(0) - Me.MSFlexGrid1.ColWidth(1) - Me.MSFlexGrid1.ColWidth(2) - Me.MSFlexGrid1.ColWidth(3) - Me.MSFlexGrid1.ColWidth(4) - Me.MSFlexGrid1.ColWidth(5) - 380 > 10 Then
            Me.MSFlexGrid1.ColWidth(6) = Me.MSFlexGrid1.Width - Me.MSFlexGrid1.ColWidth(0) - Me.MSFlexGrid1.ColWidth(1) - Me.MSFlexGrid1.ColWidth(2) - Me.MSFlexGrid1.ColWidth(3) - Me.MSFlexGrid1.ColWidth(4) - Me.MSFlexGrid1.ColWidth(5) - 380
        Else
            Me.MSFlexGrid1.ColWidth(6) = 5000
        End If
    If Me.Height <= 8820 Then
        Me.Height = 8820
    End If
    If Me.Width <= 11600 Then
        Me.Width = 11600
    End If
    Exit Sub
resized:
    If (Err.Number = 384) Or (Err.Number = 380) Then Exit Sub
    MsgBox Err.Number & "：" & Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
    AllBaiFangShow = False
End Sub

Private Sub Label3_DblClick()
    Load Form11
    Form11.Show
    Form11.Text1.Text = Label3.Caption
    Form11.Combo1.ListIndex = 2
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 MSFlexGrid1_DblClick()
On Error GoTo clickerror
    If Trim(AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0)) = "" Then
        Exit Sub
    End If
    'If AllBaiFangShow = False Then
    '    Load AllBaiFang
    '    AllBaiFang.Show
    '    ShowAllBaiFang ("select * from baifang order by 企业ID号")
    '    Exit Sub
    'Else
    '    AllBaiFang.SetFocus
    'End If
    If AllBaiFang.MSFlexGrid1.Rows = 1 Or Trim(AllBaiFang.MSFlexGrid1.TextMatrix(0, 0)) = "" Then
        'MsgBox Trim(AllBaiFang.MSFlexGrid1.TextMatrix(0, 0))
        'MsgBox "没有可以供修改的拜访记录！", vbInformation, "拜访记录为空"
        Exit Sub
    End If
    Load FrmBaiFangEdit
    FrmBaiFangEdit.Show
    FrmBaiFangEdit.Label2.Caption = AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1)
    FrmBaiFangEdit.Text3.Text = AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0)
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from com where id=" & AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1))
    If rs.RecordCount > 0 Then
        FrmBaiFangEdit.Text1.Text = rs!企业名称
    ElseIf rs.RecordCount = 0 Then
        MsgBox "取商家的名称错误，无法显示拜访记录。", vbInformation, "定位商家的名称错误"
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Exit Sub
    End If
    Set rs = db.OpenRecordset("select * from baifang where id=" & Val(AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0)))
    If rs.RecordCount = 0 Then
        MsgBox "数据库取数出现混乱,程序无法正确定位要修改的资料,可以尝试重新启动程序,或和程序提供者联系寻找解决途径."
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
        If rs!企业ID号 <> AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1) Then
            MsgBox "数据库取数出现混乱,程序无法正确定位要修改的资料,可以尝试重新启动程序,或和程序提供者联系寻找解决途径。"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        Else
            FrmBaiFangEdit.Text2.Text = rs!内容
            Dim db3 As Database
            Dim rs3 As Recordset
            Set db3 = OpenDatabase(MdbPath)
            Set rs3 = db3.OpenRecordset("select * from ren where 所属企业=" & AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1))
            If rs3.RecordCount = 1 Then
                rs3.MoveLast
                rs3.MoveFirst
                Dim i2 As Integer
                For i2 = 1 To rs3.RecordCount
                    'FrmBaiFangEdit.Combo1.AddItem rs3!姓名
                    FrmBaiFangEdit.Combo1.AddItem rs3!姓名 & " (" & rs3!部门 & rs3!职务 & ")"
                    rs3.MoveNext
                Next i2
                rs3.Close
                db3.Close
                Set rs3 = Nothing
                Set db3 = Nothing
            End If
            FrmBaiFangEdit.Combo1.Text = rs!受访人
            FrmBaiFangEdit.Combo2.Clear
            FrmBaiFangEdit.Combo2.Text = rs!拜访人
            Dim Db2 As Database
            Dim rs2 As Recordset
            Set Db2 = OpenDatabase(MdbPath)
            Set rs2 = Db2.OpenRecordset("select * from mycom")
            If rs2.RecordCount = 0 Then
                FrmBaiFangEdit.Combo2.Text = ""
            ElseIf rs2.RecordCount = 1 Then
                rs2.MoveLast
                rs2.MoveFirst
                Dim i As Integer
                For i = 1 To rs2.RecordCount
                    FrmBaiFangEdit.Combo2.AddItem rs2!姓名
                    rs2.MoveNext
                Next i
            End If
            rs2.Close
            Db2.Close
            Set rs2 = Nothing
            Set Db2 = Nothing
            FrmBaiFangEdit.DTPicker1.Value = rs!拜访时间
            FrmBaiFangEdit.SetFocus
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        End If
    End If
    Exit Sub
clickerror:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbInformation, "执行错误"
End If
End Sub

Private Sub Text1_GotFocus()
    SendKeys "{end}"
End Sub