frmaddedit.frm

功能强大的 DBF 数据库操作 dll,可以让 VB 和 POWERBASIC 调用

VERSION 5.00
Begin VB.Form frmAddEdit 
   Caption         =   "Add/Edit Record"
   ClientHeight    =   3555
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   4785
   LinkTopic       =   "Form1"
   ScaleHeight     =   3555
   ScaleWidth      =   4785
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   396
      Left            =   2484
      TabIndex        =   4
      Top             =   2976
      Width           =   972
   End
   Begin VB.CommandButton cmdOkay 
      Caption         =   "Okay"
      Height          =   396
      Left            =   1344
      TabIndex        =   3
      Top             =   2976
      Width           =   972
   End
   Begin VB.TextBox txtAcctName 
      Height          =   288
      Left            =   1356
      TabIndex        =   1
      Top             =   948
      Width           =   3240
   End
   Begin VB.TextBox txtNotes 
      Height          =   1440
      Left            =   1356
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   1332
      Width           =   3240
   End
   Begin VB.TextBox txtAcctNum 
      Height          =   300
      Left            =   1356
      TabIndex        =   0
      Top             =   564
      Width           =   1620
   End
   Begin VB.Label lblAddEdit 
      Alignment       =   1  'Right Justify
      Caption         =   "Add/Edit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   264
      Left            =   3660
      TabIndex        =   9
      Top             =   120
      Width           =   900
   End
   Begin VB.Label lblRecordNumber 
      Caption         =   "Record#:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   264
      Left            =   1356
      TabIndex        =   8
      Top             =   144
      Width           =   1644
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      Caption         =   "Notes:"
      Height          =   216
      Left            =   312
      TabIndex        =   7
      Top             =   1368
      Width           =   888
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "Name:"
      Height          =   252
      Left            =   108
      TabIndex        =   6
      Top             =   960
      Width           =   1092
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Account #:"
      Height          =   216
      Left            =   228
      TabIndex        =   5
      Top             =   576
      Width           =   972
   End
End
Attribute VB_Name = "frmAddEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'record number being added/edited
Dim RecordNumber As Long
Dim DBFhandle As Long
Dim EDITLOCK As Long



Private Sub cmdCancel_Click()
    Unload Me
End Sub


Public Sub AddRecord()
    'the new record will be appended
    lblAddEdit.Caption = "Add"
    DBFhandle = frmMain.gDBFhandle
    

End Sub


Public Sub EditRecord()

    
    'ask for a record number to edit
    lblAddEdit.Caption = "Edit"
    DBFhandle = frmMain.gDBFhandle
    
    RecordNumber = InputBox("Enter Record Number to Edit:", "Edit Record")
    
    'determine if the record exists. If it does then place an edit
    'lock on it. If it does not exist then simply switch to "Add" mode.
    If RecordNumber > 0 And RecordNumber <= xdbRecordCount(DBFhandle) Then
       
       'place the lock
       EDITLOCK = xdbSetEditLock(DBFhandle, RecordNumber)
       
        
       'see if there is an error trying to place the edit lock. An error
       'will occur if an edit lock is already in place for this record.
       If xdbError = RECORD_BUSY Then
       
          Call xdbFailedLockInfo(DBFhandle, Reason$, Username$, Workstation$, LockDate$, LockTime$)
          msg$ = "Record " & Str$(RecordNumber) & " is currently in use by " & Username$ & " " & _
                  Workstation$ & " at " & LockDate$ & " " & LockTime$ & vbCrLf & "Reason: " & Reason$
                  
          MsgBox msg$
          
          'IMPORTANT - reset the error code so Cheetah will not choke on
          'future functions.
          Call xdbResetError
          
          'set caption to flag that we "Add" instead of edit (can not edit because the
          'record is in use).
          lblAddEdit.Caption = "Add"
       Else
          Call xdbGetRecord(DBFhandle, RecordNumber)
       
          'put the record information into the text fields
          txtAcctNum.Text = xdbFieldValue(DBFhandle, "ACCTNUM", 0)
          txtAcctName.Text = xdbFieldValue(DBFhandle, "ACCTNAME", 0)
          txtNotes.Text = xdbFieldValue(DBFhandle, "NOTES", 0)
       End If
    
    Else
       lblAddEdit.Caption = "Add"
    End If
    
    
End Sub

Private Sub cmdOkay_Click()

    'save the data to the database fields and then
    'put the information into the database.
    
    
    Select Case UCase(lblAddEdit.Caption)
       Case "ADD"
          Call xdbClearBuffer(DBFhandle)
          GoSub SaveFields
          Call xdbAddRecord(DBFhandle)
          
          With frmMain
             .lblNumRecords.Caption = "Number of Records:" & Str$(xdbRecordCount(DBFhandle))
             .lblMessage.Caption = "Record Added."
          End With
          
       Case "EDIT"
          GoSub SaveFields
          
          MsgBox "Saving to previous record:" & RecordNumber
          
          Call xdbPutRecord(DBFhandle, RecordNumber)
          
          With frmMain
             .lblNumRecords.Caption = "Number of Records:" & Str$(xdbRecordCount(DBFhandle))
             .lblMessage.Caption = "Record Edited."
          End With
          
          'release the edit lock
          Call xdbRemoveEditLock(DBFhandle, EDITLOCK)
       
    End Select
    
    'unload the Add/Edit form and return to the main form
    Unload Me
    
    Exit Sub
    

SaveFields:

    Call xdbAssignField(DBFhandle, "ACCTNUM", 0, txtAcctNum.Text)
    Call xdbAssignField(DBFhandle, "ACCTNAME", 0, txtAcctName.Text)
    Call xdbAssignField(DBFhandle, "NOTES", 0, txtNotes.Text)

    Return
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    'VERY IMPORTANT - if an edit lock is active then make sure we
    'remove it before the form closes!
    
    'release the edit lock
     Call xdbRemoveEditLock(DBFhandle, EDITLOCK)

End Sub