⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmcpwh.frm

📁 适合于中小型企业管理
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":239C
            Key             =   "bz"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":2736
            Key             =   "tc"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":2AD0
            Key             =   "bcgs"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":2E6A
            Key             =   "mrlk"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":3204
            Key             =   "xsxm"
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":359E
            Key             =   "first"
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":3938
            Key             =   "prev"
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":3CD2
            Key             =   "next"
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":406C
            Key             =   "last"
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":4406
            Key             =   "xx"
         EndProperty
         BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":47A0
            Key             =   "define"
         EndProperty
         BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":4B3A
            Key             =   "exec"
         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":4ED4
            Key             =   "xz"
         EndProperty
         BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":526E
            Key             =   "sc"
         EndProperty
         BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":5608
            Key             =   "sx"
         EndProperty
         BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":59A2
            Key             =   "cx"
         EndProperty
         BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":5D3C
            Key             =   "zd"
         EndProperty
         BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":60D6
            Key             =   "dz"
         EndProperty
         BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":6470
            Key             =   "ph"
         EndProperty
         BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":680A
            Key             =   "fz"
         EndProperty
         BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmCpwh.frx":6BA4
            Key             =   "dw"
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox vsElasticLight1 
      Height          =   480
      Left            =   6660
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   19
      Top             =   1230
      Width           =   1200
   End
End
Attribute VB_Name = "FrmCpwh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim AddFlg As Boolean
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim Bln_Cancel As Boolean                '取消按钮信息传递

Private Sub BcCommand_Click()
On Error GoTo Err
     If Trim(LrText(0).Text) = "" Or Trim(LrText(1).Text) = "" Or Trim(LrText(2).Text) = "" Or Trim(LrText(3).Text) = "" Or Trim(LrText(4).Text) = "" Then
       MsgBox "记录输入不完整!"
       Exit Sub
     End If
      Cxnrrec!图号 = Trim(LrText(0).Text)
      Cxnrrec!品名 = Trim(LrText(1).Text)
      Cxnrrec!规格 = Trim(LrText(2).Text)
      Cxnrrec!硝材 = Trim(LrText(3).Text)
      Cxnrrec!创建者 = Xtczy
      Cxnrrec!创建日期 = Trim(LrText(5).Text)
      If AddFlg = True Then
        Cxnrrec.Update
        MsgBox "记录添加成功!", vbInformation
        Cxnrrec.MoveNext
        If Cxnrrec.EOF Then Cxnrrec.MoveLast
    Else
        Cxnrrec.UpdateBatch adAffectAllChapters
        MsgBox "记录修改成功!", vbInformation
        Cxnrrec.MoveNext
        If Cxnrrec.EOF Then Cxnrrec.MoveLast
    End If
    
    Call Toolfbjzt
    Call Cxnrtcwg
    Exit Sub
Err:
        If AddFlg = True Then
            Cxnrrec.CancelUpdate
        Else
            Cxnrrec.CancelBatch adAffectAllChapters
        End If
End Sub

Private Sub Form_Load()
    '调入网格设置信息
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , " ID", 800
    lstContracts.ColumnHeaders.Add , , "  图号", 1200
    lstContracts.ColumnHeaders.Add , , "    品名", 1480
    lstContracts.ColumnHeaders.Add , , "    规格", 1480
    lstContracts.ColumnHeaders.Add , , "    硝材", 1480
    lstContracts.ColumnHeaders.Add , , "  创建者", 1280
    lstContracts.ColumnHeaders.Add , , "  创建日期", 1480

    
    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
    LrText(4).Text = Xtczy
    '设置为非录入状态
    Lrzt = 0

End Sub
Private Sub lstContracts_DblClick()
    Call Xgdqjl
End Sub

Private Sub QxCommand_Click()                                           '取消
    If AddFlg = True Then
      Cxnrrec.CancelUpdate
    Else
      Cxnrrec.CancelBatch adAffectAllChapters
    End If
    
    If Bln_Cancel Then
        Bln_Cancel = False
        Exit Sub
    End If
    
    Call Toolfbjzt
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
      
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            DY_Dyymsz.Show 1
        Case "yl"                                            '预 览
                
        Case "dy"                                            '打 印
            
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            Call Cshlrxx(Lrzt)
            AddFlg = True
            LrText(5).Text = Gsdate()
            Cxnrrec.AddNew
        Case "xg"                                            '修 改
            Call Xgdqjl
            LrText(5).Text = Gsdate()
            AddFlg = False
        Case "sc"                                            '删 除
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        End Select
        
End Sub

Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
    Toolbjzt
    LrText(0).Text = ""
    LrText(1).Text = ""
    LrText(2).Text = ""
    LrText(3).Text = ""
End Function

Private Sub Scdqjl()                                     '删 除 当 前 记 录
    Toolfbjzt
     If Not lstContracts.ListItems.Count < 1 Then
        If vbYes = MsgBox("确认是要删除此记录么?" & "(" & lstContracts.SelectedItem.Text & ")", vbYesNo, "删除对话框") Then
            Sqlstr = "delete FROM Bs_产品图号 where id='" & Trim(lstContracts.SelectedItem.Text) & "'"
            Set RsView = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        End If
    Else
        MsgBox "请选择要删除的记录行!", vbCritical, "错误:"
    End If
    
    Call Cxnrtcwg
End Sub

Private Sub Xgdqjl()                                     '修改当前编码记录
    
    If Not lstContracts.ListItems.Count < 1 Then
        Toolbjzt
        Set Cxnrrec = New ADODB.Recordset
        Cxnrrec.Open "SELECT *  FROM Bs_产品图号 where id='" & Trim(lstContracts.SelectedItem.Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
             LrText(0).Text = Cxnrrec!图号
             LrText(1).Text = Cxnrrec!品名
             LrText(2).Text = Cxnrrec!规格
             LrText(3).Text = Cxnrrec!硝材
             LrText(4).Text = Cxnrrec!创建者
             LrText(5).Text = Cxnrrec!创建日期
    End If
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

     
End Function

 
Private Sub Cxnrtcwg()                               '查询内容填充网格(刷新)
    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结


    '[>>查询连接串
    Set Cxnrrec = New ADODB.Recordset
    Cxnrrec.Open "SELECT * FROM Bs_产品图号 order by 图号", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
       
    With Cxnrrec

        If .EOF And .BOF Then

            Exit Sub
        End If

        
        '[>>以下为自定义部分
        Dim ItmX As ListItem
    
        lstContracts.ListItems.Clear
        Do While Not .EOF
            Set ItmX = lstContracts.ListItems.Add(, , Cxnrrec!Id)
             ItmX.SubItems(1) = Cxnrrec!图号
             ItmX.SubItems(2) = Cxnrrec!品名
             ItmX.SubItems(3) = Cxnrrec!规格
             ItmX.SubItems(4) = Cxnrrec!硝材
             ItmX.SubItems(5) = Cxnrrec!创建者
             ItmX.SubItems(6) = Cxnrrec!创建日期
            
            Cxnrrec.MoveNext
        Loop
    End With
  
    '将网格刷新动作解冻
     lstContracts.Refresh
    
End Sub

Private Sub Toolbjzt()                                   'Toolbar状态(编辑状态)

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    StTab.TabEnabled(0) = False
  
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("sx").Enabled = False
    End With
  
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)

    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    Lrzt = 0
    
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
    End With
  
End Sub



⌨️ 快捷键说明

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