myapi.bas

进销存管理(ADO+Acess),适合初学者使用!

Attribute VB_Name = "myapi"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'移动无标题窗口
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const HTCAPTION = 2

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function htmlhelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hwndcaller As Long, ByVal pszfile As String, ByVal ucommand As Long, ByVal dwdata As Long) As Long
'____________________________________________________________________________________
Public Now_User As String             '当前管理员
Public OpenDataBase_flag As Integer   '数据是否打开    0-没有 1-打开
Public Now_view As Integer            '当前浏览哪个库
Public LangueSelect As Integer        '当前语言 0-中文   1-英文


Public ReMsgBox As Integer            '自定义 MsgBox 专用
'应答值
'0    确定  是
'1    取消  否


Public Function LoadICO(sFileName As String) As StdPicture
 '载入ICO
  Set LoadICO = LoadPicture(App.Path + "\Images\" + sFileName + ".ico")
End Function



'自定义MSGBOX专用  ------------------------------------------------------
Public Sub vMessageBox(mstr As String, mpic As Integer, flag As Integer)
    vmsgbox.Hide
    vmsgbox.msgpic.Picture = LoadICO(CStr(mpic))
    vmsgbox.msginfo.Caption = mstr
    Select Case LangueSelect
     Case 0
        Select Case flag
          Case 0          '只有确定
              vmsgbox.confim_b.Caption = "确 定"
              vmsgbox.cancel_b.Caption = "取 消"
              vmsgbox.cancel_a.Visible = False
              vmsgbox.cancel_b.Visible = False
              vmsgbox.cancel_c.Visible = False
          Case 1          '有确定有取消
              vmsgbox.confim_b.Caption = "确 定"
              vmsgbox.cancel_b.Caption = "取 消"
          Case 2          '有是无否
              vmsgbox.confim_b.Caption = "是"
              vmsgbox.cancel_b.Caption = "否"
              vmsgbox.cancel_a.Visible = False
              vmsgbox.cancel_b.Visible = False
              vmsgbox.cancel_c.Visible = False
          Case 3          '有是有否
              vmsgbox.confim_b.Caption = "是"
              vmsgbox.cancel_b.Caption = "否"
        End Select
     Case 1
        Select Case flag
          Case 0          '只有确定
              vmsgbox.confim_b.Caption = "OK"
              vmsgbox.cancel_b.Caption = "Cancel"
              vmsgbox.cancel_a.Visible = False
              vmsgbox.cancel_b.Visible = False
              vmsgbox.cancel_c.Visible = False
          Case 1          '有确定有取消
              vmsgbox.confim_b.Caption = "OK"
              vmsgbox.cancel_b.Caption = "Cancel"
          Case 2          '有是无否
              vmsgbox.confim_b.Caption = "Yes"
              vmsgbox.cancel_b.Caption = "No"
              vmsgbox.cancel_a.Visible = False
              vmsgbox.cancel_b.Visible = False
              vmsgbox.cancel_c.Visible = False
          Case 3          '有是有否
              vmsgbox.confim_b.Caption = "Yes"
              vmsgbox.cancel_b.Caption = "No"
        End Select
    End Select
    vmsgbox.Show 1
End Sub

Public Function GetMsgRe() As Integer
  GetMsgRe = ReMsgBox
End Function

'-------------------------------------------------------------------------


Public Sub SetMData(flag As Integer)
  
  Select Case flag
     Case 1              '主窗口预览库
       mainform.mygird.DataMember = "rs商品表预览"
       Now_view = 1
     Case 2              '主窗口预览库
       mainform.mygird.DataMember = "rs商家表预览"
       Now_view = 2
     Case 3              '主窗口预览库
       mainform.mygird.DataMember = "rs购预览"
       Now_view = 3
     Case 4              '主窗口预览库
       mainform.mygird.DataMember = "rs销预览"
       Now_view = 4
     Case 5              '主窗口预览库
       mainform.mygird.DataMember = "rs商品汇总"
       Now_view = 5
     
     Case 6              '主窗口预览库
       mainform.mygird.DataMember = "rs商品利润"
       Now_view = 6
  End Select
End Sub

Public Sub SetMGird(langueF As Integer, flag As Integer)
  Select Case langueF
     Case 0
        Select Case flag
          Case 1        'rs商品表预览
            mainform.mygird.Columns(0).Caption = "商品编号"
            mainform.mygird.Columns(1).Caption = "商品名称"
            mainform.mygird.Columns(2).Caption = "商品产地"
            mainform.mygird.Columns(3).Caption = "商品产家"
            mainform.mygird.Columns(4).Caption = "入库日期"
            mainform.km.Caption = "商品表预览"
          Case 2        'rs商家表预览
            mainform.mygird.Columns(0).Caption = "商品名称"
            mainform.mygird.Columns(1).Caption = "联系电话"
            mainform.mygird.Columns(2).Caption = "联系人"
            mainform.mygird.Columns(3).Caption = "地址"
            mainform.mygird.Columns(4).Caption = "邮编"
            mainform.mygird.Columns(5).Caption = "银行帐号"
            mainform.mygird.Columns(6).Caption = "日期"
            mainform.km.Caption = "商家表预览"
          Case 3         'rs购销预览
            mainform.mygird.Columns(0).Caption = "单据号"
            mainform.mygird.Columns(1).Caption = "发票号"
            mainform.mygird.Columns(2).Caption = "购销日期"
            mainform.mygird.Columns(3).Caption = "商家名称"
            mainform.mygird.Columns(4).Caption = "商品名"
            mainform.mygird.Columns(5).Caption = "单价（单位：￥）"
            mainform.mygird.Columns(6).Caption = "商品数量"
            If Now_view = 3 Then
                 mainform.km.Caption = "购表预览"
              Else
                 mainform.km.Caption = "销表预览"
            End If
          Case 4
            mainform.mygird.Columns(0).Caption = "单据号"
            mainform.mygird.Columns(1).Caption = "发票号"
            mainform.mygird.Columns(2).Caption = "购销日期"
            mainform.mygird.Columns(3).Caption = "商家名称"
            mainform.mygird.Columns(4).Caption = "商品名"
            mainform.mygird.Columns(5).Caption = "单价（单位：￥）"
            mainform.mygird.Columns(6).Caption = "商品数量"
            If Now_view = 3 Then
                 mainform.km.Caption = "购表预览"
              Else
                 mainform.km.Caption = "销表预览"
            End If
          Case 5         'rs商品汇总
            mainform.mygird.Columns(0).Caption = "商品号"
            mainform.mygird.Columns(1).Caption = "商品名"
            mainform.mygird.Columns(2).Caption = "产  地"
            mainform.mygird.Columns(3).Caption = "总进量"
            mainform.mygird.Columns(4).Caption = "总销量"
            mainform.mygird.Columns(5).Caption = "库  存"
            mainform.km.Caption = "库存汇总"
            
          Case 6         'rs商品利润
            mainform.mygird.Columns(0).Caption = "商品号"
            mainform.mygird.Columns(1).Caption = "商品名"
            mainform.mygird.Columns(2).Caption = "厂  商"
            mainform.mygird.Columns(3).Caption = "总进额"
            mainform.mygird.Columns(4).Caption = "总销额"
            mainform.mygird.Columns(5).Caption = "总利润"
            mainform.km.Caption = "利润汇总"
        End Select
     Case 1
        Select Case flag
          Case 1        'rs商品表预览
            mainform.mygird.Columns(0).Caption = "ID"
            mainform.mygird.Columns(1).Caption = "Name"
            mainform.mygird.Columns(2).Caption = "From"
            mainform.mygird.Columns(3).Caption = "Manufacturer"
            mainform.mygird.Columns(4).Caption = "Date"
            mainform.km.Caption = "Goods"
          Case 2        'rs商家表预览
            mainform.mygird.Columns(0).Caption = "Name"
            mainform.mygird.Columns(1).Caption = "Contact Tel"
            mainform.mygird.Columns(2).Caption = "Linkman"
            mainform.mygird.Columns(3).Caption = "Address"
            mainform.mygird.Columns(4).Caption = "Dak No"
            mainform.mygird.Columns(5).Caption = "Bank Accounts"
            mainform.mygird.Columns(6).Caption = "Date"
            mainform.km.Caption = "Trader"
          Case 3         'rs购销预览
            mainform.mygird.Columns(0).Caption = "Order ID"
            mainform.mygird.Columns(1).Caption = "Invoice ID"
            mainform.mygird.Columns(2).Caption = "Date"
            mainform.mygird.Columns(3).Caption = "Manufacturer"
            mainform.mygird.Columns(4).Caption = "Name"
            mainform.mygird.Columns(5).Caption = "Unit Price（Unit：￥）"
            mainform.mygird.Columns(6).Caption = "Amount"
            If Now_view = 3 Then
                 mainform.km.Caption = "Buy"
              Else
                 mainform.km.Caption = "Sell"
            End If
          Case 4
            mainform.mygird.Columns(0).Caption = "Order ID"
            mainform.mygird.Columns(1).Caption = "Invoice ID"
            mainform.mygird.Columns(2).Caption = "Date"
            mainform.mygird.Columns(3).Caption = "Manufacturer"
            mainform.mygird.Columns(4).Caption = "Name"
            mainform.mygird.Columns(5).Caption = "Unit Price（Unit：￥）"
            mainform.mygird.Columns(6).Caption = "Amount"
            If Now_view = 3 Then
                 mainform.km.Caption = "Buy"
              Else
                 mainform.km.Caption = "Sell"
            End If
          Case 5         'rs商品汇总
            mainform.mygird.Columns(0).Caption = "ID"
            mainform.mygird.Columns(1).Caption = "Name"
            mainform.mygird.Columns(2).Caption = "From"
            mainform.mygird.Columns(3).Caption = "Buy"
            mainform.mygird.Columns(4).Caption = "Sale"
            mainform.mygird.Columns(5).Caption = "Total"
            mainform.km.Caption = "Stock Total"
            
          Case 6         'rs商品利润
            mainform.mygird.Columns(0).Caption = "ID"
            mainform.mygird.Columns(1).Caption = "Name"
            mainform.mygird.Columns(2).Caption = "Manufacturer"
            mainform.mygird.Columns(3).Caption = "Buy"
            mainform.mygird.Columns(4).Caption = "Sale"
            mainform.mygird.Columns(5).Caption = "Gain"
            mainform.km.Caption = "Profit Total"
            
       End Select
  End Select
End Sub


Public Sub CenterForm(Formname As Form)
   '窗口居中
  Formname.Move (Screen.Width - Formname.Width) \ 2, (Screen.Height - Formname.Height) \ 2 - vmsgbox.Height / 3
End Sub


Public Sub OpenDataBase()
  On Error GoTo exit_label
   If OpenDataBase_flag <> 1 Then
   
      mydata.condata.Open
      
   End If
  Exit Sub
exit_label:
   
End Sub


Public Sub ReGird(flag As Integer)
  On Error GoTo exit_sub
 
   Select Case flag
    
    Case 1                 '主窗口编辑后刷新
       mydata.rsrs商品表预览.Requery
       If 1 = Now_view Then
          With mainform.mygird
              Set .DataSource = mydata
              .DataMember = "rs商品表"
              .Refresh
               SetMGird LangueSelect, Now_view
           End With
       End If
       
    Case 2                 '主窗口编辑后刷新
       mydata.rsrs商家表预览.Requery
       If 2 = Now_view Then
          With mainform.mygird
              Set .DataSource = mydata
              .DataMember = "rs商家表"
              .Refresh
               SetMGird LangueSelect, Now_view
           End With
       End If
  
    Case 3                 '主窗口编辑后刷新
       mydata.rsrs购预览.Requery
       If 3 = Now_view Then
          With mainform.mygird
              Set .DataSource = mydata
              .DataMember = "rs购预览"
              .Refresh
               SetMGird LangueSelect, Now_view
           End With
       End If
  
    Case 4                 '主窗口编辑后刷新
       mydata.rsrs销预览.Requery
       If 4 = Now_view Then
          With mainform.mygird
              Set .DataSource = mydata
              .DataMember = "rs销预览"
              .Refresh
               SetMGird LangueSelect, Now_view
           End With
       End If
  
  
    Case 100                 '商品模块填加刷新
       mydata.rsrs商品表.Requery
       With buyreg.buygd
           Set .DataSource = mydata
           .DataMember = "rs商品表"
           .Refresh
        End With
    
    Case 101                 '商品模块填加刷新
       mydata.rsrs商家表.Requery
       With sbreg.buygd
           Set .DataSource = mydata
           .DataMember = "rs商家表"
           .Refresh
        End With
    Case 102                 '购模块填加刷新
       mydata.rsrs购表.Requery
       With bsreg.buygd
           Set .DataSource = mydata
           .DataMember = "rs购表"
           .Refresh
        End With
                
    Case 103                 '销模块填加刷新
       mydata.rsrs销表.Requery