Using Visual Basic 5 (Platinum Edition)

home *** CD-ROM | disk | FTP | other *** search

/ Using Visual Basic 5 (Platinum Edition) / vb5.iso / Code / ch12 / Invoices.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1997-06-15 | 19.3 KB | 568 lines

VERSION 5.00 Begin VB.Form Form1 Caption = "Invoices" ClientHeight = 6285 ClientLeft = 60 ClientTop = 345 ClientWidth = 8475 LinkTopic = "Form1" ScaleHeight = 6285 ScaleWidth = 8475 StartUpPosition = 3 'Windows Default Begin VB.CommandButton cmdDeleteItem Caption = "Delete Item" Height = 315 Left = 1680 TabIndex = 21 Top = 5760 Width = 1455 End Begin VB.CommandButton cmdAddItem Caption = "Add Item" Default = -1 'True Height = 315 Left = 120 TabIndex = 20 Top = 5760 Width = 1455 End Begin VB.Frame Frame1 Caption = "Invoice Details" Height = 3615 Left = 120 TabIndex = 22 Top = 2040 Width = 8175 Begin VB.CheckBox chkBackorder Height = 315 Index = 1 Left = 7560 TabIndex = 19 Top = 720 Width = 255 End Begin VB.TextBox txtUnitPrice Height = 315 Index = 1 Left = 4920 TabIndex = 17 Top = 720 Width = 1095 End Begin VB.TextBox txtDescription Height = 315 Index = 1 Left = 2040 TabIndex = 16 Top = 720 Width = 2895 End Begin VB.ComboBox cboProductID Height = 315 Index = 1 Left = 720 TabIndex = 15 Top = 720 Width = 1335 End Begin VB.TextBox txtQty Height = 315 Index = 1 Left = 120 TabIndex = 14 Top = 720 Width = 615 End Begin VB.Label lblTotal Alignment = 1 'Right Justify BackColor = &H80000005& BorderStyle = 1 'Fixed Single Height = 315 Index = 1 Left = 6000 TabIndex = 18 Top = 720 Width = 1215 End Begin VB.Label lblColumn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Backorder" Height = 300 Index = 6 Left = 7200 TabIndex = 29 Top = 360 Width = 855 End Begin VB.Label lblColumn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Total " Height = 300 Index = 5 Left = 6000 TabIndex = 27 Top = 360 Width = 1215 End Begin VB.Label lblColumn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Unit Price " Height = 300 Index = 4 Left = 4920 TabIndex = 26 Top = 360 Width = 1095 End Begin VB.Label lblColumn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = " Description" Height = 300 Index = 3 Left = 2040 TabIndex = 25 Top = 360 Width = 2895 End Begin VB.Label lblColumn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = " Product ID" Height = 300 Index = 2 Left = 720 TabIndex = 24 Top = 360 Width = 1335 End Begin VB.Label lblColumn Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = " Q.ty" Height = 300 Index = 1 Left = 120 TabIndex = 23 Top = 360 Width = 615 End End Begin VB.TextBox txtHeader Height = 315 Index = 1 Left = 5520 TabIndex = 3 Top = 120 Width = 1095 End Begin VB.TextBox txtHeader Height = 315 Index = 0 Left = 1920 TabIndex = 1 Top = 120 Width = 1215 End Begin VB.TextBox Text5 Height = 315 Left = 7680 TabIndex = 13 Top = 1560 Width = 615 End Begin VB.TextBox txtHeader Height = 315 Index = 5 Left = 5520 TabIndex = 11 Top = 1560 Width = 1095 End Begin VB.TextBox txtHeader Height = 315 Index = 4 Left = 1920 TabIndex = 9 Top = 1560 Width = 2535 End Begin VB.TextBox txtHeader Height = 315 Index = 3 Left = 1920 TabIndex = 7 Top = 1080 Width = 6375 End Begin VB.TextBox txtHeader Height = 315 Index = 2 Left = 1920 TabIndex = 5 Top = 600 Width = 6375 End Begin VB.Label lblGrandTotal Alignment = 1 'Right Justify BackColor = &H80000005& BorderStyle = 1 'Fixed Single Height = 315 Left = 6120 TabIndex = 30 Top = 5760 Width = 1335 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "Grand Total " Height = 315 Index = 13 Left = 4800 TabIndex = 28 Top = 5760 Width = 1335 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "&Date " Height = 315 Index = 6 Left = 4560 TabIndex = 2 Top = 120 Width = 855 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "&Invoice No. " Height = 315 Index = 5 Left = 240 TabIndex = 0 Top = 120 Width = 1575 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "&State " Height = 315 Index = 4 Left = 6720 TabIndex = 12 Top = 1560 Width = 855 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "&ZIP code " Height = 315 Index = 3 Left = 4560 TabIndex = 10 Top = 1560 Width = 855 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "&City " Height = 315 Index = 2 Left = 240 TabIndex = 8 Top = 1560 Width = 1575 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "&Address " Height = 315 Index = 1 Left = 240 TabIndex = 6 Top = 1080 Width = 1575 End Begin VB.Label Label1 Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single Caption = "Customer &Name " Height = 315 Index = 0 Left = 240 TabIndex = 4 Top = 600 Width = 1575 End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Type TProductInfo ID As String Description As String UnitPrice As Currency End Type ' max number of detail lines in the invoice Const LINES_MAX = 8 ' this array holds information on each product Const PRODUCT_NUM = 10 Dim ProductInfo() As TProductInfo ' this variable tracks which line the cursor is currently on ' zero means that it is on the upper portion of the form Dim currentLine As Integer Private Sub Form_Load() ' load ID, description and price unit for a bunch of products ' (in a real application this information would be loaded ' from a file or a database table) Dim i As Integer ReDim ProductInfo(1 To PRODUCT_NUM) As TProductInfo ProductInfo(1).ID = "Mouse/S" ProductInfo(1).Description = "Serial Mouse" ProductInfo(1).UnitPrice = 39.5 ProductInfo(2).ID = "Mouse/PS2" ProductInfo(2).Description = "Mouse with PS/2 connector" ProductInfo(2).UnitPrice = 49.99 ProductInfo(3).ID = "Modem/I" ProductInfo(3).Description = "Internal 28.800 baud modem" ProductInfo(3).UnitPrice = 105 ProductInfo(4).ID = "Modem/E" ProductInfo(4).Description = "Internal 28.800 baud modem" ProductInfo(4).UnitPrice = 105 ProductInfo(5).ID = "Video/V" ProductInfo(5).Description = "VGA Video Card" ProductInfo(5).UnitPrice = 45 ProductInfo(6).ID = "Video/SV" ProductInfo(6).Description = "Super-VGA Video Card" ProductInfo(6).UnitPrice = 75 ProductInfo(7).ID = "CdRom/6" ProductInfo(7).Description = "CDROM Driver 6x" ProductInfo(7).UnitPrice = 109 ProductInfo(8).ID = "CdRom/12" ProductInfo(8).Description = "CDROM Driver 12x" ProductInfo(8).UnitPrice = 225 ProductInfo(9).ID = "Cable/P" ProductInfo(9).Description = "Parallel Cable" ProductInfo(9).UnitPrice = 7.99 ProductInfo(10).ID = "Cable/S" ProductInfo(10).Description = "Serial Cable" ProductInfo(10).UnitPrice = 7.99 ' load product IDs into the combo box For i = 1 To PRODUCT_NUM cboProductID(1).AddItem ProductInfo(i).ID Next End Sub Private Sub txtHeader_GotFocus(Index As Integer) NewCurrentLine 0 End Sub Private Sub txtQty_GotFocus(Index As Integer) NewCurrentLine Index End Sub Private Sub cboProductID_GotFocus(Index As Integer) NewCurrentLine Index End Sub Private Sub txtDescription_GotFocus(Index As Integer) NewCurrentLine Index End Sub Private Sub txtUnitPrice_GotFocus(Index As Integer) NewCurrentLine Index End Sub Private Sub chkBackorder_GotFocus(Index As Integer) NewCurrentLine Index End Sub Private Sub NewCurrentLine(newLine As Integer) ' set a yellow background for the controls on the ' current line, and white for all the others Dim Index As Integer Dim foColor As Long, bkColor As Long currentLine = newLine For Index = txtQty.LBound To txtQty.UBound If Index = currentLine Then foColor = vbHighlightText bkColor = vbHighlight Else foColor = vbWindowText bkColor = vbWindowBackground End If txtQty(Index).ForeColor = foColor txtQty(Index).BackColor = bkColor cboProductID(Index).ForeColor = foColor cboProductID(Index).BackColor = bkColor txtDescription(Index).ForeColor = foColor txtDescription(Index).BackColor = bkColor txtUnitPrice(Index).ForeColor = foColor txtUnitPrice(Index).BackColor = bkColor lblTotal(Index).ForeColor = foColor lblTotal(Index).BackColor = bkColor ' don't touch checkbox's colors Next End Sub Private Sub cmdAddItem_Click() ' add a new line for Invoice details Dim newLine As Integer Dim lineTop As Single Dim i As Integer newLine = txtQty.UBound + 1 ' exit if too many lines If newLine > LINES_MAX Then Exit Sub ' load all the controls that make up the row ' it is preferable to load all controls *before* acting ' on their properties, because otherwise a change event might ' rise an error since it would refer to a non existing control Load txtQty(newLine) Load cboProductID(newLine) Load txtDescription(newLine) Load txtUnitPrice(newLine) Load lblTotal(newLine) Load chkBackorder(newLine) ' then move controls in the correct position, make ' them visible and clear them lineTop = txtQty(newLine - 1).top + txtQty(newLine - 1).Height ' we don't need to modify the Left property, whose ' value is inherited by the control in the above line txtQty(newLine).top = lineTop txtQty(newLine).Visible = True txtQty(newLine).text = "" cboProductID(newLine).top = lineTop cboProductID(newLine).Visible = True cboProductID(newLine).text = "" txtDescription(newLine).top = lineTop txtDescription(newLine).Visible = True txtDescription(newLine).text = "" txtUnitPrice(newLine).top = lineTop txtUnitPrice(newLine).Visible = True txtUnitPrice(newLine).text = "" lblTotal(newLine).top = lineTop lblTotal(newLine).Visible = True lblTotal(newLine).Caption = "" chkBackorder(newLine).top = lineTop chkBackorder(newLine).Visible = True chkBackorder(newLine).Value = 0 ' load product IDs into the combo box cboProductID(newLine).Clear For i = 1 To PRODUCT_NUM cboProductID(newLine).AddItem ProductInfo(i).ID Next ' set input focus to the Qty textbox DoEvents txtQty(newLine).SetFocus End Sub Private Sub cmdDeleteItem_Click() ' delete the current line Dim Index As Integer Dim lastLine As Integer lastLine = txtQty.UBound ' exit if the cursor is not on a invoce item or if there ' is only one line (these controls are created at design-time ' and cannot be unloaded) If currentLine = 0 Or lastLine = 1 Then Exit Sub ' move all values up one row For Index = currentLine To lastLine - 1 txtQty(Index).text = txtQty(Index + 1).text cboProductID(Index).text = cboProductID(Index + 1).text txtDescription(Index).text = txtDescription(Index + 1).text txtUnitPrice(Index).text = txtUnitPrice(Index + 1).text lblTotal(Index).Caption = lblTotal(Index + 1).Caption chkBackorder(Index).Value = chkBackorder(Index + 1).Value Next ' clear the lblTotal value for the last line ' (this forces the evaluation of grand total) lblTotal(lastLine).Caption = "" ' if we are about to delete the control that has the ' input focus, move the focus elsewhere If currentLine = lastLine Then txtQty(lastLine - 1).SetFocus End If ' unload the last line of controls Unload txtQty(lastLine) Unload cboProductID(lastLine) Unload txtDescription(lastLine) Unload txtUnitPrice(lastLine) Unload lblTotal(lastLine) Unload chkBackorder(lastLine) End Sub Private Sub cboProductID_Click(Index As Integer) ' the user has selected a product Dim i As Integer i = cboProductID(Index).ListIndex If i >= 0 Then txtDescription(Index).text = ProductInfo(i + 1).Description txtUnitPrice(Index).text = Format$(ProductInfo(i + 1).UnitPrice, "###.00") End If End Sub Private Sub txtQty_Change(Index As Integer) UpdateLineTotal Index End Sub Private Sub txtUnitPrice_Change(Index As Integer) UpdateLineTotal Index End Sub Private Sub UpdateLineTotal(Index As Integer) ' update the total value of current line If txtQty(Index).text <> "" And txtUnitPrice(Index).text <> "" Then lblTotal(Index).Caption = Format$(CCur(txtQty(Index).text) * CCur(txtUnitPrice(Index).text), "###,###.00") Else lblTotal(Index).Caption = "" End If End Sub Private Sub lblTotal_Change(Index As Integer) ' update the grand total Dim i As Integer, result As Currency For i = lblTotal.LBound To lblTotal.UBound If lblTotal(i).Caption <> "" Then result = result + CCur(lblTotal(i).Caption) End If Next lblGrandTotal.Caption = Format$(result, "###,###.00") End Sub Private Sub txtHeader_KeyPress(Index As Integer, KeyAscii As Integer) ' ensure that numeric fields only get numeric keys If KeyAscii < 32 Then Exit Sub Select Case Index Case 0, 5 ' Invoice number & ZIP code If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 Case 1 ' invoce date If (KeyAscii < 48 Or KeyAscii > 57) Then If KeyAscii <> Asc("/") Then KeyAscii = 0 End If End Select ' protest loudly If KeyAscii = 0 Then Beep End Sub Private Sub txtQty_KeyPress(Index As Integer, KeyAscii As Integer) ' ignore non-numeric input If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii >= 32 Then KeyAscii = 0 Beep End If End Sub Private Sub txtUnitPrice_KeyPress(Index As Integer, KeyAscii As Integer) ' ignore non-numeric input, but accept decimal separator If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii >= 32 And KeyAscii <> Asc(".") Then KeyAscii = 0 Beep End If End Sub Private Sub lblColumn_Click(Index As Integer) ' change the header of this column Dim newCaption As String newCaption = InputBox$("Enter a new label for this column", "My Grid", lblColumn(Index).Caption) If newCaption <> "" Then lblColumn(Index).Caption = newCaption End If End Sub