frmmain1.frm

企业的进销存源码

VERSION 5.00
Begin VB.Form frmMain1 
   Caption         =   "真功夫进销存学习系统（初级）"
   ClientHeight    =   7350
   ClientLeft      =   1140
   ClientTop       =   1905
   ClientWidth     =   9870
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   7350
   ScaleWidth      =   9870
   Begin VB.PictureBox Pic 
      Height          =   1395
      Index           =   2
      Left            =   30
      Picture         =   "frmMain1.frx":0000
      ScaleHeight     =   1335
      ScaleWidth      =   9750
      TabIndex        =   2
      Top             =   30
      Width           =   9810
   End
   Begin VB.PictureBox Pic 
      BorderStyle     =   0  'None
      Height          =   5775
      Index           =   1
      Left            =   2520
      ScaleHeight     =   5775
      ScaleWidth      =   7305
      TabIndex        =   1
      Top             =   1500
      Width           =   7305
      Begin VB.PictureBox fPic 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000004&
         ForeColor       =   &H80000008&
         Height          =   705
         Index           =   0
         Left            =   720
         ScaleHeight     =   675
         ScaleWidth      =   1455
         TabIndex        =   4
         Top             =   510
         Width           =   1485
      End
   End
   Begin VB.PictureBox Pic 
      BorderStyle     =   0  'None
      Height          =   5775
      Index           =   0
      Left            =   30
      ScaleHeight     =   5775
      ScaleWidth      =   2415
      TabIndex        =   0
      Top             =   1500
      Width           =   2415
      Begin VB.PictureBox cPic 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000004&
         ForeColor       =   &H80000008&
         Height          =   435
         Index           =   0
         Left            =   210
         ScaleHeight     =   405
         ScaleWidth      =   1875
         TabIndex        =   3
         Top             =   480
         Width           =   1905
      End
   End
   Begin VB.Menu mFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu muFile 
         Caption         =   "退出"
         Index           =   0
      End
   End
   Begin VB.Menu mJczl 
      Caption         =   "基础资料(&J)"
      Begin VB.Menu muJczl 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mXsGl 
      Caption         =   "销售管理(&X)"
      Begin VB.Menu muXsGl 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mCgGl 
      Caption         =   "采购管理(&C)"
      Begin VB.Menu muCgGl 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mKcGl 
      Caption         =   "库存管理(&K)"
      Begin VB.Menu muKcGl 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmMain1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mWidth As Double, mHeight As Double
Dim mCurMoveCPicIndex As Integer
Dim mCurMoveFPicIndex As Integer

Private Sub cPic_Click(Index As Integer)
   Dim I As Integer
   Dim mPic As PictureBox
On Error GoTo Errorhandle
   
   fPic(0).Visible = False
   
   For I = 1 To fPic().Count - 1
      Unload fPic(I)
   Next
         
   Select Case Index
   Case 0
         
         Set fPic(0).Picture = LoadPicture(App.Path & "\PIC\FRMHWBM_B.BMP")
         fPic(0).Tag = "FRMHWBM"
         fPic(0).Left = fPic(0).Width / 2
         fPic(0).Top = fPic(0).Height / 2
         fPic(0).BorderStyle = 0
         fPic(0).Visible = True
         
         Load fPic(1)
         Set fPic(1).Picture = LoadPicture(App.Path & "\PIC\FRMHWCK.BMP")
         fPic(1).Tag = "FRMHWCK"
         fPic(1).Left = fPic(1).Width * 2
         fPic(1).Top = fPic(1).Height / 2
         fPic(1).Visible = True
         
         Load fPic(2)
         Set fPic(2).Picture = LoadPicture(App.Path & "\PIC\FRMHWPDRC.BMP")
         fPic(2).Tag = "FRMHWPDRC"
         fPic(2).Left = fPic(2).Width * 3 + fPic(2).Width / 2
         fPic(2).Top = fPic(2).Height / 2
         fPic(2).Visible = True
         
         Load fPic(3)
         Set fPic(3).Picture = LoadPicture(App.Path & "\PIC\FRMHWBFRC.BMP")
         fPic(3).Tag = "FRMHWBFRC"
         fPic(3).Left = fPic(3).Width * 5
         fPic(3).Top = fPic(3).Height / 2
         fPic(3).Visible = True
         
         Load fPic(4)
         Set fPic(4).Picture = LoadPicture(App.Path & "\PIC\FRMXSKH.BMP")
         fPic(4).Tag = "FRMXSKH"
         fPic(4).Left = fPic(4).Width / 2
         fPic(4).Top = fPic(4).Height * 2
         fPic(4).Visible = True
         
         Load fPic(5)
         Set fPic(5).Picture = LoadPicture(App.Path & "\PIC\FRMCGGYS.BMP")
         fPic(5).Tag = "FRMCGGYS"
         fPic(5).Left = fPic(5).Width * 2
         fPic(5).Top = fPic(5).Height * 2
         fPic(5).Visible = True
         
   Case 1
   
         Set fPic(0).Picture = LoadPicture(App.Path & "\PIC\FRMXSSOD_B.BMP")
         fPic(0).Tag = "FRMXSSOD"
         fPic(0).Left = fPic(0).Width / 2
         fPic(0).Top = fPic(0).Height / 2
         fPic(0).BorderStyle = 0
         fPic(0).Visible = True
         
         Load fPic(1)
         Set fPic(1).Picture = LoadPicture(App.Path & "\PIC\FRMXSFHD.BMP")
         fPic(1).Tag = "FRMXSFHD"
         fPic(1).Left = fPic(1).Width * 2
         fPic(1).Top = fPic(1).Height / 2
         fPic(1).Visible = True
         
         Load fPic(2)
         Set fPic(2).Picture = LoadPicture(App.Path & "\PIC\FRMXSTHD.BMP")
         fPic(2).Tag = "FRMXSTHD"
         fPic(2).Left = fPic(2).Width * 3 + fPic(2).Width / 2
         fPic(2).Top = fPic(2).Height / 2
         fPic(2).Visible = True
         
   Case 2
   
         Set fPic(0).Picture = LoadPicture(App.Path & "\PIC\FRMCGPOD_B.BMP")
         fPic(0).Tag = "FRMCGPOD"
         fPic(0).Left = fPic(0).Width / 2
         fPic(0).Top = fPic(0).Height / 2
         fPic(0).BorderStyle = 0
         fPic(0).Visible = True
         
         Load fPic(1)
         Set fPic(1).Picture = LoadPicture(App.Path & "\PIC\FRMCGSHD.BMP")
         fPic(1).Tag = "FRMCGSHD"
         fPic(1).Left = fPic(1).Width * 2
         fPic(1).Top = fPic(1).Height / 2
         fPic(1).Visible = True
         
         Load fPic(2)
         Set fPic(2).Picture = LoadPicture(App.Path & "\PIC\FRMCGTHD.BMP")
         fPic(2).Tag = "FRMCGTHD"
         fPic(2).Left = fPic(2).Width * 3 + fPic(2).Width / 2
         fPic(2).Top = fPic(2).Height / 2
         fPic(2).Visible = True
         
   Case 3
   
         Set fPic(0).Picture = LoadPicture(App.Path & "\PIC\FRMKCDBD_B.BMP")
         fPic(0).Tag = "FRMKCDBD"
         fPic(0).Left = fPic(0).Width / 2
         fPic(0).Top = fPic(0).Height / 2
         fPic(0).BorderStyle = 0
         fPic(0).Visible = True
         
         Load fPic(1)
         Set fPic(1).Picture = LoadPicture(App.Path & "\PIC\FRMKCPDD.BMP")
         fPic(1).Tag = "FRMKCPDD"
         fPic(1).Left = fPic(1).Width * 2
         fPic(1).Top = fPic(1).Height / 2
         fPic(1).Visible = True
         
         Load fPic(2)
         Set fPic(2).Picture = LoadPicture(App.Path & "\PIC\FRMKCBFD.BMP")
         fPic(2).Tag = "FRMKCBFD"
         fPic(2).Left = fPic(2).Width * 3 + fPic(2).Width / 2
         fPic(2).Top = fPic(2).Height / 2
         fPic(2).Visible = True
         
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub cPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Errorhandle
   
   If Index = mCurMoveCPicIndex Then
      Exit Sub
   End If
   
   Set cPic(0).Picture = LoadPicture(App.Path & "\PIC\JCZL_B.BMP")
   Set cPic(1).Picture = LoadPicture(App.Path & "\PIC\XSGL_B.BMP")
   Set cPic(2).Picture = LoadPicture(App.Path & "\PIC\CGGL_B.BMP")
   Set cPic(3).Picture = LoadPicture(App.Path & "\PIC\KCGL_B.BMP")
   
   Select Case Index
   Case 0
         Set cPic(0).Picture = LoadPicture(App.Path & "\PIC\JCZL.BMP")
         
   Case 1
         Set cPic(1).Picture = LoadPicture(App.Path & "\PIC\XSGL.BMP")
         
   Case 2
         Set cPic(2).Picture = LoadPicture(App.Path & "\PIC\CGGL.BMP")
         
   Case 3
         Set cPic(3).Picture = LoadPicture(App.Path & "\PIC\KCGL.BMP")
   
   End Select
   
   mCurMoveCPicIndex = Index

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle

   mWidth = Me.Width
   mHeight = Me.Height

   Pic(0).BackColor = RGB(186, 193, 212)
   Pic(1).BackColor = RGB(233, 238, 241)
   
   Set cPic(0).Picture = LoadPicture(App.Path & "\PIC\JCZL_B.BMP")
   cPic(0).BorderStyle = 0
   cPic(0).Top = cPic(0).Height / 2
   cPic(0).Visible = True
   
   Load cPic(1)
   Set cPic(1).Picture = LoadPicture(App.Path & "\PIC\XSGL_B.BMP")
   cPic(1).BorderStyle = 0
   cPic(1).Top = cPic(1).Height * 3
   cPic(1).Visible = True
   
   Load cPic(2)
   Set cPic(2).Picture = LoadPicture(App.Path & "\PIC\CGGL_B.BMP")
   cPic(2).BorderStyle = 0
   cPic(2).Top = cPic(2).Height * 5
   cPic(2).Visible = True
   
   Load cPic(3)
   Set cPic(3).Picture = LoadPicture(App.Path & "\PIC\KCGL_B.BMP")
   cPic(3).BorderStyle = 0
   cPic(3).Top = cPic(3).Height * 7
   cPic(3).Visible = True
   
   Set cPic(0).Picture = LoadPicture(App.Path & "\PIC\JCZL.BMP")
   mCurMoveCPicIndex = 0
   cPic_Click 0
   

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Resize()
On Error GoTo Errorhandle

   Pic(0).Height = Pic(0).Height + Me.Height - mHeight
   Pic(2).Width = Pic(2).Width + Me.Width - mWidth
   
   Pic(1).Width = Pic(1).Width + Me.Width - mWidth
   Pic(1).Height = Pic(1).Height + Me.Height - mHeight
   
   mWidth = Me.Width
   mHeight = Me.Height

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub fPic_DblClick(Index As Integer)
On Error GoTo Errorhandle

Select Case fPic(Index).Tag
Case "FRMHWBM"
      frmHwbm.Show
Case "FRMHWCK"
      frmHwCk.Show
Case "FRMHWPDRC"
      frmHwPdRc.Show
Case "FRMHWBFRC"
      frmHwBfrc.Show
Case "FRMXSKH"
      frmXsKh.Show
Case "FRMCGGYS"
      frmCgGys.Show
Case "FRMXSSOD"
      frmXsSod.Show
Case "FRMXSFHD"
      frmXsFhd.Show
Case "FRMXSTHD"
      frmXsThd.Show
Case "FRMCGPOD"
      frmCgPod.Show
Case "FRMCGSHD"
      frmCgShd.Show
Case "FRMCGTHD"
      frmCgThd.Show
Case "FRMKCDBD"
      frmKcDbd.Show
Case "FRMKCPDD"
      frmKcPdd.Show
Case "FRMKCBFD"
      frmKcbfd.Show
End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub fPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Errorhandle
   
   If mCurMoveFPicIndex = Index Then
      Exit Sub
   End If
   
   For I = 0 To fPic.Count - 1
      Set fPic(I).Picture = LoadPicture(App.Path & "\PIC\" & fPic(I).Tag & ".BMP")
   Next
   
   Set fPic(Index).Picture = LoadPicture(App.Path & "\PIC\" & fPic(Index).Tag & "_B.BMP")
   
   mCurMoveFPicIndex = Index

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub