📄 dwlb.frm

📁 酒店系统源码。为了学习和研究软件内含的设计思想和原理
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      End
      Begin VB.Menu MNU16 
         Caption         =   "退出(&E)"
      End
   End
   Begin VB.Menu MNU2 
      Caption         =   "编辑(&E)"
      Begin VB.Menu MNU21 
         Caption         =   "增加  "
         Shortcut        =   ^A
      End
      Begin VB.Menu MNU25 
         Caption         =   "修改  "
         Shortcut        =   ^E
      End
      Begin VB.Menu MNU26 
         Caption         =   "-"
      End
      Begin VB.Menu MNU23 
         Caption         =   "恢复  "
         Shortcut        =   ^U
      End
      Begin VB.Menu MNU24 
         Caption         =   "-"
      End
      Begin VB.Menu MNU22 
         Caption         =   "删除  "
         Shortcut        =   ^D
      End
   End
   Begin VB.Menu MNU3 
      Caption         =   "查看(&V)"
      Enabled         =   0   'False
   End
   Begin VB.Menu MNU4 
      Caption         =   "计算器(&J)"
   End
   Begin VB.Menu MNU5 
      Caption         =   "帮助(&H)"
      Begin VB.Menu MNU51 
         Caption         =   "帮助主题"
         Enabled         =   0   'False
      End
      Begin VB.Menu MNU52 
         Caption         =   "索引"
         Enabled         =   0   'False
      End
      Begin VB.Menu MNU53 
         Caption         =   "-"
      End
      Begin VB.Menu MNU54 
         Caption         =   "关于红日软件..."
      End
   End
End
Attribute VB_Name = "dwlb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DATZFGJ As Database    '住房公积管理数据库
Dim RECDWLB As Recordset     '代码数据表
Dim SFADD As Boolean       '是否增加标识

Private Sub Command1_Click()
    If Text2.Text = "" Then
       MsgBox "类别名称不能为空!", vbInformation, "提示信息"
       Text2.SetFocus
       Exit Sub
    End If
    STRKEY = "A" + Trim(Text1.Text)
    STRTEXT = Text2.Text
    If SFADD Then
       RECDWLB("类别名称") = Text2.Text
       RECDWLB.Update
       Set TEMPNODE = TreeView1.Nodes.Add(, , STRKEY, STRTEXT, 1, 2)
       Else
         RECDWLB.Edit
         RECDWLB("类别名称") = Text2.Text
         RECDWLB.Update
         TreeView1.Nodes(STRKEY).Text = Text2.Text
    End If
    TreeView1.Nodes(STRKEY).Selected = True
    Form_Activate
End Sub

Private Sub Form_Activate()
    Text2.Locked = True
    Text1.BackColor = &H8000000B
    Text2.BackColor = &H8000000B
    Command1.Enabled = False
    
    '使恢复菜单失效
    MNU23.Enabled = False
    Toolbar1.Buttons(7).Enabled = False

    SFADD = False
    If TreeView1.Nodes.Count > 0 Then
       STRKEY = Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1)
       RECDWLB.FindFirst ("类别ID=" & STRKEY)
       If RECDWLB.NoMatch Then
          MsgBox "错误的单位类别设置!", vbCritical, "错误"
          Text1.Text = ""
          Text2.Text = ""
          TransImg1.Visible = False
          '使修改菜单失效
          MNU25.Enabled = False
          Toolbar1.Buttons(6).Enabled = False
          '使删除菜单失效
          MNU22.Enabled = False
          Toolbar1.Buttons(8).Enabled = False
          Exit Sub
          Else
            Text1.Text = RECDWLB("类别ID")
            Text2.Text = RECDWLB("类别名称")
            If RECDWLB("使用") = True Then
               TransImg1.Visible = True
               MNU25.Enabled = False
               MNU22.Enabled = False
               Toolbar1.Buttons(6).Enabled = False
               Toolbar1.Buttons(8).Enabled = False
               Else
                 TransImg1.Visible = False
                 MNU25.Enabled = True
                 MNU22.Enabled = True
                 Toolbar1.Buttons(6).Enabled = True
                 Toolbar1.Buttons(8).Enabled = True
            End If
       End If
       Else
         Text1.Text = ""
         Text2.Text = ""
         TransImg1.Visible = False
         '使修改菜单失效
         MNU25.Enabled = False
         Toolbar1.Buttons(6).Enabled = False
         '使删除菜单失效
         MNU22.Enabled = False
         Toolbar1.Buttons(8).Enabled = False
    End If

End Sub

Private Sub Form_Load()          ' 激活模块时初设
    Dim TEMPNODE As Node
    Dim ncounter As Integer
    Dim STRKEY As String
    Dim STRTEXT As String
    
    Set DATZFGJ = OpenDatabase(App.Path & "\DATA\ZT" & ZTGL.STRZTH & "\ZFGJ.MDB")
    Set RECDWLB = DATZFGJ.OpenRecordset("单位分类", dbOpenDynaset)
   
    TreeView1.Nodes.Clear
    
    Do While Not RECDWLB.EOF
       STRKEY = "A" + Trim(RECDWLB("类别ID"))
       STRTEXT = IIf(IsNull(RECDWLB("类别名称")), "新类别", RECDWLB("类别名称"))
       If Not IsNull(STRTEXT) Then
          Set TEMPNODE = TreeView1.Nodes.Add(, , STRKEY, STRTEXT, 1, 2)
       End If
       RECDWLB.MoveNext
    Loop
    If TreeView1.Nodes.Count > 0 Then
       If TreeView1.Nodes(1).Children Then
          TreeView1.Nodes(1).Child.Selected = True
          Else
            TreeView1.Nodes(1).Selected = True
       End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)     '退出模块
    SFOK = MsgBox("  是否退出?  ", vbQuestion + vbYesNo, "提示信息")
    If SFOK = vbNo Then
       Cancel = True
       Else
         DATZFGJ.Close
    End If
End Sub

Private Sub MNU11_Click()      '打印机设置
    CDLTEST.Flags = cdlPDDisablePrintToFile
    CDLTEST.Copies = 3
    CDLTEST.PrinterDefault = True
'    CDLTEST.ShowPrinter

End Sub

Private Sub MNU16_Click()     ' 退出模块
    Unload Me
    
End Sub

Private Sub MNU21_Click()    '增加新记录
    SFADD = True
    RECDWLB.AddNew
    Text1.Text = RECDWLB("类别ID")
    Text2.Text = ""
    Text2.Locked = False
    Text2.BackColor = &H80000005
    Command1.Enabled = True
    
    '使恢复菜单有效
    MNU23.Enabled = True
    Toolbar1.Buttons(7).Enabled = True
    
    TransImg1.Visible = False

    Text2.SetFocus
    
End Sub

Private Sub MNU22_Click()     ' 删除记录
    Dim MTJ As String
    If TreeView1.Nodes.Count = 0 Then Exit Sub
    SFOK = MsgBox(Mid(TreeView1.SelectedItem.Key, 2) + " " + TreeView1.SelectedItem.Text + Chr(13) + "是否删除此记录?", vbYesNo + vbQuestion, "提示信息")
    If SFOK = vbYes Then
       MTJ = "类别ID=" + Mid(TreeView1.SelectedItem.Key, 2)
       RECDWLB.FindFirst (MTJ)
       If Not RECDWLB.NoMatch Then
          RECDWLB.Delete
          If Not RECDWLB.EOF Then
             RECDWLB.MoveNext
             Else
               RECDWLB.MoveLast
          End If
          TreeView1.Nodes.Remove (TreeView1.SelectedItem.Key)
          Else
            MsgBox "查无此记录!", , "提示信息"
       End If
    End If

End Sub

Private Sub MNU23_Click()           '恢复增加
    SFADD = False
    Form_Activate
End Sub

Private Sub MNU25_Click()
    Text2.Locked = False
    Text2.BackColor = &H80000005
    Command1.Enabled = True

    '使恢复菜单有效
    MNU23.Enabled = True
    Toolbar1.Buttons(7).Enabled = True
End Sub

Private Sub MNU4_Click()            ' 计算器
    Dim jsq As Double
    jsq = Shell("calc", vbNormalNoFocus)
 
End Sub

Private Sub MNU54_Click()          ' 关于对话
    Load frmAbout
    frmAbout.Show vbModal
    
End Sub

Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub
Private Sub Text5_GotFocus()
    Text5.SelStart = 0
    Text5.SelLength = 20
End Sub
Private Sub Text5_Validate(Cancel As Boolean)
    Text5.Text = FormatCurrency(Text5.Text)
End Sub
Private Sub Text6_GotFocus()
    Text6.SelStart = 0
    Text6.SelLength = Len(Text6.Text)
End Sub
Private Sub Text7_GotFocus()
    Text7.SelStart = 0
    Text7.SelLength = Len(Text7.Text)
End Sub
Private Sub Text10_GotFocus()
    Text10.SelStart = 0
    Text10.SelLength = Len(Text10.Text)
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case UCase(Button.Key)
        Case "A"          ' 打印机设置
            MNU11_Click
        Case "B"          ' 打印预览
            MsgBox "B"
        Case "C"          ' 文件输出
            MsgBox "C"
        Case "E"          ' 增加
            MNU21_Click
        Case "O"          ' 修改
            MNU25_Click
        Case "F"          ' 恢复增加
            SFADD = False
            Form_Activate
            
        Case "G"          ' 删除
            MNU22_Click
        Case "I"          ' 查看
            MsgBox "H"
        Case "O"
            
        Case "K"          ' 计算器
            MNU4_Click
        Case "M"          ' 帮助
            MsgBox "L"
        Case "N"          ' 退出
            Unload Me
    End Select
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    Form_Activate
End Sub
上一页 12
⌨️ 快捷键说明

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