frmauthone.frm

一个用VB写的财务软件源码

VERSION 5.00
Begin VB.Form frmAuthOne 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "一个权限"
   ClientHeight    =   2130
   ClientLeft      =   4950
   ClientTop       =   6105
   ClientWidth     =   6525
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2130
   ScaleWidth      =   6525
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox chkEnd 
      Caption         =   "明细权限(&E)"
      Height          =   180
      Left            =   5040
      TabIndex        =   8
      Top             =   120
      Value           =   1  'Checked
      Width           =   1380
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   375
      Left            =   5085
      TabIndex        =   10
      Top             =   1680
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   375
      Left            =   3480
      TabIndex        =   9
      Top             =   1680
      Width           =   1335
   End
   Begin VB.TextBox txtMenuName 
      Height          =   285
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   7
      Top             =   1148
      Width           =   3375
   End
   Begin VB.TextBox txtName 
      Height          =   285
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   5
      Top             =   788
      Width           =   4215
   End
   Begin VB.TextBox txtCode 
      Height          =   285
      Left            =   1440
      MaxLength       =   2
      TabIndex        =   3
      Top             =   428
      Width           =   1935
   End
   Begin VB.TextBox txtCodePre 
      Enabled         =   0   'False
      Height          =   285
      Left            =   1440
      TabIndex        =   1
      Top             =   68
      Width           =   1935
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "菜单名(&M)："
      Height          =   180
      Left            =   240
      TabIndex        =   6
      Top             =   1200
      Width           =   990
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "名称(&N)："
      Height          =   180
      Left            =   240
      TabIndex        =   4
      Top             =   840
      Width           =   810
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "本层代码(&D)："
      Height          =   180
      Left            =   240
      TabIndex        =   2
      Top             =   480
      Width           =   1170
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "上层代码(&P)："
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1170
   End
End
Attribute VB_Name = "frmAuthOne"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_bFunc As Boolean
Private m_sCodePre As String
Private m_sCode As String
Private m_sName As String
Private m_sMenuName As String
Private m_iCodeLen As Integer
Private m_bEnd As Boolean

Public OK As Boolean

Public Property Let ubFunc(ByVal NewFunc As Boolean)
    m_bFunc = NewFunc
End Property
Public Property Get ubFunc() As Boolean
    ubFunc = m_bFunc
End Property

Public Property Let usCodePre(ByVal newC As String)
    m_sCodePre = newC
End Property
Public Property Get usCodePre() As String
    usCodePre = m_sCodePre
End Property

Public Property Let usCode(ByVal newC As String)
    m_sCode = newC
End Property
Public Property Get usCode() As String
    usCode = m_sCode
End Property

Public Property Let usName(ByVal NewName As String)
    m_sName = NewName
End Property
Public Property Get usName() As String
    usName = m_sName
End Property

Public Property Let usMenuName(ByVal NewN As String)
    m_sMenuName = NewN
End Property
Public Property Get usMenuName() As String
    usMenuName = m_sMenuName
End Property
    
Public Property Let uiCodeLen(ByVal NewLen As Integer)
    m_iCodeLen = NewLen
End Property
Public Property Get uiCodeLen() As Integer
    uiCodeLen = m_iCodeLen
End Property

Public Property Let ubEnd(ByVal NewB As Boolean)
    m_bEnd = NewB
End Property
Public Property Get ubEnd() As Boolean
    ubEnd = m_bEnd
End Property





Private Sub chkEnd_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Then
        SendKeys "{tab}"
    ElseIf KeyCode = vbKeyUp Then
        SendKeys "+{tab}"
    End If
End Sub

Private Sub cmdCancel_Click()
    OK = False
    Me.Hide
End Sub

Private Sub cmdOk_Click()
    m_sCodePre = Trim(txtCodePre.text)
    m_sCode = Trim(txtCode.text)
    m_sName = Trim(txtName.text)
    m_sMenuName = Trim(txtMenuName.text)
    If m_sCodePre = "" Then
        MsgBox "上层代码不能为空!"
        Exit Sub
    End If
    If m_sCode = "" Then
        MsgBox "本层代码不能为空!"
        Exit Sub
    End If
    If m_sName = "" Then
        MsgBox "名称不能为空!"
        Exit Sub
    End If
    If m_sMenuName = "" Then
        MsgBox "菜单名不能为空!"
        Exit Sub
    End If
    If InStr(1, m_sCodePre, "'") > 0 Then
         MsgBox "上层代码含有非法字符!"
         Exit Sub
    End If
    If InStr(1, m_sCode, "'") > 0 Then
        MsgBox "本层代码含有非法字符!"
        Exit Sub
    End If
    If InStr(1, m_sName, "'") > 0 Then
        MsgBox "名称含有非法字符!"
        Exit Sub
    End If
    If InStr(1, m_sMenuName, "'") > 0 Then
        MsgBox "菜单名含有非法字符!"
        Exit Sub
    End If
    m_bEnd = chkEnd.Value
    OK = True
    Me.Hide
End Sub

Private Sub Form_Initialize()
    OK = False
    m_bEnd = True
End Sub

Private Sub Form_Load()
    
    txtCodePre.text = Me.usCodePre
    txtCode.text = Me.usCode
    txtName.text = Me.usName
    txtMenuName.text = Me.usMenuName
    chkEnd.Value = IIf(Me.ubEnd, 1, 0)
    If Me.ubFunc Then
        txtCode.Enabled = True
    Else
        txtCode.Enabled = False
    End If
    
End Sub

Private Sub txtCode_GotFocus()
    txtCode.IMEMode = 2
End Sub

Private Sub txtCode_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Then SendKeys "{tab}"
End Sub

Private Sub txtCode_KeyPress(KeyAscii As Integer)
    Dim iTemp As Integer
    
    iTemp = NumberORLetterEnabled(KeyAscii)
    If iTemp >= 97 And iTemp < 122 Then
        KeyAscii = iTemp - 32
    Else
        KeyAscii = iTemp
    End If
    
End Sub

Private Sub txtCode_LostFocus()
    txtCode.IMEMode = 0
End Sub

Private Sub txtMenuName_GotFocus()
    txtMenuName.SelStart = Len(txtMenuName.text)
    txtMenuName.IMEMode = 2
End Sub

Private Sub txtMenuName_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Then
        SendKeys "{tab}"
    ElseIf KeyCode = vbKeyUp Then
        SendKeys "+{tab}"
    End If
End Sub

Private Sub txtMenuName_LostFocus()
    txtMenuName.IMEMode = 0
End Sub

Private Sub txtName_GotFocus()
    txtName.IMEMode = 1
End Sub

Private Sub txtName_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Then
        SendKeys "{tab}"
    ElseIf KeyCode = vbKeyUp Then
        SendKeys "+{tab}"
    End If
End Sub

Private Sub txtName_LostFocus()
    txtName.IMEMode = 3
End Sub