📄 frmcpwh.frm
字号:
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 + -