mainform.frm

一套数据库管理软件,大家可以交流交流

      TabIndex        =   9
      Top             =   120
      Width           =   3000
   End
   Begin VB.Label copyright 
      BackStyle       =   0  'Transparent
      Caption         =   "- iszheSoft WorkGroup -"
      ForeColor       =   &H00404040&
      Height          =   255
      Left            =   8880
      TabIndex        =   5
      Top             =   510
      Width           =   2175
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00808080&
      X1              =   13
      X2              =   13
      Y1              =   30
      Y2              =   50
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      X1              =   10
      X2              =   10
      Y1              =   32
      Y2              =   48
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00808080&
      FillColor       =   &H00808080&
      Height          =   345
      Left            =   8700
      Top             =   435
      Width           =   2415
   End
End
Attribute VB_Name = "mainform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONUP = &H205
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 10
End Type

Private Declare Function Shell_NotifyIcon Lib "shell32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Boolean
'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Dim nid As NOTIFYICONDATA


Sub EditSelect(flag As Integer)
   Select Case flag
      Case 1      ' 商品库
          buyreg.Show
          Me.Hide
      Case 2      ' 商家库
          sbreg.Show
          Me.Hide
      Case 3      ' 购库
          bsreg.Show
          Me.Hide
      Case 4      ' 销库
          bxreg.Show
          Me.Hide
   End Select
End Sub


Sub LoadMyMenu()
 '载入菜单
   With frmmenu.MenuItems
     .Add 0, "WriteData", , "登记登记"                           'Index= 1
         .Add "WriteData", "Buyreg", smiPicture, "进货登记进货登记", LoadICO("Buyreg")  'Index= 2
         .Add "WriteData", "Sellreg", smiPicture, "销售登记销售登记", LoadICO("Sellreg")  'Index= 3
         .Add "WriteData", , smiSeparator  'Index= 4
         .Add "WriteData", "Personreg", smiPicture, "客商登记客商登记", LoadICO("Personreg")  'Index= 5
         .Add "WriteData", "Goodsreg", smiPicture, "商品登记商品登记", LoadICO("Goodsreg")  'Index= 6
        
     .Add 0, "ViewData", , "浏览浏览"  'Index= 7
         .Add "ViewData", "Goodsinfo", smiPicture, "商品浏览商品浏览", LoadICO("Goodsinfo")   'Index= 8
         .Add "ViewData", "Personinfo", smiPicture, "客商浏览客商浏览", LoadICO("Personinfo")   'Index= 9
         .Add "ViewData", "Buyinfo", smiPicture, "进货名细进货名细", LoadICO("Buyinfo")   'Index= 10
         .Add "ViewData", "Sellinfo", smiPicture, "出货名细出货名细", LoadICO("Sellinfo")  'Index= 11
         .Add "ViewData", , smiSeparator  'Index= 12
         .Add "ViewData", "ViewData_A", smiPicture, "报表打印报表打印", LoadICO("Print")  'Index= 13
              .Add "ViewData_A", "Pwlr", smiPicture, "商品利润商品利润", LoadICO("Preview")  'Index= 14
              .Add "ViewData_A", "Pwkc", smiPicture, "商品库存商品库存", LoadICO("Preview")  'Index= 15
              
     .Add 0, "FindData", , "查询查询"    'Index= 16
         .Add "FindData", "Goodsfind", smiPicture, "商品查询商品查询", LoadICO("Goodsfind")   'Index= 17
         .Add "FindData", "Mfind", , "利润查询利润查询"   'Index= 18
         .Add "FindData", , smiSeparator   'Index= 19
         .Add "FindData", "Superfind", smiPicture, "高级查询高级查询", LoadICO("Superfind")   'Index= 20
    
     .Add 0, "System", , "系统系统"   'Index= 21
         .Add "System", "admin", smiPicture, "管理员库管理员库", LoadICO("admin")   'Index= 22
         .Add "System", "System_A", smiPicture, "语言语言", LoadICO("Langue")   'Index= 23
              .Add "System_A", "Lchinese", smiCheckBox, "中文中文", , , , smiChecked   'Index= 24
              .Add "System_A", "Lenglish", smiCheckBox, "EngLish", , , , smiUnchecked   'Index=25
         .Add "System", , smiSeparator   'Index= 26
         .Add "System", "Help", smiPicture, "帮助帮助", LoadICO("Help")  'Index= 27
         .Add "System", "About", , "关于关于"   'Index= 28
   End With

End Sub
Private Sub Form_Load()
 Dim sTip As String
 Dim nid As NOTIFYICONDATA
 
  CenterForm Me
  LoadMyMenu

  SetMData Now_view
  SetMGird LangueSelect, Now_view
  CnToEn LangueSelect
  
  
 If LangueSelect <> 0 Then
     '载入英文语句 ------------
     frmmenu.MenuItems.Value(24) = smiUnchecked
     frmmenu.MenuItems.Value(25) = smiChecked
 End If
 
 'Dim stp As String
nid.szTip = "进销存软件"
' CopyMemory nid.szTip(1), ByVal stip, LenB(stip)
 nid.cbSize = LenB(nid)
 nid.hwnd = Me.hwnd
 nid.uID = 0
 nid.hIcon = Me.Icon.Handle
 nid.uCallbackMessage = WM_MOUSEMOVE
 nid.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
 
Shell_NotifyIcon NIM_ADD, nid

Image2.ToolTipText = "最小化"
Image1.ToolTipText = "最大化"

End Sub






Private Sub frmmenu_Click(ByVal ID As Long)
  'Debug.Print "ID=" & ID, "Name=" & frmmenu.MenuItems.Key(ID)
  
  Select Case frmmenu.MenuItems.Key(ID)
     
     Case "Buyreg"
       EditSelect 3
       
     Case "Sellreg"
       EditSelect 4
       
     Case "Goodsreg"
       EditSelect 1
       
     Case "Personreg"
       EditSelect 2
     Case "Goodsinfo"
       SetMData 1
       SetMGird LangueSelect, 1
       
     Case "Pwlr"
       rlr.Show 1
     
     Case "Pwkc"
       rhz.Show 1
       
     Case "Personinfo"
       SetMData 2
       SetMGird LangueSelect, 2
     Case "Buyinfo"
       SetMData 3
       SetMGird LangueSelect, 3
     Case "Sellinfo"
       SetMData 4
       SetMGird LangueSelect, 3
     Case "Goodsfind"
       SetMData 5
       SetMGird LangueSelect, 5
     Case "Mfind"
       SetMData 6
       SetMGird LangueSelect, 6
     Case "Superfind"
       spfind.Show
       Me.Hide
     Case "admin"
       If Now_User = "root" Then
           userreg.Show
           Me.Hide
         Else
           vMessageBox GetLStr(11), 1, 0
       End If
     Case "Lchinese"                         '转换成中文
        If LangueSelect <> 0 Then    '判断当前语言是否是中文
            '载入中文语句 ------------
            frmmenu.MenuItems.Value(ID) = smiChecked
            frmmenu.MenuItems.Value(ID + 1) = smiUnchecked
            LangueSelect = 0
            CnToEn LangueSelect
            SetMGird LangueSelect, Now_view
          Else
            frmmenu.MenuItems.Value(ID) = smiChecked
        End If
        
     Case "Lenglish"                         '转换成英文
        If LangueSelect <> 1 Then
            '载入英文语句 ------------
            frmmenu.MenuItems.Value(ID - 1) = smiUnchecked
            frmmenu.MenuItems.Value(ID) = smiChecked
            LangueSelect = 1
            CnToEn LangueSelect
            SetMGird LangueSelect, Now_view
          Else
            frmmenu.MenuItems.Value(ID) = smiChecked
        End If
     Case "Help"
        htmlhelp Me.hwnd, App.Path & "\help.chm", 0, 0
        Case "About"
    frmAbout.Show 1
  End Select
  
  
End Sub

Private Sub Image1_Click()
Shell_NotifyIcon NIM_DELETE, nid
End

End Sub

Private Sub Image2_Click()
 Me.Hide
 smmainform.Show
End Sub

Private Sub mfrm_move_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 '移动无标题窗口
  ReleaseCapture
  SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
End Sub

Private Sub mfrm_move_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Select Case X / Screen.TwipsPerPixelX
  Case WM_LBUTTONUP
    Unload smmainform
    Me.Show
  Case WM_RBUTTONUP
  Me.Hide
 End Select
End Sub

Private Sub mytoolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
 'Debug.Print "Button index:=" & Button.Index
 
 Select Case Button.Index
     Case 2                 '填加
       If Now_view <= 4 Then EditSelect Now_view
     Case 3                 '编辑
       If Now_view <= 4 Then EditSelect Now_view
     Case 4                 '刷新
        ReGird Now_view
     Case 6                 '用户库
       If Now_User = "root" Then
           userreg.Show
           Me.Hide
         Else
           vMessageBox GetLStr(11), 1, 0
       End If
     Case 7
       htmlhelp Me.hwnd, App.Path & "\help.chm", 0, 0
     Case 8              '退出系统
     Shell_NotifyIcon NIM_DELETE, nid
       End
      
 End Select
End Sub