📄 commbas.bas

📁 本代码适合初学数据库者学习借鉴
💻 BAS
字号:
Attribute VB_Name = "CommBas"
Option Explicit

Public GlobalCon As New ADODB.Connection
Public RoleID As String  '当前用户的角色
Public RolePass As String '当前用户的角色的口令字
Public AdoConnectionStr As String 'ADO连接字符串
Public NowFormName As String    '当前的窗体代码
Public NowUserFuncQx As String  '用户使用的权限
Public FormPath As String  '当前使用的系统缺省路径
Sub EnableDbCommFunc(TempForm As Form)

With TempForm.Toolbar1
    .Buttons("Add").Enabled = True
    .Buttons("Change").Enabled = True
    .Buttons("Del").Enabled = True
    .Buttons("Save").Enabled = False
    
    .Buttons("Cancel").Enabled = False
End With

End Sub

Sub FormShowComm(TempForm As Form, TempFormId As String)
Dim varChunk As Variant, lngLogoSize As Long, i As Integer, lngOffset As Long
Dim TempType As String, TempStr As String, TempRec As New ADODB.Recordset
Dim SqlStr As String

Const conChunkSize = 16384

On Error GoTo LoadErr
Screen.MousePointer = 11

'加载资源
LoadCommRes TempForm

If GlobalCon Is Nothing Then
   MsgBox "没有打开的数据库连接，唉，程序错误，打个电话吧！", vbCritical
   For i = 1 To TempForm.Toolbar1.Buttons.Count
       If TempForm.Toolbar1.Buttons(i).Key <> "Exit" Then
          TempForm.Toolbar1.Buttons(i).Enabled = False
       End If
   Next
   TempForm.RecGrid.Enabled = False
   Screen.MousePointer = 0
   Exit Sub
End If


'读取配置字符串开始
TempType = ""
TempStr = ""
Set TempRec = New ADODB.Recordset
SqlStr = "select formtype,setstring from formset where  groupid='" & RoleID & "' and formid='" & TempFormId & "'  "
TempRec.Open SqlStr, GlobalCon, adOpenDynamic, adLockReadOnly, adCmdText
If Not TempRec.EOF Then
    lngLogoSize = TempRec!SetString.ActualSize
    Do While lngOffset < lngLogoSize
        varChunk = TempRec!SetString.GetChunk(conChunkSize)
        TempStr = TempStr & varChunk
        lngOffset = lngOffset + conChunkSize
    Loop
    If Not IsNull(TempRec!formtype) Then
       TempForm.Tag = Trim$(TempRec!formtype)
    End If
End If
TempRec.Close
Set TempRec = Nothing

'读取配置字符串结束

'窗体权限初始化
If InStr(1, TempForm.Tag, "查询") = 0 And InStr(1, UCase(TempForm.Tag), "ASK") = 0 Then
    TempForm.Toolbar1.Buttons("Out").Visible = False
    
    TempForm.Toolbar1.Buttons("Add").Visible = True
    TempForm.Toolbar1.Buttons("Change").Visible = True
    TempForm.Toolbar1.Buttons("Save").Visible = True
    TempForm.Toolbar1.Buttons("Del").Visible = True
    
    TempForm.Toolbar1.Buttons("Add").Enabled = True
    TempForm.Toolbar1.Buttons("Change").Enabled = True
    TempForm.Toolbar1.Buttons("Save").Enabled = True
    TempForm.Toolbar1.Buttons("Del").Enabled = True
    
    TempForm.Toolbar1.Buttons("First").Visible = True
    TempForm.Toolbar1.Buttons("Last").Visible = True
    TempForm.Toolbar1.Buttons("Prev").Visible = True
    TempForm.Toolbar1.Buttons("Next").Visible = True
    
    TempForm.Toolbar1.Buttons("First").Enabled = True
    TempForm.Toolbar1.Buttons("Last").Enabled = True
    TempForm.Toolbar1.Buttons("Prev").Enabled = True
    TempForm.Toolbar1.Buttons("Next").Enabled = True
    
Else
    TempForm.Toolbar1.Buttons("Out").Visible = True
    
    TempForm.Toolbar1.Buttons("Add").Visible = False
    TempForm.Toolbar1.Buttons("Change").Visible = False
    TempForm.Toolbar1.Buttons("Save").Visible = False
    TempForm.Toolbar1.Buttons("Del").Visible = False
    
    TempForm.Toolbar1.Buttons("First").Visible = True
    TempForm.Toolbar1.Buttons("Last").Visible = True
    TempForm.Toolbar1.Buttons("Prev").Visible = True
    TempForm.Toolbar1.Buttons("Next").Visible = True
    
    TempForm.Toolbar1.Buttons("First").Enabled = True
    TempForm.Toolbar1.Buttons("Last").Enabled = True
    TempForm.Toolbar1.Buttons("Prev").Enabled = True
    TempForm.Toolbar1.Buttons("Next").Enabled = True
    
End If

'窗体控件接口初始化

If TempForm.RecGrid.UserDefineString <> TempStr Then  '如果配置相同则不初始化
    With TempForm.RecGrid
        .UserDefineType = TempForm.Tag
        .UserDesignMode = "W"
        .UserDefineString = TempStr
        
        .NowUserAppPath = FormPath
        .Init GlobalCon, AdoConnectionStr & "UID=" & RoleID & ";PWD=" & RolePass, ""
    End With
    TempForm.RecGrid.Refresh
        
    LoadCommRes TempForm
End If

Screen.MousePointer = 0
    
Exit Sub
LoadErr:
    MsgBox Err.Description, vbExclamation

End Sub




Sub DisableDbCommFunc(TempForm As Form)

With TempForm.Toolbar1
    .Buttons("Add").Enabled = False
    .Buttons("Change").Enabled = False
    .Buttons("Del").Enabled = False
    .Buttons("Save").Enabled = False
    .Buttons("Cancel").Enabled = False
    
End With

End Sub


Sub ButtonClickComm(TempForm As Form, TempKey As String)
On Error GoTo ClickErr

Select Case TempKey

    Case "Exit"
        Unload TempForm
        
    Case "Add"
        TempForm.RecGrid.RunDbFunc "ADDNEW", ""
        TempForm.Toolbar1.Buttons("Change").Enabled = False
        TempForm.Toolbar1.Buttons("Save").Enabled = True
        TempForm.Toolbar1.Buttons("Del").Enabled = True
        TempForm.Toolbar1.Buttons("Cancel").Enabled = True
        
        TempForm.Toolbar1.Buttons("Prev").Enabled = False
        TempForm.Toolbar1.Buttons("Next").Enabled = False
        TempForm.Toolbar1.Buttons("First").Enabled = False
        TempForm.Toolbar1.Buttons("Last").Enabled = False
        
    Case "Change"
        TempForm.RecGrid.RunDbFunc "UPDATE", ""
        TempForm.Toolbar1.Buttons("Add").Enabled = False
        TempForm.Toolbar1.Buttons("Save").Enabled = True
        TempForm.Toolbar1.Buttons("Del").Enabled = True
        TempForm.Toolbar1.Buttons("Cancel").Enabled = True
        
        TempForm.Toolbar1.Buttons("Prev").Enabled = False
        TempForm.Toolbar1.Buttons("Next").Enabled = False
        TempForm.Toolbar1.Buttons("First").Enabled = False
        TempForm.Toolbar1.Buttons("Last").Enabled = False
        
    Case "Del"
        TempForm.RecGrid.RunDbFunc "DELETE", ""
        
    Case "Save"
        If TempForm.RecGrid.RunDbFunc("SAVE", "") = True Then
            TempForm.Toolbar1.Buttons("Add").Enabled = True
            TempForm.Toolbar1.Buttons("Save").Enabled = False
            TempForm.Toolbar1.Buttons("Del").Enabled = True
            TempForm.Toolbar1.Buttons("Change").Enabled = True
            TempForm.Toolbar1.Buttons("Cancel").Enabled = False
            
            TempForm.Toolbar1.Buttons("Prev").Enabled = True
            TempForm.Toolbar1.Buttons("Next").Enabled = True
            TempForm.Toolbar1.Buttons("First").Enabled = True
            TempForm.Toolbar1.Buttons("Last").Enabled = True
                
        End If
        
    Case "Cancel"
        TempForm.RecGrid.RungridFunc "CANCEL", ""
        TempForm.Toolbar1.Buttons("Add").Enabled = True
        TempForm.Toolbar1.Buttons("Save").Enabled = False
        TempForm.Toolbar1.Buttons("Del").Enabled = True
        TempForm.Toolbar1.Buttons("Change").Enabled = True
        TempForm.Toolbar1.Buttons("Cancel").Enabled = False
                    
        TempForm.Toolbar1.Buttons("Prev").Enabled = True
        TempForm.Toolbar1.Buttons("Next").Enabled = True
        TempForm.Toolbar1.Buttons("First").Enabled = True
        TempForm.Toolbar1.Buttons("Last").Enabled = True
            
    Case "First"
        If InStr(1, TempForm.Tag, "查询") = 0 And InStr(1, UCase(TempForm.Tag), "ASK") = 0 Then
            TempForm.RecGrid.RunDbFunc "FIRST", ""
        Else
            TempForm.RecGrid.RungridFunc "FIRST", ""
        End If
    Case "Last"
        If InStr(1, TempForm.Tag, "查询") = 0 And InStr(1, UCase(TempForm.Tag), "ASK") = 0 Then
            TempForm.RecGrid.RunDbFunc "LAST", ""
        Else
            TempForm.RecGrid.RungridFunc "LAST", ""
        End If
        
    Case "Prev"
        If InStr(1, TempForm.Tag, "查询") = 0 And InStr(1, UCase(TempForm.Tag), "ASK") = 0 Then
            TempForm.RecGrid.RunDbFunc "PREV", ""
        Else
            TempForm.RecGrid.RungridFunc "PREV", ""
        End If
        
    Case "Next"
        If InStr(1, TempForm.Tag, "查询") = 0 And InStr(1, UCase(TempForm.Tag), "ASK") = 0 Then
            TempForm.RecGrid.RunDbFunc "NEXT", ""
        Else
            TempForm.RecGrid.RungridFunc "NEXT", ""
        End If
        
    Case "Out"
        TempForm.RecGrid.RungridFunc "OUT", ""
        
    Case "Print"
        TempForm.RecGrid.RungridFunc "PRINT", ""
        
End Select

Exit Sub
ClickErr:
    Screen.MousePointer = 0
    MsgBox Err.Description, vbExclamation

End Sub


Sub LoadCommRes(TempForm As Form)

With TempForm.Toolbar1.Buttons
    
    TempForm.CoolBar1.Bands(1).MinHeight = TempForm.Toolbar1.Height
    TempForm.CoolBar1.Bands(1).Width = TempForm.CoolBar1.Bands(1).Width + 1000

    .Item("First").ToolTipText = "首记录"
    .Item("Last").ToolTipText = "尾记录"
    .Item("Prev").ToolTipText = "前  移"
    .Item("Next").ToolTipText = "后  移"
    .Item("Print").ToolTipText = "打  印"
    .Item("Exit").ToolTipText = "退   出"
    .Item("Out").ToolTipText = "输  出"
    
    .Item("Add").ToolTipText = "增  加"
    .Item("Change").ToolTipText = "修  改"
    .Item("Save").ToolTipText = "保  存"
    .Item("Del").ToolTipText = "删  除"
    .Item("Cancel").ToolTipText = "取  消"
        
    '=========
    
    .Item("First").Caption = "首记录"
    .Item("Last").Caption = "尾记录"
    .Item("Prev").Caption = "前  移"
    .Item("Next").Caption = "后  移"
    .Item("Print").Caption = "打  印"
    .Item("Exit").Caption = "退   出"
    .Item("Out").Caption = "输  出"
    
    .Item("Add").Caption = "增  加"
    .Item("Change").Caption = "修  改"
    .Item("Save").Caption = "保  存"
    .Item("Del").Caption = "删  除"
    .Item("Cancel").Caption = "取  消"
        
End With

End Sub
💿 文件大小 47281 K
👤 上传用户 ahkid
📂 所属分类数据库系统
🏷️ 相关标签

#代码 #数据库
⌨️ 快捷键说明

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