home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
browse_1
/
frmcat.frm
< prev
next >
Wrap
Text File
|
1993-07-19
|
10KB
|
337 lines
VERSION 2.00
Begin Form frmCatalog
BorderStyle = 1 'Fixed Single
Caption = "Catalog Database"
ClientHeight = 6444
ClientLeft = 876
ClientTop = 1296
ClientWidth = 7284
ControlBox = 0 'False
Height = 6780
Left = 828
LinkTopic = " "
MaxButton = 0 'False
ScaleHeight = 6444
ScaleWidth = 7284
Top = 1008
Width = 7380
Begin CommandButton comExit
Caption = "E&xit"
Height = 252
Left = 5880
TabIndex = 18
Top = 6120
Width = 1332
End
Begin CommandButton comDelete
Caption = "&Delete "
Height = 372
Left = 5760
TabIndex = 17
Top = 840
Width = 1452
End
Begin CommandButton comNew
Caption = "&Add New"
Height = 372
Left = 5760
TabIndex = 16
Top = 480
Width = 1452
End
Begin CommandButton comUpdate
Caption = "&Update"
Enabled = 0 'False
Height = 372
Left = 5760
TabIndex = 15
Top = 120
Width = 1452
End
Begin TextBox txtEdt
DataField = "TYPE"
DataSource = "dtaCatalog"
Enabled = 0 'False
Height = 288
Index = 6
Left = 4200
MaxLength = 4
TabIndex = 14
Top = 840
Width = 1332
End
Begin TextBox txtEdt
DataField = "CODE"
DataSource = "dtaCatalog"
Enabled = 0 'False
Height = 288
Index = 5
Left = 4200
MaxLength = 4
TabIndex = 12
Top = 480
Width = 1332
End
Begin TextBox txtEdt
DataField = "GROUP"
DataSource = "dtaCatalog"
Enabled = 0 'False
Height = 288
Index = 4
Left = 4200
MaxLength = 4
TabIndex = 10
Top = 120
Width = 1332
End
Begin TextBox txtEdt
DataField = "DESCR"
DataSource = "dtaCatalog"
Height = 288
Index = 3
Left = 1800
MaxLength = 50
TabIndex = 8
Top = 1320
Width = 5412
End
Begin TextBox txtEdt
DataField = "LIST"
DataSource = "dtaCatalog"
Height = 288
Index = 2
Left = 1800
MaxLength = 12
TabIndex = 6
Top = 840
Width = 1332
End
Begin TextBox txtEdt
DataField = "CATNO"
DataSource = "dtaCatalog"
Height = 288
Index = 1
Left = 1800
MaxLength = 15
TabIndex = 4
Top = 480
Width = 1332
End
Begin TextBox txtEdt
DataField = "SYSNO"
DataSource = "dtaCatalog"
Height = 288
Index = 0
Left = 1800
MaxLength = 6
TabIndex = 2
Top = 120
Width = 1092
End
Begin TBrowse Brw
BorderStyle = 0 'None
DataSource = "dtaCatalog"
Height = 4332
Left = 120
TabIndex = 0
Top = 1680
Width = 7092
End
Begin Data dtaCatalog
Caption = "Catalog Table Data Control"
Connect = ""
DatabaseName = "C:\VB\CDK\BRWA\DEMO\DEMO.MDB"
Exclusive = 0 'False
Height = 252
Left = 120
Options = 0
ReadOnly = 0 'False
RecordSource = "CATALOG"
Top = 6120
Width = 5532
End
Begin Label Label1
Caption = "&Type:"
Height = 252
Index = 6
Left = 3240
TabIndex = 13
Top = 840
Width = 852
End
Begin Label Label1
Caption = "C&ode:"
Height = 252
Index = 5
Left = 3240
TabIndex = 11
Top = 480
Width = 852
End
Begin Label Label1
Caption = "&Group:"
Height = 252
Index = 4
Left = 3240
TabIndex = 9
Top = 120
Width = 852
End
Begin Label Label1
Caption = "D&escription"
Height = 252
Index = 3
Left = 120
TabIndex = 7
Top = 1320
Width = 1572
End
Begin Label Label1
Caption = "&List price:"
Height = 252
Index = 2
Left = 120
TabIndex = 5
Top = 840
Width = 1572
End
Begin Label Label1
Caption = "&Catalog number:"
Height = 252
Index = 1
Left = 120
TabIndex = 3
Top = 480
Width = 1572
End
Begin Label Label1
Caption = "&Number:"
Height = 252
Index = 0
Left = 120
TabIndex = 1
Top = 120
Width = 1572
End
End
Option Explicit
' lInitialize is required as a one time flag,
' see form_activate() for details
Dim lInitialize As Integer
Sub Brw_EditValid (nCol As Integer, cField As String, lOk As Integer)
' Edit validations, we need to check the primary key - SYSNO
' and the list price
If nCol = 0 Then
' SYSNO must be non-zero and positive
If Trim$(cField) = "" Or Val(cField) <= 0 Then
MsgBox "Wrong primary key!"
lOk = False
End If
ElseIf nCol = 5 Then
' List price must be positive or zero
If Val(cField) < 0 Then
MsgBox "Wrong list price!"
lOk = False
End If
End If
End Sub
Sub comDelete_Click ()
' delete current record
' IMPORTANT: YOU MUST ISSUE THE REFRESH, OTHERWISE THE CONTROL WILL CRASH!
dtaCatalog.Recordset.Delete
dtaCatalog.Refresh
End Sub
Sub comExit_Click ()
' pseudo-exit, we are just hidding ourselfs
Me.Hide
BrwDemo!comProducts.Enabled = True ' and re-enable the show button
End Sub
Sub comNew_Click ()
' add a new record
dtaCatalog.Recordset.AddNew
' set the read-only fields, we must preserve
' database relations
txtEdt(4).Text = BrwDemo!dtaPrdGroup.Recordset.Fields("GROUP").Value
txtEdt(5).Text = BrwDemo!dtaPrdGroup.Recordset.Fields("CODE").Value
txtEdt(6).Text = BrwDemo!dtaPrdGroup.Recordset.Fields("TYPE").Value
End Sub
Sub comUpdate_Click ()
' we must update explicitly after editing in one
' of the text box bound controls
dtaCatalog.Recordset.Update
comUpdate.Enabled = False
End Sub
Sub Form_Activate ()
Dim cFind As String
' We need to force the data control to refresh
' after the form has been loaded (but not in
' the form_load(), the objects are not yet initialized ).
' This must be done also if the RecordSource
' changes at run-time.
If Not lInitialize Then
lInitialize = True
cFind = "GROUP = '" + BrwDemo!dtaPrdGroup.Recordset.Fields("GROUP").Value + "' and "
cFind = cFind + "CODE = '" + BrwDemo!dtaPrdGroup.Recordset.Fields("CODE").Value + "' and "
cFind = cFind + "TYPE = '" + BrwDemo!dtaPrdGroup.Recordset.Fields("TYPE").Value + "'"
dtaCatalog.Recordset.FindFirst cFind
End If
End Sub
Sub Form_Load ()
' set form position
Me.Top = 0: Me.Left = Screen.Width - Me.Width
' initialize the browse control
Brw.Cols = 7 ' we need 7 columns
' set column width for each
Brw.ColWidth(0) = 6
Brw.ColWidth(1) = 4
Brw.ColWidth(2) = 4
Brw.ColWidth(3) = 4
Brw.ColWidth(4) = 15
Brw.ColWidth(5) = 12
Brw.ColWidth(6) = 50
' set header for each (if is not the default = field name)
Brw.Header(0) = "Sysno"
Brw.Header(1) = "Group"
Brw.Header(2) = "Code"
Brw.Header(3) = "Type"
Brw.Header(4) = "Catalog no"
Brw.Header(5) = "List price"
Brw.Header(6) = "Description"
' set the data field for each column
Brw.ColField(0) = "SYSNO"
Brw.ColField(1) = "GROUP"
Brw.ColField(2) = "CODE"
Brw.ColField(3) = "TYPE"
Brw.ColField(4) = "CATNO"
Brw.ColField(5) = "LIST"
Brw.ColField(6) = "DESCR"
' enable editing for the ones we want
Brw.ColEdit(0) = True
Brw.ColEdit(4) = True
Brw.ColEdit(5) = True
Brw.ColEdit(6) = True
Brw.LeftFrozen = 1 ' freeze the SYSNO to the left
Brw.SpcColor(5) = True ' set the LIST column to a special color
End Sub
Sub txtEdt_Change (Index As Integer)
' enable the Update button if the user has changed something
If HasFocus(txtEdt(Index)) And Not comUpdate.Enabled Then comUpdate.Enabled = True
End Sub