sales.cls

VB示例源码 VB source code,very important.good,download VB source code,very important.good,download

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Sales"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim sngPubRevenue() As Single     ' 月收入总计数组
Dim sngAuthorRoyalty() As Single  ' 月版权总计数组
Dim sngBookPrice() As Single        ' 月书定价数组

Public Function GetAuthors() As ADODB.Recordset
'返回所知作者的完全列表，作为一项服务提供给客户
'以至于他们不需要知道如何或从哪里获得这些数据。这样
'它将形成一个 "数据服务"。  通常, 数据服务将从商务
'服务群组中分离出来，有助于对立地进行开发及维护。
    Dim strSQL As String
    
    strSQL = "SELECT Authors.Author FROM Authors"
    Set rsAuthors = New ADODB.Recordset
    With rsAuthors
      .CursorLocation = adUseClient
      .Open strSQL, gCN, adOpenStatic, adLockReadOnly
    End With
   Set GetAuthors = rsAuthors
End Function

Public Function GetTitles(ByVal strSQL As String) As ADODB.Recordset
   ' 从客户端使用查询传递来获得标题
   Set rsTitles = New ADODB.Recordset
   With rsTitles
      .CursorLocation = adUseClient
      .Open strSQL, gCN, adOpenStatic, adLockReadOnly
   End With
   Set GetTitles = rsTitles
End Function
Public Function GetBookPages(ByVal strSQL As String) As ADODB.Recordset
   ' 从客户端使用查询传递来获得书的页数
   Set rsBookPages = New ADODB.Recordset
   With rsBookPages
      .CursorLocation = adUseClient
      .Open strSQL, gCN, adOpenStatic, adLockReadOnly
   End With
   Set GetBookPages = rsBookPages

End Function
Public Function GetRsCOGS(ByVal strSQL As String) As ADODB.Recordset
   ' 从客户端使用查询传递来获得 COGS 数
   Set rsCOGS = New ADODB.Recordset
   With rsCOGS
      .CursorLocation = adUseClient
      .Open strSQL, gCN, adOpenStatic, adLockReadOnly
   End With
   Set GetRsCOGS = rsCOGS
End Function

Public Function GetRevenue(intSalesModel As Integer, _
                              curCostPerUnit As Currency, _
                              curAdvCost As Currency, _
                              intSalesPeriod As Integer, _
                              lngUnitsPerMonth As Long, _
                              bolIsDiscount As Boolean, _
                              strBookTitle As String) As Variant

  Dim i As Integer
  Dim iOldBound As Integer
  Dim iNewBound As Integer

  gintSalesModel = intSalesModel
  gcurCostPerUnit = curCostPerUnit
  gcurAdvertisingCost = curAdvCost
  gintSalesPeriod = intSalesPeriod
  glngUnitsPerMonth = lngUnitsPerMonth
  
  If GetPubRevenue(strBookTitle) = False Then
      ServerMsg Error$ & " - " & Str$(Err), vbOKOnly, "获得数据图表错误"
    GetRevenue = 0
    Exit Function
  
  End If

  If GetAuthorRoyalty() = False Then
      ServerMsg Error$ & " - " & Str$(Err), vbOKOnly, "获得数据图表错误"
    GetRevenue = 0
    Exit Function

  End If

  iOldBound = UBound(sngPubRevenue)

  For i = 0 To iOldBound
    sngPubRevenue(i, 1) = sngAuthorRoyalty(i)
  
  Next i

  GetRevenue = sngPubRevenue()

End Function

Public Function GetAuthorRoyalty() As Boolean
Dim i As Integer

Dim cGrossMonthlySalary As Currency
Dim cTaxAmount As Currency
Dim cTotalRevenue As Currency

'创建对 Tax 类的引用
Dim objTax As New Taxes

frmBookSales.lblStatus(1).Caption = "要求作者的版权..."

ReDim sngAuthorRoyalty(gintSalesPeriod)

  For i = 0 To (gintSalesPeriod - 1)
    cGrossMonthlySalary = sngPubRevenue(i, 0) * gRoyalty
    sngAuthorRoyalty(i) = cGrossMonthlySalary - _
                                    objTax.CalcNationalIncomeTax(cGrossMonthlySalary) - _
                                    objTax.CalcSalesTax(cGrossMonthlySalary, 0)

  Next i

  ' 删除类引用
  Set objTax = Nothing
  
  frmBookSales.lblStatus(1).Caption = "考虑作者的版权..."
  GetAuthorRoyalty = True

End Function

Public Function GetPubRevenue(strTitle As String) As Variant
Dim sn As ADODB.Recordset

Dim strSQL As String
Dim i As Integer
Dim Price As Currency

'创建类引用
Dim objModel As New Model

Static strOldTitle As String
Static cUnitPrice As Currency

frmBookSales.lblStatus(0).Caption = "要求发行商的收入..."
frmBookSales.lblStatus(1).Caption = "计算发行商的收入..."

On Error GoTo GetRevenueError

If strTitle <> strOldTitle Then
  frmBookSales.lblStatus(1).Caption = "取得行 " & strTitle & "..."
  strSQL = "SELECT Titles.Price " & _
                "FROM Titles " & _
                "WHERE ((Titles.Title=" & Chr$(34) & strTitle & Chr$(34) & "));"
    ' 初始化 ADODB 记录集变量, 并且用全局连接对象 gCN 来打开它。
  Set sn = New ADODB.Recordset
  sn.Open strSQL, gCN, adOpenForwardOnly, adLockReadOnly
  '设置 sn = gdb.OpenRecordset(strSQL, dbOpenSnapshot)
  cUnitPrice = sn.Fields("Price")
  
Else
  frmBookSales.lblStatus(1).Caption = "使用最后的值..."
  
End If

ReDim sngPubRevenue(gintSalesPeriod - 1, 1)
ReDim sngBookPrice(gintSalesPeriod - 1)

For i = 0 To gintSalesPeriod - 1
   sngPubRevenue(i, 0) = cUnitPrice * _
                          objModel.intGetMonthSales(i, _
                          gintSalesPeriod, _
                          gintSalesModel)
Next i

'删除类引用
Set objModel = Nothing

frmBookSales.lblStatus(1).Caption = "发送发行商收入到客户..."
GetPubRevenue = True

' 如果还没有创建快照，则不要试图关闭这个对象。
' 当 strTitle = strOldTitle 时 sn 还没有被定义。
  If strTitle <> strOldTitle Then
    sn.Close
    Set sn = Nothing
  End If

  strOldTitle = strTitle

  Exit Function
  If IsObject(sn) Then sn.Close
  Set sn = Nothing

GetRevenueError:
  frmBookSales.lblStatus(1).Caption = Error$ & " - " & Str$(Err)
  GetPubRevenue = False
  
End Function

Private Sub Class_Initialize()
' 类被客户立即地初始化。

On Error GoTo InitErr
    
  If gintInstanceCount = 0 Then
    frmBookSales.Show
    gintInstanceCount = 0
  ' 创建全局 ADODB 连接, 设置连接字符串，并且打开它。
    LoadDB
    frmBookSales.lblStatus(1).Caption = "正在打开 " & gDBName & "..."
  
    frmBookSales.lblStatus(1).Caption = "正在等待命令..."
  End If
    
  gintInstanceCount = gintInstanceCount + 1
  frmBookSales.lblInstanceCount.Caption = Format$(gintInstanceCount)

  Exit Sub

InitExit:
    Screen.MousePointer = vbDefault
Exit Sub
  
InitErr:
  
  frmBookSales.lblStatus(1).Caption = Error$ & " - " & Str$(Err)
  
  If Err.Number <> 0 Then ' another error
      ServerMsg Error$ & " - " & Str$(Err), vbCritical, "图书销售服务器启动错误"
      End
  End If
  
  Resume InitExit
  
End Sub
Private Sub LoadDB()
  ' 加在 booksale.mdb。如果文件不在指定的目录中
  ' 提供标准对话框，让最终用户来查找此文件。
   
   gDBName = "booksale.mdb"
   On Error GoTo LoadDBError
   Set gCN = New ADODB.Connection ' 全局连接对象。

   ' 为连接对象设置连接字符串。
   gCN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
   Left(App.Path, Len(App.Path) - Len("client")) & gDBName
   gCN.Open ' 打开连接。
  
  Exit Sub
LoadDBError:
   Select Case Err.Number
   Case -2147467259
      ' 不能找到文件, 使用标准对话框来查找它。
      gCN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
      GetBooksale
      Resume
   Case Else ' 其他未知的错误
       MsgBox Err.Number & ": " & Err.Description
   End Select
End Sub

Private Function GetBooksale() As String
   ' 返回 booksale.mdb 的路径。
   ' 如果 booksale.mdb 不在默认的位置,
   ' 为最终用户提供标准对话框，
   ' 提示用户来查找数据库。
    On Error GoTo ErrHandler

   With frmBookSales.dlgFindDB
      .DialogTitle = "请查找 Booksale.mdb"
      .InitDir = App.Path
      .FileName = gDBName
      .Filter = "Access (*.mdb)| *.mdb"
      .CancelError = True '如果用户选择取消将导致一个错误。
      .ShowOpen
   End With
    
   Do While UCase(Right(Trim(frmBookSales.dlgFindDB.FileName), Len("booksale.mdb"))) <> "BOOKSALE.MDB"
         MsgBox "不存在与 BOOKSALE.MDB 符合的文件名"
         frmBookSales.dlgFindDB.ShowOpen
   Loop
   
   GetBooksale = frmBookSales.dlgFindDB.FileName
   Exit Function
ErrHandler:
    If Err = 32755 Then '取消将导致错误。
      End
    End If
End Function

Private Sub Class_Terminate()
  gintInstanceCount = gintInstanceCount - 1
  frmBookSales.lblInstanceCount.Caption = Format$(gintInstanceCount)
  
  If gintInstanceCount <= 0 Then
    Unload frmBookSales
  End If
End Sub