PC World Komputer 1997 February/PCWK0297.iso/envelop/envelop.5/Tools/Bootcamp/advanced/dbsample/dbsample.eto

Text File | 1996-07-08 | 16KB | 527 lines

Type datasamp From Application
  Dim AccessControl As New ACL
End Type

Type OptionGroupMaster
  Type Buttons From Form
    Property Value Get getValue Set setValue As String
    Dim OptButton1 As New OptionGroupMaster.OptButton
    Dim OptButton2 As New OptionGroupMaster.OptButton
    Dim OptButton3 As New OptionGroupMaster.OptButton

    ' METHODS for object: OptionGroupMaster.Buttons
    Sub AddValue(codex as String, Caption As String)
      dim newobj as OptionGroupMaster.OptButton
      newobj = EmbedObject(Me, OptionGroupMaster.OptButton, UniqueEmbedName(Me, "OptButton"))
      newobj.Caption = Caption
      newobj.codex = codex
      Resize()
    End Sub

    Function FindValue(value As String) As Integer
      dim i as integer
      For i = 0 To Controls.Count - 1
        If (Controls(i).codex = value) Then FindValue = i : Exit Function
      Next i

      Throw ValueNotFound
    End Function

    Function getValue() As String
      dim i as integer
      For i = 0 To Controls.Count - 1
        If Controls(i).Value Then
          getValue = Controls(i).codex
          Exit Function
        End If
      Next i
    End Function

    Sub RemoveValue(value As String)
      dim i as integer

      ' This call will throw if value is not found.
      i = FindValue(value)

      ' Maintain a reference to the object in the group, to control destruction
      ' during RemoveAt phase.
      DestroyObject(Controls(i))
      Resize()
    End Sub

    Sub Resize()
      dim i as integer
      dim top, newheight as single
      If Controls.Count = 0 Then Exit Sub

      top = 60
      newheight = ((ScaleHeight - top) / Controls.Count) - 30

      For i = 0 To Controls.Count - 1
        Controls(i).Move(0, top, ScaleWidth, newheight)
        top = top + newheight
      Next i
      Refresh
    End Sub

    Sub setValue(sval as String)
      dim i as integer
      For i = 0 To Controls.Count - 1
        If (Controls(i).codex = sval) Then
          Controls(i).Value = True
          Exit Sub
        Else
          Controls(i).Value = False
        End If
      Next i
    End Sub

    Sub Update(ByVal value As String)
      Value = Trim(value)
    End Sub

    Sub UpdateDataControl(value As String)
      value = Value

    End Sub

    Sub UpdateDataSource(value As String)
      value = Value
    End Sub

  End Type
  Type OptButton From OptionButton
    Dim codex As String

    ' METHODS for object: OptionGroupMaster.OptButton
    Sub Click()
      ' If any new value is picked by a Value Option Button mark container as changed.
      If Parent Then Parent.DataChanged = True
    End Sub

    Sub DragStart(xfd As XferData, x As Single, y As Single)
      xfd.ObjectRef = Parent
      xfd.Drag 7
    End Sub

  End Type
End Type

Type EmployeeForm From SampleMasterForm
  Dim OptionGroup As New OptionGroupMaster.Buttons
  Dim Label1 As New Label
  Dim Label2 As New Label
  Dim Label3 As New Label
  Dim Label4 As New Label
  Dim TxtEmployeeID As New TextBox
  Dim TxtDepartment As New TextBox
  Dim TxtName As New TextBox
  Dim TxtSalary As New TextBox
  Dim BtnNew As New Button
  Dim BtnDelete As New Button
  Dim BtnUpdate As New Button
  Dim DataControl1 As New DataControl
  Dim Frame1 As New Frame
  Type IndentedList1 From IndentedList
    Dim font1 As New Font
  End Type
  Dim Label5 As New Label
  Dim Label6 As New Label

  ' METHODS for object: EmployeeForm
  Sub BtnDelete_Click()
    Dim response As Integer
    response = YesNoBox.Message("Delete?", "OK to remove current employee record?")
    If response = 6 Then
      Dim eid, did As String
      eid = TxtEmployeeID.Text
      did = TxtDepartment.Text

      With DataControl1.RecordSet
        If Not .EOF Or Not .BOF Then
          .Delete
          .MoveNext
          If .EOF Then .MovePrev
        End If
      End With
      DataControl1.RecordSet.UpdateAll()
      ' Need to check and possibly update the indented list if entry is selected
      If IndentedList1.ListIndex <> -1 Then
        ' Determine if selected entry is an employee entry
        If IndentedList1.ItemIcon(IndentedList1.ListIndex) = 2 Then
          ' Determine if the indented list line entry is the same as displayed record
          If Trim(Left(IndentedList1.ItemString(IndentedList1.ListIndex), 5)) = eid Then
            ' ok to remove the selected entry
            IndentedList1.RemoveItem(IndentedList1.ListIndex)
            ' Need to see if any more department id's exit and if not, do a PopulateList
            DataControl1.RecordSet.Column(1).FindFirst(did)
            If did <> Trim(DataControl1.RecordSet.Row(DataControl1.RecordSet.CurrentRecordNumber).Column(0).Value) Then
              PopulateList
            End If
          End If
        End If
      End If
    End If
  End Sub

  Sub BtnNew_Click()
    ' Add a new entry to the recordset
    DataControl1.RecordSet.AddNew

    ' Need to clear the option buttons
    OptionGroup.OptButton1.Value = True
    OptionGroup.OptButton2.Value = False
    OptionGroup.OptButton3.Value = False

    ' Place the type-in point in the Employee ID textbox
    TxtEmployeeID.SetFocus
  End Sub

  Sub BtnUpdate_Click()
    ' Need to validate vital employee information
    If TxtEmployeeID.Text = "" Then
      InfoBox.Message("Warning", "No Employee ID has been entered.")
      Exit Sub
    End If

    If TxtDepartment.Text = "" Then
      InfoBox.Message("Warning", "No Department number has been entered.")
      Exit Sub
    End If
    ' Save the contents of the recordset to disk file
    DataControl1.RecordSet.UpdateAll()

    ' Need to update the indented list
    PopulateList
  End Sub

  Sub CheckUpdateRecords ()
    ' If the employee ID or department number change, collapse the list
    If TxtEmployeeID.DataChanged || TxtDepartment.DataChanged Then
      BtnUpdate_Click
    Else
      ' update the current record in case it has changed
      DataControl1.RecordSet.Update
    End If
  End Sub

  Sub IndentedList1_Click()
    Dim icon_type As Integer
    ' Determine the type of icon the item has
    icon_type = IndentedList1.ItemIcon(IndentedList1.ListIndex)

    ' If the item is an icon_type = 2, it is an employee
    ' so we need to move the datacontrol to the right employee
    If icon_type = 2 Then
      Dim eid As String
      Dim i, row As Integer
      ' check the key records to see if list needs to be redone
      CheckUpdateRecords
      ' Get the indented list line entry
      eid = Trim(Left(IndentedList1.ItemString(IndentedList1.ListIndex), 5))
      ' Find the first blank space
      DataControl1.RecordSet.Column(1).FindFirst(eid)
      DataControl1.RecordSet.CurrentRecordNumber = DataControl1.RecordSet.CurrentRecordNumber
    End If
  End Sub

  Sub IndentedList1_Collapsed(ByVal itemIndex as Integer, ByVal itemData as Long, itemObj as Object)
    IndentedList1.SetItemIcon(itemIndex, 1)
  End Sub

  Sub IndentedList1_Expand(ByVal itemIndex as Integer, ByVal itemData as Long, itemObj as Object)
    Dim i as Integer
    Dim sdept, fdept, eid As String

    sdept = IndentedList1.ItemString(itemIndex)
    ' Search the recordset to find all employees in sdept department
    For i = 0 To DataControl1.RecordSet.RowsRead - 1
      fdept = DataControl1.RecordSet.Row(i).Column(0).Value
      If sdept = fdept Then
        eid = DataControl1.RecordSet.Row(i).Columns(1, 2).Value
        IndentedList1.InsertItem(eid, 2, 1, itemIndex + 1)
      End If
    Next i
    IndentedList1.Reset
  End Sub

  Sub PopulateList
    Dim i, j, pos as Integer
    Dim dept As String
    Dim found As Boolean

    IndentedList1.Clear

    pos = 0

    For i = 0 To DataControl1.RecordSet.RowsRead - 1
      dept = DataControl1.RecordSet.Row(i).Column(0).Value
      ' If the item does not already exist, add it
      For j = 0 To IndentedList1.ListCount - 1
        If IndentedList1.ItemString(j) = dept Then
          found = True
          Exit For
        Else
          found = False
        End If
      Next j
      If Not found Then
        pos = pos + 1
        ' IndentedList1.InsertItem(dept, 1, 0, pos - 1)
        ' We use AddItem so we get the benefit of the sorted property
        IndentedList1.AddItem(dept, 1)

        ' IndentedList1.SetItemCanExpand(pos - 1, True)
      End If
      found = False
    Next i

    ' Set the expand flag on all items in the indented list
    For i = 0 To IndentedList1.ListCount - 1
      IndentedList1.SetItemCanExpand(i, True)
    Next i

    IndentedList1.Reset
  End Sub

  Sub ResetApplication_Click()
    ' Restore the size of the form
    Height = 6015
    Width = 7170
    ' connect the Data Control to the ASCII Data Source
    DataControl1.RecordSet.Connect = SampleDir & "employee.TXT"

    ' Move to the first record
    DataControl1.RecordSet.MoveFirst

    ' Populate the department list
    PopulateList
  End Sub

End Type

Begin Code
' Reconstruction commands for object: datasamp
'
  With datasamp
    .ModulePath := "C:\ENVELOP\PROGRAM\base.ebo;C:\ENVELOP\PROGRAM\win32.ebo;C:\ENVELOP\PROGRAM\dialogs.ebo;C:\ENVELOP\PROGRAM\tools.ebo;D:\envelop1\bootcamp\concepts\dbsample\dbsample.eto"
    .ProjectFileName := "C:\envelop\temp\datasamp.epj"
    .Path := "C:\envelop\temp\"
    .EXEName := "datasamp"
    With .AccessControl
      .ObjectAccess := "R,W,C,M,P"
    End With  'datasamp.AccessControl
  End With  'datasamp
' Reconstruction commands for object: OptionGroupMaster
'
  With OptionGroupMaster
    With .Buttons
      .Move(3750, 1275, 1785, 1695)
      .Value := ""
      With .OptButton1
        .Caption := "Active"
        .ZOrder := 2
        .Move(0, 60, 1665, 380)
        .codex := "A"
      End With  'OptionGroupMaster.Buttons.OptButton1
      With .OptButton2
        .Caption := "On Leave"
        .ZOrder := 3
        .Move(0, 440, 1665, 380)
        .codex := "O"
      End With  'OptionGroupMaster.Buttons.OptButton2
      With .OptButton3
        .Caption := "Terminated"
        .ZOrder := 1
        .Move(0, 820, 1665, 380)
        .codex := "T"
      End With  'OptionGroupMaster.Buttons.OptButton3
    End With  'OptionGroupMaster.Buttons
    With .OptButton
      .Move(0, 0, 0, 0)
      .codex := ""
    End With  'OptionGroupMaster.OptButton
  End With  'OptionGroupMaster
' Reconstruction commands for object: EmployeeForm
'
  With EmployeeForm
    .Caption := "Database Sample: Maintain Employees"
    .Move(4290, 1785, 7170, 6015)
    .SampleDir := "C:\envelop\bootcamp\advanced\dbsample\"
    .SampleName := "dbsample"
    With .OptionGroup
      .DataSource := EmployeeForm.DataControl1.RecordSet
      .DataField := "Status"
      .ZOrder := 15
      .Move(5100, 3000, 1500, 1200)
      .BorderStyle := "None"
      .MaxButton := False
      .ControlBox := False
      .Parent := EmployeeForm
      .Visible := True
      .Value := "A"
      With .OptButton1
        .ZOrder := 1
        .Move(0, 60, 1500, 350)
        .TabStop := True
        .Value := True
      End With  'EmployeeForm.OptionGroup.OptButton1
      With .OptButton2
        .ZOrder := 2
        .Move(0, 410, 1500, 350)
      End With  'EmployeeForm.OptionGroup.OptButton2
      With .OptButton3
        .ZOrder := 3
        .Move(0, 760, 1500, 350)
      End With  'EmployeeForm.OptionGroup.OptButton3
    End With  'EmployeeForm.OptionGroup
    With .Label1
      .Caption := "Employee ID:"
      .ZOrder := 14
      .Move(300, 2850, 1350, 300)
      .Alignment := "Right"
    End With  'EmployeeForm.Label1
    With .Label2
      .Caption := "Department:"
      .ZOrder := 13
      .Move(300, 3300, 1350, 300)
      .Alignment := "Right"
    End With  'EmployeeForm.Label2
    With .Label3
      .Caption := "Name:"
      .ZOrder := 12
      .Move(300, 3750, 1350, 300)
      .Alignment := "Right"
    End With  'EmployeeForm.Label3
    With .Label4
      .Caption := "Salary:"
      .ZOrder := 11
      .Move(300, 4200, 1350, 300)
      .Alignment := "Right"
    End With  'EmployeeForm.Label4
    With .TxtEmployeeID
      .DataSource := EmployeeForm.DataControl1.RecordSet
      .DataField := "EID"
      .ZOrder := 1
      .Move(1950, 2850, 750, 345)
      .MaxLength := 5
    End With  'EmployeeForm.TxtEmployeeID
    With .TxtDepartment
      .DataSource := EmployeeForm.DataControl1.RecordSet
      .DataField := "Dept"
      .ZOrder := 2
      .Move(1950, 3300, 750, 345)
      .MaxLength := 5
    End With  'EmployeeForm.TxtDepartment
    With .TxtName
      .DataSource := EmployeeForm.DataControl1.RecordSet
      .DataField := "Name"
      .ZOrder := 3
      .Move(1950, 3750, 2550, 345)
      .MaxLength := 20
    End With  'EmployeeForm.TxtName
    With .TxtSalary
      .DataSource := EmployeeForm.DataControl1.RecordSet
      .DataField := "Salary"
      .ZOrder := 4
      .Move(1950, 4200, 1350, 345)
      .MaxLength := 10
    End With  'EmployeeForm.TxtSalary
    With .BtnNew
      .Caption := "New"
      .ZOrder := 10
      .Move(5100, 600, 1650, 450)
      .TabStop := False
    End With  'EmployeeForm.BtnNew
    With .BtnDelete
      .Caption := "Delete"
      .ZOrder := 9
      .Move(5100, 1200, 1650, 450)
      .TabStop := False
    End With  'EmployeeForm.BtnDelete
    With .BtnUpdate
      .Caption := "Update"
      .ZOrder := 8
      .Move(5100, 1800, 1650, 450)
      .TabStop := False
    End With  'EmployeeForm.BtnUpdate
    With .DataControl1
      .Caption := "DataControl1"
      .ZOrder := 7
      .Move(300, 4800, 6450, 300)
      .BorderStyle := "None"
      .MinButton := True
      .ControlBox := False
      .Parent := EmployeeForm
      .Visible := True
      With .DataMoveFirst
        .ZOrder := 1
        .Move(0, 0, 806, 300)
      End With  'EmployeeForm.DataControl1.DataMoveFirst
      With .DataMovePrev
        .ZOrder := 2
        .Move(806, 0, 806, 300)
      End With  'EmployeeForm.DataControl1.DataMovePrev
      With .DataMoveNext
        .ZOrder := 3
        .Move(4837, 0, 806, 300)
      End With  'EmployeeForm.DataControl1.DataMoveNext
      With .DataMoveLast
        .ZOrder := 4
        .Move(5643, 0, 806, 300)
      End With  'EmployeeForm.DataControl1.DataMoveLast
      With .DataLabel
        .ZOrder := 5
        .Move(1612, 0, 3225, 300)
      End With  'EmployeeForm.DataControl1.DataLabel
      With .RecordSet
        .DatabaseType := "FixedAscii"
        .Database.FirstLineAsFieldNames := True
        .Database.FieldWidthList := "5, 5, 20, 10, 7"
        .Connect := "C:\envelop\bootcamp\advanced\dbsample\employee.TXT"
      End With  'EmployeeForm.DataControl1.RecordSet
    End With  'EmployeeForm.DataControl1
    With .Frame1
      .Caption := " Status "
      .ZOrder := 16
      .Move(4950, 2700, 1800, 1650)
      .TabStop := False
    End With  'EmployeeForm.Frame1
    With .IndentedList1
      .Caption := "IndentedList1"
      .ForeColor := 0
      .Font := EmployeeForm.IndentedList1.font1
      .ZOrder := 17
      .Move(300, 600, 4500, 1950)
      .TabStop := False
      .IconBitmap := SourceSearcher.bitmap
      .IconHeight := 12
      .IconWidth := 12
      .Sorted := True
      .HighlightStyle := "FullLine"
      With .font1
        .FaceName := "Courier"
        .Size := 12.000000
        .Bold := True
        .Italic := False
        .Strikethru := False
      End With  'EmployeeForm.IndentedList1.font1
    End With  'EmployeeForm.IndentedList1
    With .Label5
      .Caption := "Dept"
      .ForeColor := 16711680
      .ZOrder := 6
      .Move(300, 75, 525, 225)
    End With  'EmployeeForm.Label5
    With .Label6
      .Caption := "EID      Name"
      .ForeColor := 255
      .ZOrder := 5
      .Move(825, 300, 2250, 300)
    End With  'EmployeeForm.Label6
    With .helpfile
      .FileName := "C:\envelop\bootcamp\advanced\dbsample\dbsample.hlp"
    End With  'EmployeeForm.helpfile
  End With  'EmployeeForm
End Code