module3.bas

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

Attribute VB_Name = "Module3"
Option Explicit
Public MDIFormBackColor As Long
Public FormBackColor As Long
Public FormTopColor As Long
Public LabelColor As Long
Const MsFlexGridFixColor = 16777178

Public MsFlexGridBackColorBkgValue As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'下面用于实现半透明窗体
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'上面用于实现半透明窗体
       
Public Const MAX_PATH = 260
Public Sub SetCorlor()
    'MDIForm1.BackColor = MDIFormBackColor
    
End Sub
Public Sub ChaZhaoNum(TelNum As String)
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from com where 企业电话 like '*" & TelNum & "*' order by id desc")
    MsgBox rs.RecordCount
End Sub
Public Sub SetGN(i As String)
    If Len(Trim(i)) <> 7 Then
        MsgBox "设置的参数有问题，传递过来的设置参数长度不对。", vbInformation, "错误"
        Exit Sub
    End If
    If Mid(i, 1, 1) = "否" Then '不使用商家和联系人功能模块。
        MDIForm1.Mshang.Visible = False
        MDIForm1.MLianxiren.Visible = False
    Else
        MDIForm1.Mshang.Visible = True
        MDIForm1.MLianxiren.Visible = True
    End If
    If Mid(i, 2, 1) = "否" Then '不使用拜访记录模块。
        MDIForm1.Mjilu.Visible = False
    Else
        MDIForm1.Mjilu.Visible = True
    End If
    If Mid(i, 3, 1) = "否" Then '不使用网址收藏功能。
        MDIForm1.murls.Visible = False
    Else
        MDIForm1.murls.Visible = True
    End If
    If Mid(i, 4, 1) = "否" Then '不使用网址收藏功能。
        MDIForm1.mcanshubengongsi.Visible = False
    Else
        MDIForm1.mcanshubengongsi.Visible = True
    End If
    If Mid(i, 5, 1) = "否" Then '不使用更换数据库功能。
        MDIForm1.MDYBDHMD.Visible = False
    Else
        MDIForm1.MDYBDHMD.Visible = True
    End If
    If Mid(i, 6, 1) = "否" Then '不使用号码查询中心功能。
        MDIForm1.mchaxundianhuahaoma.Visible = False
    Else
        MDIForm1.mchaxundianhuahaoma.Visible = True
    End If
    If Mid(i, 7, 1) = "否" Then '不使用主窗体的状态栏。
        MDIForm1.StatusBar1.Visible = False
    Else
        MDIForm1.StatusBar1.Visible = True
    End If
End Sub
Public Function CheckHangye() As Boolean
On Error GoTo ddd
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("hangye")
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function
ddd:
    If Err.Number = 3078 Then
        CheckHangye = True
    End If
End Function
Public Function Checkxingzhi() As Boolean
On Error GoTo ddd
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("xingzhi")
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function
ddd:
    If Err.Number = 3078 Then
        Checkxingzhi = True
    End If
End Function





Public Sub CreatHangYe()
    Dim db As Database
    Dim rs As TableDef
    Set db = OpenDatabase(MdbPath)
    Set rs = db.CreateTableDef("HangYe")
    Dim fd As Field
    Set fd = rs.CreateField("ID", dbLong)
    fd.Attributes = dbAutoIncrField '设置ID字段为自动增加字段.
    rs.Fields.Append fd
    db.TableDefs.Append rs
    
    Set fd = rs.CreateField("行业名称", dbText, 250) '设置名称字段
    fd.AllowZeroLength = True '设置可以为空字段。
    rs.Fields.Append fd
    
    Set fd = rs.CreateField("备注信息", dbMemo) '设置备注字段
    fd.AllowZeroLength = True
    rs.Fields.Append fd
End Sub


Public Sub CreatXingzhi()
    Dim db As Database
    Dim rs As TableDef
    Set db = OpenDatabase(MdbPath)
    Set rs = db.CreateTableDef("XingZhi")
    Dim fd As Field
    Set fd = rs.CreateField("ID", dbLong)
    fd.Attributes = dbAutoIncrField '设置ID字段为自动增加字段.
    rs.Fields.Append fd
    db.TableDefs.Append rs
    
    Set fd = rs.CreateField("性质名称", dbText, 250) '设置名称字段
    fd.AllowZeroLength = True '设置可以为空字段。
    rs.Fields.Append fd
    
    Set fd = rs.CreateField("备注信息", dbMemo) '设置备注字段
    fd.AllowZeroLength = True
    rs.Fields.Append fd
End Sub

Public Sub DelRowSel(MS As MSFlexGrid)
    If MS.RowSel = 1 Then
        MsgBox "没有选择需要删除的信息，请重新选择。", vbCritical
        Exit Sub
    ElseIf MS.RowSel > 1 Then
        MsgBox "正好"
    End If
End Sub


Public Sub CreatProSet()
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("proset")
    If rs.RecordCount = 0 Then
        rs.AddNew
            rs!pswd = ""
            rs!comname = ""
            rs!yb = ""
            rs!gongneng = "是是是是是是是"
            rs!ListNum = "100"
            rs!texta = "是"
            rs!textb = "是"
        rs.Update
    End If
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
End Sub