📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMain
BackColor = &H8000000C&
Caption = "图书出入库管理系统"
ClientHeight = 8070
ClientLeft = 165
ClientTop = 735
ClientWidth = 11685
Icon = "frmMain.frx":0000
LinkTopic = "MDIForm1"
Picture = "frmMain.frx":0442
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin VB.PictureBox Picture2
Align = 1 'Align Top
BorderStyle = 0 'None
Height = 450
Left = 0
ScaleHeight = 450
ScaleWidth = 11685
TabIndex = 3
Top = 0
Width = 11685
Begin VB.CommandButton Command7
Caption = "退出"
Height = 450
Left = 3000
TabIndex = 9
Top = 0
Width = 615
End
Begin VB.CommandButton Command6
Caption = "关于"
Height = 450
Left = 2400
TabIndex = 8
ToolTipText = "输出订购数据"
Top = 0
Width = 615
End
Begin VB.CommandButton Command5
Caption = "界面"
Height = 450
Left = 1800
TabIndex = 7
ToolTipText = "批查重选购"
Top = 0
Width = 615
End
Begin VB.CommandButton Command4
Caption = "参数"
Height = 450
Left = 1200
TabIndex = 6
ToolTipText = "单查重选购"
Top = 0
Width = 615
End
Begin VB.CommandButton Command3
Caption = "出库"
Height = 450
Left = 600
TabIndex = 5
ToolTipText = "EXCEL转入预采库"
Top = 0
Width = 615
End
Begin VB.CommandButton Command2
Caption = "入库"
Height = 450
Left = 0
TabIndex = 4
ToolTipText = "EXCEL转入馆藏"
Top = 0
Width = 615
End
End
Begin VB.PictureBox Picture1
Align = 1 'Align Top
Height = 7215
Left = 0
ScaleHeight = 7155
ScaleWidth = 11625
TabIndex = 1
Top = 450
Width = 11685
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Label3"
BeginProperty Font
Name = "华文彩云"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 3600
TabIndex = 11
Top = 3840
Width = 6375
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Label2"
BeginProperty Font
Name = "华文彩云"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 360
TabIndex = 10
Top = 240
Width = 9375
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "使用单位：化学工业出版社"
BeginProperty Font
Name = "楷体_GB2312"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 2
Top = 1560
Width = 9855
End
Begin VB.Image Image1
Height = 6810
Left = 0
Picture = "frmMain.frx":0784
Stretch = -1 'True
Top = 0
Width = 10335
End
End
Begin MSComctlLib.StatusBar sbStatusBar
Align = 2 'Align Bottom
Height = 270
Left = 0
TabIndex = 0
Top = 7800
Width = 11685
_ExtentX = 20611
_ExtentY = 476
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 14975
Text = "图书出入库管理系统，设计者：熊拥军 QQ:9521715"
TextSave = "图书出入库管理系统，设计者：熊拥军 QQ:9521715"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
AutoSize = 2
TextSave = "2006-8-5"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
AutoSize = 2
TextSave = "20:11"
EndProperty
EndProperty
End
Begin VB.Menu mnurcsj
Caption = "功能"
Begin VB.Menu mnurexcel
Caption = "库存转入"
End
Begin VB.Menu tsdcchuli
Caption = "图书入库"
End
Begin VB.Menu tsjg_tsdb
Caption = "图书出库"
End
Begin VB.Menu ssssss
Caption = "-"
End
Begin VB.Menu gxdcs
Caption = "参数设置"
End
Begin VB.Menu currentkz
Caption = "查看当前库存"
End
Begin VB.Menu clearyc
Caption = "清空库存数据"
End
Begin VB.Menu clearbg
Caption = "清空出库数据"
End
Begin VB.Menu setupabc
Caption = "界面参数"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于"
End
Begin VB.Menu exitsy
Caption = "退出"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Sub clearbg_Click()
Dim db As Database
If MsgBox("要清空本馆所有馆藏库数据？", 17, "清空馆藏库") = 1 Then
If MsgBox("确实要清空本馆所有馆藏库数据？,请再次确认!", 17, "清空馆藏库") = 1 Then
Set db = OpenDatabase("d:\cbssys\bookcgk.mdb")
db.Execute "delete * from 本馆数据"
db.Close
MsgBox "本馆数据已清空"
End If
End If
gcrecordx = 0
End Sub
Private Sub clearyc_Click()
Dim db As Database
If MsgBox("确实要清空当前预采库所有数据？", 17, "清空预采库") = 1 Then
Set db = OpenDatabase("d:\cbssys\bookcgk.mdb")
db.Execute "delete * from 预采数据"
db.Close
MsgBox "预采数据已清空"
End If
rcrecordx = 0
End Sub
Private Sub Command2_Click()
dg_singlexg.Show 1
End Sub
Private Sub Command3_Click()
singleanddc = "tsdb"
tsdbxg.Show 1
End Sub
Private Sub Command5_Click()
setupabout.Show 1
Label1.Caption = "使用单位：" & dwstring
Label2.Caption = welcomestring
Label3.Caption = thankstring
End Sub
Private Sub Command6_Click()
MsgBox "软件设计：熊拥军，QQ：9521715"
End Sub
Private Sub Command7_Click()
Unload Me
End Sub
Private Sub exceltwo_Click()
excelnew.Show 1
End Sub
Private Sub erasebaohao_Click()
Dim db As Database
If MsgBox("要清空上次打包数据吗？", 17, "清空包号出书数") = 1 Then
If MsgBox("确实要清空上次打包数据？,请再次确认!", 17, "清空包号/出书数") = 1 Then
Set db = OpenDatabase("d:\cbssys\bookcgk.mdb")
db.Execute "update 预采数据 set dgs=0,baohao=0"
db.Close
MsgBox "出书数和包号均设置为0!"
End If
End If
End Sub
Private Sub currentkz_Click()
On Error Resume Next
Set db = Workspaces(0).OpenDatabase("d:\cbssys\bookcgk.mdb")
Set rs = db.OpenRecordset("select count(*) as zongsum,sum(fbl)as csum,sum(fbl*val(jg)) as je from 预采数据")
MsgBox "种数：" & rs.Fields("zongsum").Value & "；册数：" & rs.Fields("csum").Value & "；金额：" & rs.Fields("je").Value
rs.Close
db.Close
End Sub
Private Sub exitsy_Click()
Unload Me
End Sub
Private Sub gxdcs_Click()
outputpara.Show 1
End Sub
Private Sub MDIForm_Load()
On Error Resume Next
' Set xddb = Workspaces(0).OpenDatabase("d:\cbssys\bookcgk.mdb")
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)
Picture1.Height = Me.Height - Me.sbStatusBar.Height * 2 - Picture2.Height * 2 + 50
Image1.Width = Picture1.Width
Image1.Height = Picture1.Height
Command1.Left = Me.Width - Command1.Width
Command1.Top = Picture1.Height - Command1.Height * 2
' Me.Width = Me.Picture.Width
Me.Show
'introhg.Show 1
Label1.Caption = "使用单位：" & dwstring
Label2.Caption = welcomestring
Label3.Caption = thankstring
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim reply As Integer
reply = MsgBox("真的想退出系统吗？", vbYesNo)
If reply = vbNo Then
Cancel = True
End If
If reply = vbYes Then
End
End If
End Sub
Private Sub MDIForm_Resize()
On Error Resume Next
Picture1.Height = Me.Height - Me.sbStatusBar.Height * 2 - Picture2.Height * 2 + 50
Image1.Width = Picture1.Width
Image1.Height = Picture1.Height
Command1.Left = Me.Width - Command1.Width
Command1.Top = Picture1.Height - Command1.Height * 2
Label2.Left = Label1.Left
Label2.Top = 100
Label3.Left = Me.Width - Label3.Width - 100
Label3.Top = Me.Height - Label3.Height * 3
Frame1.Top = 10
Frame1.Left = Me.Width - Frame1.Width - 200
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
End Sub
Private Sub mnuHelphx_Click()
introhg.Show 1
End Sub
Private Sub mnurexcel_Click()
worktok = "预采库"
excelfile.Show 1
End Sub
Private Sub mnurmarc_Click()
worktok = "预采库"
worzzk.Show 1
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "Align Left"
ActiveForm.rtfText.SelAlignment = rtfLeft
Case "Center"
ActiveForm.rtfText.SelAlignment = rtfCenter
Case "Align Right"
ActiveForm.rtfText.SelAlignment = rtfRight
End Select
End Sub
Private Sub mnuHelpAbout_Click()
MsgBox "软件设计：熊拥军，QQ：9521715"
End Sub
Private Sub mnuHelpContents_Click()
introhf.Show 1
End Sub
Private Sub mnuWindowArrangeIcons_Click()
Me.Arrange vbArrangeIcons
End Sub
Private Sub mnuWindowTileVertical_Click()
Me.Arrange vbTileVertical
End Sub
Private Sub mnuWindowTileHorizontal_Click()
Me.Arrange vbTileHorizontal
End Sub
Private Sub mnuWindowCascade_Click()
Me.Arrange vbCascade
End Sub
Private Sub setupabc_Click()
setupabout.Show 1
Label1.Caption = "使用单位：" & dwstring
Label2.Caption = welcomestring
Label3.Caption = thankstring
End Sub
Private Sub tsdcchuli_Click()
'图书典藏
'singleanddc = "diancang"
' singlexg.Show 1
dg_singlexg.Show 1
End Sub
Private Sub tsinputoutput_Click()
tsinputout.Show 1
End Sub
Private Sub tsjg_tsdb_Click()
singleanddc = "tsdb"
tsdbxg.Show 1
End Sub
Private Sub Command4_Click()
outputpara.Show 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -