SELECT CASES ???

[Kernelpanic]

Thank you Pete! It works now. I tried to make the pictures all the same size so that they are in the middle, but it doesn't always work that way. Otherwise I'm satisfied. 

Database motorbike

Code: (Select All)

'Direktzugriffsdatei (Random Access) - 5. Okt. 2022
'Geaendert auf "Shared" Variable da sonst Probleme beim Lesen - 14. Okt. 2022
'Jetzt werden auch Bilder angezeigt. Dank an Pete. - 19. Okt. 2022

$Console:Only

Option _Explicit

'Definition der Datenstruktur - Direktzugriff
Type MotorradModell
  Modell As String * 20
  Farbe As String * 10
  Hubraum As String * 10
  Kilowatt As String * 10
  Fahrgewicht As String * 10
  Preis As Double
End Type

'Global zur Verfuegung stellen, sonst wird es
'wirklich kompliziert
Dim Shared Motorrad As MotorradModell

Declare Sub Eingabe()
Declare Sub Lesen()
Declare Sub SatzLesen()

Dim As Integer auswahl

Nochmal:
Cls
auswahl = 0
Locate 3, 4
Print "Waehlen Sie das gewuenschte Programm."
Locate 6, 10
Print "In Datei schreiben    -> 1"
Locate 7, 10
Print "Datei lesen           -> 2"
Locate 8, 10
Print "Bestimmten Satz lesen -> 3"
Locate 9, 10
Print "Programm beenden      -> 4"

Locate 11, 4
Input "Ihre Wahl bitte: ", auswahl
Print

Select Case auswahl
  Case 1
    Call Eingabe
  Case 2
    Call Lesen
  Case 3
    Call SatzLesen
  Case 4
    End
  Case Else
    Beep: Locate 12, 4
    Print "Falsche Eingabe!"
    Sleep 1
    GoTo Nochmal
End Select

End 'Hauptprogramm

'Neue Datei erstellen und Daten einlesen
Sub Eingabe

  Dim As Integer SatzNummer
  Dim As String Antwort

  Open "Motorrad.Dat" For Random As #1 Len = Len(Motorrad)

  SatzNummer = LOF(1) \ Len(Motorrad)

  'Neue Datensaetze hinzufuegen
  Do
    Input "Modell     : ", Motorrad.Modell
    Input "Farbe      : ", Motorrad.Farbe
    Input "Hubraum    : ", Motorrad.Hubraum
    Input "Kilowatt   : ", Motorrad.Kilowatt
    Input "Fahrgewicht: ", Motorrad.Fahrgewicht
    Input "Preis      : ", Motorrad.Preis

    SatzNummer = SatzNummer + 1

    'Datensatz in Datei schreiben
    Put #1, SatzNummer, Motorrad

    'Sollen weitere Daten eingegeben werden?
    Input "Weiter J/N: ", Antwort$
  Loop Until UCase$(Antwort$) = "N"

  Close 1#
End Sub

'Datensaetze sequentiell auslesen (alle)
Sub Lesen

  Dim As Integer AnzahlSaetze, SatzNummer

  Open "Motorrad.Dat" For Random As #1 Len = Len(Motorrad)

  'Anzahl der Datensaetze berechnen
  AnzahlSaetze = LOF(1) \ Len(Motorrad)

  'Datensaetze lesen und anzeigen
  For SatzNummer = 1 To AnzahlSaetze
    Get #1, SatzNummer, Motorrad

    'Daten anzeigen
    Print Tab(4); "Modell     : ", Motorrad.Modell
    Print Tab(4); "Farbe      : ", Motorrad.Farbe
    Print Tab(4); "Hubraum    : ", Motorrad.Hubraum
    Print Tab(4); "Kilowatt   : ", Motorrad.Kilowatt
    Print Tab(4); "Fahrgewicht: ", Motorrad.Fahrgewicht
    Print Tab(4); Using "Preis      : #####.##"; Motorrad.Preis
    Print
    Print Tab(4); "---------------------------------"
    Print
  Next

  Close 1#
End Sub

Sub SatzLesen ()

  Const Falsch = 0, Wahr = Not Falsch
  Dim As Integer AnzahlSaetze, BestimmterSatz, SatzNummer

  Open "Motorrad.Dat" For Random As #1 Len = Len(Motorrad)

  'Anzahl der Datensaetze berechnen
  AnzahlSaetze = LOF(1) \ Len(Motorrad)
  BestimmterSatz = Wahr

  Do
    Print
    Print Tab(4); "Satznummer: ";
    Print "(Null zum Beenden): ";
    Input " ", SatzNummer

    'Warum "AnzahlSaetze + 1"? War intuitiv!
    If SatzNummer > 0 And SatzNummer < AnzahlSaetze + 1 Then
      Get #1, SatzNummer, Motorrad

      'Bestimmten Datenssatz anzeigen
      Print
      Print Tab(4); "Modell     : ", Motorrad.Modell
      Print Tab(4); "Farbe      : ", Motorrad.Farbe
      Print Tab(4); "Hubraum    : ", Motorrad.Hubraum
      Print Tab(4); "Kilowatt   : ", Motorrad.Kilowatt
      Print Tab(4); "Fahrgewicht: ", Motorrad.Fahrgewicht
      Print Tab(4); Using "Preis      : #####.##"; Motorrad.Preis
    ElseIf SatzNummer = 0 Then
      AnzahlSaetze = Falsch
    Else
      Print: Print: Beep: Print Tab(4); "Satznummer ausserhalb des Bereichs!"
    End If

    If SatzNummer = 1 Then
      _Clipboard$ = "..\Bilder\Honda-CB450_1965.jpg"
      Shell "BildAnzeigen.exe"
    ElseIf SatzNummer = 2 Then
      _Clipboard$ = "..\Bilder\Zuendapp-KS50-S.jpg"
      Shell "BildAnzeigen.exe"
    ElseIf SatzNummer = 3 Then
      _Clipboard$ = "..\Bilder\Yamaha-250-1965.jpg"
      Shell "BildAnzeigen.exe"
    ElseIf SatzNummer = 4 Then
      _Clipboard$ = "..\Bilder\BMW-R69S.jpg"
      Shell "BildAnzeigen.exe"
    ElseIf SatzNummer = 5 Then
      _Clipboard$ = "..\Bilder\Royal-Enfield-2009.jpg"
      Shell "BildAnzeigen.exe"
    End If
  Loop While BestimmterSatz = 0

End Sub

Show picture:

Code: (Select All)

'Programm 2 (benenne und speichere dieses als Bild.bas und kompiliere es als Bild.exe)
'Wird von "BildAufrufen" aufgerufen. - Name muss mit dem Aufruf uebereinstimmen.

Dim Bild As Long
Dim As String myBild
myBild = _Clipboard$
If _Trim$(myBild) = "" Then System ' Nothing got transferred.

Screen _NewImage(800, 500, 32)
Cls
'Neue Farbe setzen
Color _RGB32(255, 165, 0), _RGB32(0, 0, 0)

Bild = _LoadImage(myBild)

'Neues Fenster - Bildgroesse fuer mittig
_PutImage (((800 - 689) / 2), ((500 - 459) / 2)), Bild

End