📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMain
BackColor = &H8000000C&
Caption = "物资管理信息系统"
ClientHeight = 5088
ClientLeft = 132
ClientTop = 732
ClientWidth = 8064
LinkTopic = "MDIForm1"
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin MSComctlLib.StatusBar sbStatusBar
Align = 2 'Align Bottom
Height = 264
Left = 0
TabIndex = 0
Top = 4824
Width = 8064
_ExtentX = 14224
_ExtentY = 466
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 8615
Text = "Status"
TextSave = "Status"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
AutoSize = 2
TextSave = "2001-11-7"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
AutoSize = 2
TextSave = "16:20"
EndProperty
EndProperty
End
Begin VB.Menu menuSystem
Caption = "系统"
Begin VB.Menu menuModifypwd
Caption = "修改密码"
End
Begin VB.Menu menuAdduser
Caption = "添加用户"
End
Begin VB.Menu menuExit
Caption = "退出"
End
End
Begin VB.Menu menuMaterial
Caption = "物资基本信息管理"
Begin VB.Menu menuAddmaterial
Caption = "添加物资基本信息"
End
Begin VB.Menu menuModifymaterial
Caption = "修改物资基本信息"
End
Begin VB.Menu menuDeletematerial
Caption = "删除物资基本信息"
End
Begin VB.Menu menuInqurematerial
Caption = "查询物资基本信息"
End
End
Begin VB.Menu menuMaterialin
Caption = "物资入库信息管理"
Begin VB.Menu menuAddmaterialin
Caption = "添加物资入库信息"
End
Begin VB.Menu menuModifymaterialin
Caption = "修改物资入库信息"
End
Begin VB.Menu menuDeletematerialin
Caption = "删除物资入库信息"
End
Begin VB.Menu menuInquirematerialin
Caption = "查询物资入库信息"
End
End
Begin VB.Menu menuMaterialout
Caption = "物资出库信息管理"
Begin VB.Menu menuAddmaterialout
Caption = "添加物资出库信息"
End
Begin VB.Menu menuModifymaterialout
Caption = "修改物资出库信息"
End
Begin VB.Menu menuDeletematerialout
Caption = "删除物资出库信息"
End
Begin VB.Menu menuInquirematerialout
Caption = "查询物资出库信息"
End
End
Begin VB.Menu menuSurplus
Caption = "物资余额信息管理"
Begin VB.Menu menuInquiresurplus
Caption = "查询物资余额信息"
End
End
Begin VB.Menu menuHelp
Caption = "帮助"
Begin VB.Menu menuAbout
Caption = "About"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub MDIForm_Load()
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
Unload Me
End Sub
Private Sub menuAddmaterial_Click()
gintMmode = 1
frmMater1.Show
frmMater1.ZOrder 0
End Sub
Private Sub menuAddmaterialin_Click()
gintImode = 1
frmMaterIn1.Show
frmMaterIn1.ZOrder 0
End Sub
Private Sub menuAddmaterialout_Click()
gintOmode = 1
frmMaterOut1.Show
frmMaterOut1.ZOrder 0
End Sub
Private Sub menuAddsurplus_Click()
gintLmode = 1
frmMaterList1.Show
frmMaterList1.ZOrder 0
End Sub
Private Sub menuDeletematerial_Click()
Dim txtSQL As String
Dim intCount As Integer
Dim mrc As ADODB.Recordset
Dim MsgText As String
If flagMedit Then
If frmMater.msgList.Rows > 1 Then
If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
intCount = frmMater.msgList.Row
txtSQL = "delete from material where wzid='" & Trim(frmMater.msgList.TextMatrix(intCount, 1)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Unload frmMater
frmMater.txtSQL = "select * from material"
frmMater.Show
End If
End If
End If
End Sub
Private Sub menuDeletematerialin_Click()
Dim txtSQL As String
Dim intCount As Integer
Dim mrc As ADODB.Recordset
Dim MsgText As String
If flagIedit Then
If frmMaterIn.msgList.Rows > 1 Then
If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
intCount = frmMaterIn.msgList.Row
txtSQL = "update msurplus set yeaccount=yeaccount-" & Trim(frmMaterIn.msgList.TextMatrix(intCount, 7)) & ",yevalue=yevalue-" & Trim(frmMaterIn.msgList.TextMatrix(intCount, 9)) & " where yeid='" & Trim(frmMaterIn.msgList.TextMatrix(intCount, 2)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
txtSQL = "delete from msave where rkno='" & Trim(frmMaterIn.msgList.TextMatrix(intCount, 1)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Unload frmMaterIn
frmMaterIn.txtSQL = "select * from msave"
frmMaterIn.Show
End If
End If
End If
End Sub
Private Sub menuDeletematerialout_Click()
Dim txtSQL As String
Dim intCount As Integer
Dim mrc As ADODB.Recordset
Dim MsgText As String
If flagOedit Then
If frmMaterOut.msgList.Rows > 1 Then
If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
intCount = frmMaterOut.msgList.Row
txtSQL = "update msurplus set yeaccount=yeaccount+" & Trim(frmMaterOut.msgList.TextMatrix(intCount, 7)) & ",yevalue=yevalue+" & Trim(frmMaterOut.msgList.TextMatrix(intCount, 9)) & " where yeid='" & Trim(frmMaterOut.msgList.TextMatrix(intCount, 2)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
txtSQL = "delete from muse where lyno='" & Trim(frmMaterOut.msgList.TextMatrix(intCount, 1)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Unload frmMaterOut
frmMaterOut.txtSQL = "select * from muse"
frmMaterOut.Show
End If
End If
End If
End Sub
Private Sub menuInquirematerialin_Click()
frmMaterIn2.Show
End Sub
Private Sub menuInquirematerialout_Click()
frmMaterOut2.Show
End Sub
Private Sub menuInquiresurplus_Click()
If flagLedit Then
frmMaterList2.Show
Else
frmMaterList.txtSQL = "select * from msurplus"
frmMaterList.Show
End If
End Sub
Private Sub menuInqurematerial_Click()
frmMater2.Show
End Sub
Private Sub menuModifymaterial_Click()
Dim intCount As Integer
If flagMedit Then
If frmMater.msgList.Rows > 1 Then
gintMmode = 2
intCount = frmMater.msgList.Row
frmMater1.txtSQL = "select * from material where wzid='" & Trim(frmMater.msgList.TextMatrix(intCount, 1)) & "'"
frmMater1.Show
Else
Call menuAddmaterial_Click
End If
Else
frmMater.txtSQL = "select * from material"
frmMater.Show
End If
End Sub
Private Sub menuModifymaterialin_Click()
Dim intCount As Integer
If flagIedit Then
If frmMaterIn.msgList.Rows > 1 Then
gintImode = 2
intCount = frmMaterIn.msgList.Row
frmMaterIn1.txtSQL = "select * from msave where rkno='" & Trim(frmMaterIn.msgList.TextMatrix(intCount, 1)) & "'"
frmMaterIn1.Show
Else
Call menuAddmaterialin_Click
End If
Else
frmMaterIn.txtSQL = "select * from msave"
frmMaterIn.Show
End If
End Sub
Private Sub menuModifymaterialout_Click()
Dim intCount As Integer
If flagOedit Then
If frmMaterOut.msgList.Rows > 1 Then
gintOmode = 2
intCount = frmMaterOut.msgList.Row
frmMaterOut1.txtSQL = "select * from muse where lyno='" & Trim(frmMaterOut.msgList.TextMatrix(intCount, 1)) & "'"
frmMaterOut1.Show
Else
Call menuAddmaterialout_Click
End If
Else
frmMaterOut.txtSQL = "select * from muse"
frmMaterOut.Show
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -