Programming Tool Box/SIMS_2.iso/code/database/c_dbsuch/suchform.frm

Visual Basic Form | 1995-01-25 | 20.0 KB | 648 lines

VERSION 2.00
Begin Form frm_Globale_Suchform
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Globale Suchform f
r Datenbank-Tabellen"
   ClientHeight    =   6495
   ClientLeft      =   420
   ClientTop       =   420
   ClientWidth     =   8655
   Height          =   6900
   Left            =   360
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6495
   ScaleWidth      =   8655
   Top             =   75
   Width           =   8775
   Begin CommandButton cmd_Exit
      Caption         =   "Ende"
      Height          =   435
      Left            =   3600
      TabIndex        =   17
      Top             =   5820
      Width           =   1455
   End
   Begin Grid gri_Datensatz
      Cols            =   1
      FixedCols       =   0
      FixedRows       =   0
      Height          =   1455
      Left            =   240
      Rows            =   1
      TabIndex        =   16
      Top             =   4080
      Width           =   8175
   End
   Begin CommandButton cmd_Suchen
      Caption         =   "letzter Datensatz"
      Enabled         =   0   'False
      Height          =   435
      Index           =   3
      Left            =   6480
      TabIndex        =   15
      Top             =   3420
      Width           =   1935
   End
   Begin CommandButton cmd_Suchen
      Caption         =   "vorheriger Datensatz"
      Enabled         =   0   'False
      Height          =   435
      Index           =   2
      Left            =   4380
      TabIndex        =   14
      Top             =   3420
      Width           =   1995
   End
   Begin CommandButton cmd_Suchen
      Caption         =   "n
chster Datensatz"
      Enabled         =   0   'False
      Height          =   435
      Index           =   1
      Left            =   2340
      TabIndex        =   13
      Top             =   3420
      Width           =   1935
   End
   Begin CommandButton cmd_Suchen
      Caption         =   "erster Datensatz"
      Enabled         =   0   'False
      Height          =   435
      Index           =   0
      Left            =   240
      TabIndex        =   12
      Top             =   3420
      Width           =   1995
   End
   Begin TextBox txt_Bedingung
      Height          =   285
      Left            =   5580
      TabIndex        =   11
      Top             =   2520
      Width           =   2835
   End
   Begin ComboBox cmb_Tabelle
      BackColor       =   &H00FFFFFF&
      Height          =   300
      Left            =   4920
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1620
      Width           =   3495
   End
   Begin ComboBox cmb_Feld
      BackColor       =   &H00FFFFFF&
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   20
      Top             =   2520
      Width           =   3135
   End
   Begin FileListBox fil_Datei
      BackColor       =   &H00FFFFFF&
      Height          =   1005
      Left            =   6600
      Pattern         =   "*.MDB"
      TabIndex        =   2
      Top             =   240
      Width           =   1815
   End
   Begin DirListBox dir_Verzeichnis
      BackColor       =   &H00FFFFFF&
      Height          =   1155
      Left            =   1500
      TabIndex        =   1
      Top             =   240
      Width           =   4995
   End
   Begin DriveListBox drv_Laufwerk
      BackColor       =   &H00FFFFFF&
      Height          =   315
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1155
   End
   Begin Label lab_Pr
dikat
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "wie"
      Height          =   255
      Index           =   5
      Left            =   4980
      TabIndex        =   10
      Top             =   2520
      Width           =   495
   End
   Begin Label lab_
      BackColor       =   &H00C0C0C0&
      Caption         =   "Tabelle"
      Height          =   195
      Index           =   1
      Left            =   4140
      TabIndex        =   18
      Top             =   1680
      Width           =   675
   End
   Begin Label lab_
      BackColor       =   &H00C0C0C0&
      Caption         =   "Datenbankdatei"
      Height          =   195
      Index           =   0
      Left            =   240
      TabIndex        =   19
      Top             =   1680
      Width           =   1395
   End
   Begin Label lab_Pr
dikat
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   ">="
      Height          =   255
      Index           =   4
      Left            =   4680
      TabIndex        =   9
      Top             =   2520
      Width           =   315
   End
   Begin Label lab_Pr
dikat
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   ">"
      Height          =   255
      Index           =   3
      Left            =   4380
      TabIndex        =   8
      Top             =   2520
      Width           =   315
   End
   Begin Label lab_Pr
dikat
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "<="
      Height          =   255
      Index           =   2
      Left            =   4080
      TabIndex        =   7
      Top             =   2520
      Width           =   315
   End
   Begin Label lab_Pr
dikat
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "<"
      Height          =   255
      Index           =   1
      Left            =   3780
      TabIndex        =   6
      Top             =   2520
      Width           =   315
   End
   Begin Label lab_Pr
dikat
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "="
      Height          =   255
      Index           =   0
      Left            =   3480
      TabIndex        =   5
      Top             =   2520
      Width           =   315
   End
   Begin Label lab_Datei
      Alignment       =   2  'Center
      BackColor       =   &H0080FFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   1740
      TabIndex        =   4
      Top             =   1620
      Width           =   2295
   End
'============================================================
' Formdatei   : SUCHFORM.FRM
' Formname    : frm_Globale_Suchform
' Aufgabe     : Globale Suchform (Suchen in Datenbank-Tabellen)
' Copyright   : Arthur Burda
' Compiler    : Visual Basic 3.0 f
r Windows
' erstellt am : 26.01.1995
'============================================================
Option Explicit
Dim DB As Database
Dim Snap As snapshot
Dim Pr
dikat As String ' Vergleichspr
dikat
'============================================================
' Routine : cmb_Feld_Click
'============================================================
' Aufgabe : Combo-Box mit Tabellen-Felddefinition wurde an-
'           geklickt; Fokus auf Feld f
r die Eingabe der Such-
'           bedingung setzen
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub cmb_Feld_Click ()
    txt_Bedingung.SetFocus
End Sub
'============================================================
' Routine : cmb_Tabelle_Click
'============================================================
' Aufgabe : Combo-Box mit Datenbank-Tabellen wurde angeklickt;
'           Combo-Box mit Tabellen-Felddefinition aktualisieren
'           und Datensatz-Tabelle einrichten
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub cmb_Tabelle_Click ()
    ' Feld-Datentypen
    Const DB_BOOLEAN = 1
    Const DB_BYTE = 2
    Const DB_INTEGER = 3
    Const DB_LONG = 4
    Const DB_CURRENCY = 5
    Const DB_SINGLE = 6
    Const DB_DOUBLE = 7
    Const DB_DATE = 8
    Const DB_TEXT = 10
    Const DB_LONGBINARY = 11
    Const DB_MEMO = 12
    Dim i
    Dim List_Count
    Dim Table_Name
    Dim Field_Count
    ' alle Eintr
ge aus der Combo-Box mit Tabellen-Felddefinition l
schen
    If cmb_Feld.ListCount > 0 Then
        List_Count = cmb_Feld.ListCount
        For i = 1 To List_Count
            cmb_Feld.RemoveItem 0
        Next i
    End If
    ' Combo-Box (Tabellen-Felddefinition) mit neuen Eintr
gen f
    Table_Name = DB.TableDefs(cmb_Tabelle.List(cmb_Tabelle.ListIndex)).Name
    If DB.TableDefs(Table_Name).Fields.Count > 0 Then
        For i = 1 To DB.TableDefs(Table_Name).Fields.Count
            cmb_Feld.AddItem DB.TableDefs(Table_Name).Fields(i - 1).Name
        Next i
        cmb_Feld.ListIndex = 0
    End If
    ' Datensatz-Tabelle einrichten
    Field_Count = DB.TableDefs(Table_Name).Fields.Count
    gri_Datensatz.Cols = Field_Count + 1
    gri_Datensatz.Rows = 2
    gri_Datensatz.FixedCols = 1
    gri_Datensatz.FixedRows = 1
    gri_Datensatz.Row = 0
    For i = 1 To Field_Count
        gri_Datensatz.Col = i
        gri_Datensatz.ColWidth(i) = Len(DB.TableDefs(Table_Name).Fields(i - 1).Name) * 120
        Select Case DB.TableDefs(Table_Name).Fields(i - 1).Type
            Case DB_TEXT ' Textfeld
                If gri_Datensatz.ColWidth(i) < DB.TableDefs(Table_Name).Fields(i - 1).Size * 120 Then
                    gri_Datensatz.ColWidth(i) = DB.TableDefs(Table_Name).Fields(i - 1).Size * 120
                End If
            Case Else ' alle anderen Felder
                If gri_Datensatz.ColWidth(i) < 2000 Then
                    gri_Datensatz.ColWidth(i) = 2000
                End If
        End Select
        gri_Datensatz.Text = DB.TableDefs(Table_Name).Fields(i - 1).Name
    Next i
    gri_Datensatz.Row = 1
    For i = 1 To Field_Count
        gri_Datensatz.Col = i
        gri_Datensatz.Text = ""
    Next i
    ' Snapshot-Objekt schlie
    If Not Snap Is Nothing Then
        Snap.Close
    End If
    ' Snapshot neu generieren (andere Tabelle)
    Set Snap = DB.CreateSnapshot(Table_Name)
End Sub
'============================================================
' Routine : cmd_Exit_Click
'============================================================
' Aufgabe : Programm beenden
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub cmd_Exit_Click ()
    End
End Sub
'============================================================
' Routine : cmb_Suchen_Click
'============================================================
' Aufgabe : Schalter zum Suchen in der Datenbank-Tabelle nach
'           vorgegebenem Kriterium angeklickt; Suchaktion star-
'           ten
' Eingabe : Index = Index des angeklickten Schalters
' Ausgabe : keine
'------------------------------------------------------------
Sub cmd_Suchen_Click (Index As Integer)
    Dim Table_Name
    Dim Field_Name
    Dim Field_Count
    Dim Statement
    Dim i
    Dim Fehler_
    On Error GoTo ERR_cmd_Suchen_Click
    Table_Name = DB.TableDefs(cmb_Tabelle.List(cmb_Tabelle.ListIndex)).Name
    Field_Name = DB.TableDefs(Table_Name).Fields(cmb_Feld.List(cmb_Feld.ListIndex)).Name
    Field_Count = DB.TableDefs(Table_Name).Fields.Count
    Statement = "[" & Field_Name & "] " & Pr
dikat & " " & txt_Bedingung.Text
    ' Datensatz suchen
    If Not Snap Is Nothing Then
        Select Case Index
            Case 0 ' erster Datensatz
                Snap.FindFirst Statement
            Case 1 ' n
chster Datensatz
                Snap.FindNext Statement
            Case 2 ' vorheriger Datensatz
                Snap.FindPrevious Statement
            Case 3 ' letzter Datensatz
                Snap.FindLast Statement
        End Select
        If Fehler_ = 0 Then
            If Snap.NoMatch Then
                Beep
                MsgBox "Kein Datensatz gefunden, der dem eingegebenen Suchkriterium entsprechen w
rde."
            Else ' Datensatz gefunden, anzeigen
                gri_Datensatz.Cols = Field_Count + 1
                gri_Datensatz.Rows = 2
                gri_Datensatz.Row = 1
                On Error Resume Next
                For i = 1 To Field_Count
                    gri_Datensatz.Col = i
                    gri_Datensatz.Text = Snap(i - 1)
                Next i
                On Error GoTo ERR_cmd_Suchen_Click
            End If
        End If
    End If
    txt_Bedingung.SetFocus
EXIT_cmd_Suchen_Click:
    Exit Sub
ERR_cmd_Suchen_Click:
    Fehler_ = Err
    Beep
    MsgBox "Fehler Nr. " & Str$(Fehler_) & " aufgetreten. Bitte korrigieren Sie die Suchbedingung."
    txt_Bedingung.SetFocus
    Resume Next
End Sub
'============================================================
' Routine : dir_Verzeichnis_Change
'============================================================
' Aufgabe : Pfad hat sich ge
ndert; Datei-Auswahlbox aktuali-
'           sieren
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub dir_Verzeichnis_Change ()
    fil_Datei.Path = dir_Verzeichnis.Path
End Sub
'============================================================
' Routine : drv_Laufwerk_Change
'============================================================
' Aufgabe : Laufwerk hat sich ge
ndert; Verzeichnis-Auswahl-
'           box aktualisieren
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub drv_Laufwerk_Change ()
    dir_Verzeichnis.Path = drv_Laufwerk.Drive
End Sub
'============================================================
' Routine : fil_Datei_Click
'============================================================
' Aufgabe : Datei-Eintrag wurde angeklickt; zuerst Controls
'           zur
cksetzen und deaktivieren, dann Datenbankdatei
'
ffnen und Controls aktualisieren
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub fil_Datei_Click ()
    ' Tabellendefinition-Attribute
    Const DB_ATTACHEXCLUSIVE = &H10000
    Const DB_ATTACHSAVEPWD = &H20000
    Const DB_SYSTEMOBJECT = &H80000002
    Const DB_ATTACHEDTABLE = &H40000000
    Const DB_ATTACHEDODBC = &H20000000
    Dim i
    Dim List_Count
    ' Pfad wechseln
    ChDir fil_Datei.Path
    ' alle Eintr
ge aus allen Combo-Boxen l
schen
    If cmb_Tabelle.ListCount > 0 Then
        List_Count = cmb_Tabelle.ListCount
        For i = 1 To List_Count
            cmb_Tabelle.RemoveItem 0
        Next i
    End If
    If cmb_Feld.ListCount > 0 Then
        List_Count = cmb_Feld.ListCount
        For i = 1 To List_Count
            cmb_Feld.RemoveItem 0
        Next i
    End If
    ' Controls zur
cksetzen und deaktivieren
    Pr
dikat = ""
    For i = 0 To 5
        lab_Pr
dikat(i).BackColor = RGB(255, 255, 255)
    Next i
    txt_Bedingung.Text = ""
    For i = 0 To 3
        cmd_Suchen(i).Enabled = False
    Next i
    gri_Datensatz.FixedCols = 0
    gri_Datensatz.FixedRows = 0
    gri_Datensatz.Cols = 1
    gri_Datensatz.Rows = 1
    gri_Datensatz.Row = 0
    gri_Datensatz.Col = 0
    gri_Datensatz.Text = ""
    ' ge
ffnete Datenbank und Snapshot-Objekt schlie
    If Not Snap Is Nothing Then
        Snap.Close
    End If
    If Not DB Is Nothing Then
        DB.Close
    End If
    lab_Datei.Caption = ""
    Set DB = Nothing
    Set Snap = Nothing
    ' Datenbankdatei
ffnen
    Set DB = OpenDatabase(fil_Datei.FileName)
    ' wenn kein Fehler, dann Controls aktualisieren
    If Err = 0 Then
        lab_Datei.Caption = UCase$(fil_Datei.FileName)
        If DB.TableDefs.Count > 0 Then
            For i = 1 To DB.TableDefs.Count
                If (DB.TableDefs(i - 1).Attributes And DB_SYSTEMOBJECT) = 0 Then
                    cmb_Tabelle.AddItem DB.TableDefs(i - 1).Name
                End If
            Next i
            cmb_Tabelle.ListIndex = 0
        End If
        Pr
dikat = "Like"
        lab_Pr
dikat(5).BackColor = RGB(0, 255, 0)
        txt_Bedingung.Text = "'*'"
    End If
End Sub
'============================================================
' Routine : Form_Load
'============================================================
' Aufgabe : Wird aufgerufen, wenn die Form geladen wird.
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub Form_Load ()
    ChDir App.Path
    Zentriere_Form
    Me.Show
    lab_Datei.Caption = ""
    Set DB = Nothing
    Set Snap = Nothing
    dir_Verzeichnis.Path = App.Path
    ' Datenbankdatei CITIES.MDB
ffnen
    fil_Datei.SetFocus
    If UCase$(fil_Datei.List(0)) = "CITIES.MDB" Then
        fil_Datei.Selected(0) = True
    End If
End Sub
'============================================================
' Routine : Form_Unload
'============================================================
' Aufgabe : Wird aufgerufen, wenn die Form aus dem Speicher
'           entfernt wird, also wenn das Programm beendet wird.
' Eingabe : Cancel = True, wenn Abbruch, sonst False
' Ausgabe : keine
'------------------------------------------------------------
Sub Form_Unload (Cancel As Integer)
    If Not Cancel Then
        ' ge
ffnete Datenbank und Snapshot schlie
        If Not Snap Is Nothing Then
            Snap.Close
        End If
        If Not DB Is Nothing Then
            DB.Close
        End If
    End If
End Sub
'============================================================
' Routine : lab_Pr
dikat_Click
'============================================================
' Aufgabe : Vergleichspr
dikat-Control wurde angeklickt; Ver-
'           gleichspr
dikat setzen
' Eingabe : Index = Index des angeklickten Labels
' Ausgabe : keine
'------------------------------------------------------------
Sub lab_Pr
dikat_Click (Index As Integer)
    Dim i
    For i = 0 To 5
        lab_Pr
dikat(i).BackColor = RGB(255, 255, 255)
    Next i
    Select Case Index
        Case 0
            Pr
dikat = "="
        Case 1
            Pr
dikat = "<"
        Case 2
            Pr
dikat = "<="
        Case 3
            Pr
dikat = ">"
        Case 4
            Pr
dikat = ">="
        Case 5
            Pr
dikat = "Like"
    End Select
    lab_Pr
dikat(Index).BackColor = RGB(0, 255, 0)
    txt_Bedingung.SetFocus
End Sub
'============================================================
' Routine : txt_Bedingung_Change
'============================================================
' Aufgabe : Die Suchbedingung in einem der vier Eingabefelder
'           hat sich ge
ndert; Suchschalter in Abh
ngigkeit
'           von der Eingabe der Suchbedingung aktivieren bzw.
'           deaktivieren
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub txt_Bedingung_Change ()
    Dim i
    If txt_Bedingung.Text <> "" Then
        For i = 0 To 3
            cmd_Suchen(i).Enabled = True
        Next i
    Else
        For i = 0 To 3
            cmd_Suchen(i).Enabled = False
        Next i
    End If
End Sub
'============================================================
' Routine : Zentriere_Form
'============================================================
' Aufgabe : Zentriert die Form.
' Eingabe : keine
' Ausgabe : keine
'------------------------------------------------------------
Sub Zentriere_Form ()
    Me.Top = Screen.Height / 2 - Me.Height / 2
    Me.Left = Screen.Width / 2 - Me.Width / 2
End Sub