SELECT CASES ???

[Pete]

Thanks, I forgot that one was in this thread.

The syntax error is the CALL line. He is trying to call a function without including a procedure statement or use of a return value.

Functions...

Code: (Select All)

DEFSTR P
PETE - ' Syntax error

PRINT PETE

Professional = PETE + PETE
PRINT Professional

FUNCTION PETE
    PETE = "GREAT!"
END FUNCTION

Pete

[Kernelpanic]

SMcNeill - Because FUNCTIONS *have* to be returned to a variable or used in conjecture with a SUB style command such as PRINT.

You're right! - I are gone through everything(?) what crossed my mind of now, but the damn picture just won't show. Look at Case 3 Maybe that's not possible. . . Maybe no new console can be opened from a program? That would be practically two.

The sub routine is this program that works. https://qb64phoenix.com/forum/showthread...39#pid7939
And both are in the same directory. The image can be found as basic, but if a new output console cannot be opened, it is of no use.

Code: (Select All)

$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 Bildzeigen(SatzNummer as Integer)
Declare Function SatzLesen()

Dim As Integer auswahl, SatzNummer

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
    'SatzNummer = SatzLesen
    'Call Bildzeigen(SatzNummer)
    Call Bildzeigen(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

Function 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
  Loop While BestimmterSatz = 0
  SatzLesen = SatzNummer
End Function

Sub Bildzeigen (SatzNummer As Integer)
  'Bild in neuem Fenster aufrufen

  Dim Bild As Long, myFont As Long
  Dim Text As String
  ', Text2 As String


  'Input "Satznummer: ", SatzNummer

  If SatzNummer = 1 Then
    Screen _NewImage(800, 600, 32)
    Cls
    'Neue Farbe setzen
    Color _RGB32(255, 165, 0), _RGB32(0, 0, 0)

    Bild = _LoadImage("..\Bilder\Yamaha-250-1965.jpg")

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

    Text = "Die Yamaha als Zweitakter mit 250 ccm - 1965"
    'Text2 = " and leaves before she is left."
    myFont = _LoadFont("C:\Windows\Fonts\Tahoma.ttf", 25, "")
    _Font myFont

    'Zeile, Spalte und die Bildhoehe(!) beruecksichtigen
    _PrintString (135, 490), Text
    '_PrintString (256, 537), Text2

    'Farbe und Schrift zuruecksetzen
    Color _RGB32(255), _RGB32(0, 0, 0)
    _Font 16
    _FreeFont myFont

  End If
End Sub

[Pete]

Do you get an unhandled error #258 when you try to display the motorcycle image in the other program? If so, check to make sure your file path is correct. It appears you coded the other example to find the Bilder folder as one-level up from the folder you are running your program in. If the Bilder folder is a folder in your current folder, get rid of the ..\ part.

Pete

[Kernelpanic]

Do you get an unhandled error #258 when you try to display the motorcycle image in the other program? If so, check to make sure your file path is correct. It appears you coded the other example to find the Bilder folder as one-level up from the folder you are running your program in. If the Bilder folder is a folder in your current folder, get rid of the ..\ part.

Pete

No! The path is correct. - It should at least open a new console, right?

[Pete]

No. Not in a new "console" or window, in the same window. Consoles are text only, so that option is out for this graphics routine. You want to open an image in a new separate window, right?

To do so, you'd have to write a separate program, pass the info to it, and shell to it from the part of your code that now does the your _PUTIMAGE routine.

Example:

Program 1 (Name this anything you want.)

Code: (Select All)

'Bild in neuem Fenster aufrufen

DIM AS INTEGER SatzNummer
DIM Bild AS LONG, myFont AS LONG
DIM Text AS STRING
', Text2 As String

INPUT "Satznummer: ", SatzNummer

IF SatzNummer = 1 THEN
    _CLIPBOARD$ = "..\Bilder\Yamaha-250-1965.jpg"
    SHELL "bild.exe"
END IF

Program 2 (Name and save this as Bild.bas and compile it as Bild.exe)

Code: (Select All)

DIM AS INTEGER SatzNummer
DIM Bild AS LONG, myFont AS LONG
DIM AS STRING Text, myBild
myBild = _CLIPBOARD$
IF _TRIM$(myBild) = "" THEN SYSTEM ' Nothing got transferred.

SCREEN _NEWIMAGE(800, 600, 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), 15), Bild

Text = "Die Yamaha als Zweitakter mit 250 ccm - 1965"
'Text2 = " and leaves before she is left."
myFont = _LOADFONT("C:\Windows\Fonts\Tahoma.ttf", 25, "")
_FONT myFont

'Zeile, Spalte und die Bildhoehe(!) beruecksichtigen
_PRINTSTRING (135, 490), Text
'_PrintString (256, 537), Text2

'Farbe und Schrift zuruecksetzen
COLOR _RGB32(255), _RGB32(0, 0, 0)
_FONT 16
_FREEFONT myFont

It uses the _CLIPBOARD statement to transfer the file path and file between programs.

Anyway, if you want more than a single window, this is what I developed to make it so. Just run program #1 and input 1. A new window will open with your motorcycle pic.

Pete

[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

[Pete]

Nice! Glad we got it working. It's up to you if you want to continue using that _CLIPBOARD method or create a data file to access and pass the information that way. I even thought about experimenting with a way to pipe it, via the shell but I didn't want to complicate what _CLIPBOARD would demonstrate so easily.

Pete