frmcogs.frm

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

         Index           =   5
         Left            =   1725
         TabIndex        =   20
         Top             =   960
         Width           =   60
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "页"
         ForeColor       =   &H00800000&
         Height          =   255
         Index           =   4
         Left            =   450
         TabIndex        =   19
         Top             =   960
         Width           =   615
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "+"
         ForeColor       =   &H00800000&
         Height          =   195
         Index           =   2
         Left            =   1725
         TabIndex        =   17
         Top             =   480
         Width           =   90
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "纸张级别"
         ForeColor       =   &H00800000&
         Height          =   255
         Index           =   1
         Left            =   60
         TabIndex        =   16
         Top             =   480
         Width           =   1005
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "图片颜色"
         ForeColor       =   &H00800000&
         Height          =   255
         Index           =   0
         Left            =   60
         TabIndex        =   15
         Top             =   270
         Width           =   1005
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "___________________"
         ForeColor       =   &H00800000&
         Height          =   195
         Index           =   3
         Left            =   105
         TabIndex        =   18
         Top             =   540
         Width           =   1710
      End
   End
End
Attribute VB_Name = "frmCogs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim lRetVal As Long

' 这些变量储存用户选定的当前 COGS 值。
Dim cBindingCost As Currency
Dim cPicture As Currency
Dim cPaperGrade As Currency
Dim lngNumPages As Long

Dim strBinding As String
Dim strPicture As String
Dim strPaper As String

Dim acurBindingCost(1) As Currency
Dim acurPictureCost(1) As Currency
Dim acurPaperCost(3) As Currency
Dim acurCogs(5) As Currency
Private Sub optPicColor_Click(Index As Integer)
If Index = 0 Then
  ' 黑白
  strPicture = "BW"
Else
  ' 彩色
  strPicture = "Color"
End If
  
acurCogs(0) = acurPictureCost(Index)
lblCost(0).Caption = Format$(acurCogs(0), "#.0000")

CalcUnitCost

End Sub

Private Sub Command1_Click(Index As Integer)
  Dim sHelpString As String
  
  Select Case Index
    Case 0  ' 保存
      frmRevenue.txtRevParm(0).Text = strBinding & ", " & strPicture & ", " & strPaper
      frmRevenue.txtRevParm(0).Tag = lblCost(6).Caption
      Unload Me
      
    Case 1  ' 帮助
      sHelpString = "选择所要求的装订类型, 图片类型, 以及纸张质量" & vbCrLf & _
                    "单击 <保存> 保存这些值并且返回到图书收入窗体。" & vbCrLf & _
                     "单击 <取消> 放弃这些值并且返回到图书收入窗题。"
                    
      lRetVal = MsgBox(prompt:=sHelpString, Title:="COGS 帮助", Buttons:=vbInformation)
      
    Case 2  '关闭
      Unload Me
      
 End Select
      
End Sub
Sub CalcUnitCost()
  Dim curTemp As Currency
    
  curTemp = acurCogs(0) + acurCogs(1)
  lblCost(2).Caption = Format$(curTemp, "#.0000")
  
  curTemp = curTemp * lngNumPages
  lblCost(4).Caption = Format$(curTemp, "#.0000")
  
  curTemp = curTemp + acurCogs(5)
  lblCost(6).Caption = Format$(curTemp, "#.0000")
  
End Sub
Function GetCOGS() As Integer
  Dim fld As Field
  Dim strSQL As String
  Dim rsCOGS As ADODB.Recordset
  On Error GoTo GetCOGSError
  
  goStatusPanel.Text = "正在取得 COGS 数..."
  strSQL = "SELECT * FROM COGS"
           
  Set rsCOGS = gobjServer.GetRsCOGS(strSQL)
  
  
  
  acurBindingCost(0) = rsCOGS.Fields("HardCover")
  acurBindingCost(1) = rsCOGS.Fields("PaperBack")
  acurPictureCost(0) = rsCOGS.Fields("BlackWhite")
  acurPictureCost(1) = rsCOGS.Fields("Color")
  acurPaperCost(0) = rsCOGS.Fields("Grade1")
  acurPaperCost(1) = rsCOGS.Fields("Grade2")
  acurPaperCost(2) = rsCOGS.Fields("Grade3")
  acurPaperCost(3) = rsCOGS.Fields("Grade4")

  rsCOGS.Close
  
  GetCOGS = True
  Exit Function
  
GetCOGSError:
  If IsObject(gSn) Then gSn.Close
  GetCOGS = False
    
End Function

Public Function GetBookPages(strTitle As String) As Long
   Dim strSQL As String
   Dim rsBookPages As ADODB.Recordset
   Static strOldTitle As String
   Static lngPages As Long

   On Error GoTo GetBookPagesError

   If strTitle <> strOldTitle Then
     frmRevenue.sbrRev.Panels(1).Text = "检索 " & strTitle & "的页数..."
     strSQL = "SELECT Titles.Pages " & _
              "FROM Titles " & _
              "WHERE ((Titles.Title=" & Chr$(34) & Trim$(strTitle) & Chr$(34) & "));"
  
      
  Set rsBookPages = gobjServer.GetBookPages(strSQL)
  
  lngPages = rsBookPages.Fields("Pages")
  strOldTitle = strTitle
  rsBookPages.Close
  
Else
  goStatusPanel.Text = "使用缓存的页数"

End If

GetBookPages = lngPages

Exit Function

GetBookPagesError:
  If IsObject(rsBookPages) Then rsBookPages.Close
  GetBookPages = False
  MsgBox Error$ & Str$(Err), vbCritical, "获得书的页数错误"

End Function

Private Sub Form_Load()
  Me.Left = (Screen.Width - Me.Width) / 2
  Me.Top = (Screen.Height - Me.Height) / 2
  Me.Show
  DoEvents
  
  lngNumPages = GetBookPages(frmRevenue.cboBooks.Text)
  lRetVal = GetCOGS
  
  lblCost(0).Caption = Format$(acurPictureCost(0), "#.0000")
  acurCogs(0) = acurPictureCost(0)
  
  lblCost(1).Caption = Format$(acurPaperCost(0), "#.0000")
  acurCogs(1) = acurPaperCost(0)
  
  lblCost(3).Caption = Str$(lngNumPages)
  
  lblCost(5).Caption = Format$(acurBindingCost(0), "#.0000")
  acurCogs(5) = acurBindingCost(0)
  
  strBinding = "Hard"
  strPicture = "BW"
  strPaper = "1"
  CalcUnitCost
  DoEvents
  
End Sub

Private Sub optBinding_Click(Index As Integer)
  If Index = 0 Then
    strBinding = "Hard"
    
  Else
    strBinding = "Paper"
    
  End If
  
  acurCogs(5) = acurBindingCost(Index)
  lblCost(5).Caption = Format$(acurCogs(5), "#.0000")
  
  If optPaperGrade(0).Value Then
    optPaperGrade_Click (0)
  
  ElseIf optPaperGrade(0).Value Then
    optPaperGrade_Click (1)
    
  ElseIf optPaperGrade(2).Value Then
    optPaperGrade_Click (2)
    
  Else
    optPaperGrade_Click (3)
    
  End If

  CalcUnitCost
  
End Sub

Private Sub optPaperGrade_Click(Index As Integer)
  
  Select Case Index
    Case 0
      strPaper = "1"
      
    Case 1
      strPaper = "2"
      
    Case 2
      strPaper = "3"

    Case 3
      strPaper = "4"
      
  End Select
 
  
  If optBinding(1).Value = True Then
    acurCogs(1) = acurPaperCost(Index) * 0.5
      
  Else
    acurCogs(1) = acurPaperCost(Index)
    
  End If
  
  lblCost(1).Caption = Format$(acurCogs(1), "#.0000")
  CalcUnitCost
  
End Sub