Menü im Screen (z.B. für Spiele)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Rokur
Beiträge: 167
Registriert: 29.12.2005 09:58
Computerausstattung: Intel Core2 Quad (4x2,4 GHz), 4096 MB RAM, GForce 8800GTX 786 MB
Windows XP 32 Bit, PureBasic 4.40 (x86)

Menü im Screen (z.B. für Spiele)

Beitrag von Rokur »

Hier mal ein kleines dynamisches Menü-Beispiel, z.B. für Spiele:

Code: Alles auswählen

;Datei menu.pb

#menuFrontColor = #Yellow
#menuBackColor = #Black
#menuSelectedColor = #Red
#menuAbstandY = 50
#menuStartX = 50
#menuStartY = 200
#menuTitleFontSize = 50
#menuItemFontSize = 20
Global menuTitleFont = LoadFont(#PB_Any, "Arial", #menuTitleFontSize, #PB_Font_Bold)
Global menuItemFont = LoadFont(#PB_Any, "Arial", #menuItemFontSize, #PB_Font_Bold)

Global Dim menu.s(0)

Procedure.l showMenu(titel.s, index.l)
  ;Zeigt ein Menü an und gibt den ausgewählten Eintrag zurück, oder -1 wenn nichts ausgewählt wurde
  Define menuIndex.l = index
  Define menuY.l = #menuStartY
  
  ;Index in gültigen Bereich setzen
  If menuIndex < 0
    menuIndex = 0
  ElseIf menuIndex > ArraySize(menu())
    menuIndex = ArraySize(menu())
  EndIf
  
  ;Menü-Schleife
  Repeat
    ;Eingabe
    ExamineKeyboard()
    If KeyboardReleased(#PB_Key_Escape)
      menuIndex = -1
      Break
    ElseIf KeyboardReleased(#PB_Key_Return)
      Break
    ElseIf KeyboardReleased(#PB_Key_Up)
      menuIndex-1
      If menuIndex < 0
        menuIndex = 0
      EndIf
    ElseIf KeyboardReleased(#PB_Key_Down)
      menuIndex+1
      If menuIndex > ArraySize(menu())
        menuIndex = ArraySize(menu())
      EndIf
    EndIf
    ;Ausgabe
    ClearScreen(#menuBackColor)
    StartDrawing(ScreenOutput())
      ;Titel Haupt
      DrawingFont(FontID(menuTitleFont))
      ;Titel Ergänzung
      DrawingFont(FontID(menuTitleFont))
      ;Menüpunkte
      DrawingFont(FontID(menuItemFont))
      menuY.l = #menuStartY
      DrawingMode(#PB_2DDrawing_Outlined)
      For i = 0 To ArraySize(menu())
        If i = menuIndex
          DrawText(#menuStartX, menuY, menu(i), #menuSelectedColor, #menuBackColor)
          Circle(#menuStartX-5-#menuItemFontSize,menuY+(#menuItemFontSize/2), #menuItemFontSize/2, #menuSelectedColor)
          Circle(#menuStartX+10+(#menuItemFontSize/2)+TextWidth(menu(i)),menuY+(#menuItemFontSize/2), #menuItemFontSize/2, #menuSelectedColor)
        Else
          DrawText(#menuStartX, menuY, menu(i), #menuFrontColor, #menuBackColor)
        EndIf
        menuY+#menuAbstandY
      Next i
      ;Sonstiges
    StopDrawing()
    ;
    FlipBuffers()
    Delay(1)
  ForEver
  
  ProcedureReturn menuIndex
EndProcedure
Aufgerufen wird das Ganze z.B. so:

Code: Alles auswählen

;Datei start.pb

#scrWidth = 1280
#scrHeight = 1024
#scrDepth = 32

If Not InitSprite() Or Not InitKeyboard() Or Not InitMouse()
  Debug "Kann DirectX nicht initialisieren!"
  End
EndIf

If Not OpenScreen(#scrWidth, #scrHeight, #scrDepth, "Menü-Test")
  Debug "Kann Screen nicht öffnen!"
  End
EndIf

XIncludeFile "menu.pb"

ReDim menu(3)

menu(0) = "Neues Spiel"
menu(1) = "Spiel Laden"
menu(2) = "Optionen"
menu(3) = "Beenden"

Define menuIndex.l = showMenu("Hauptmenü", 0)
Select menuIndex
  Case -1
    Debug "Menü: Abbruch (ESC gedrückt)"
  Case 0
    Debug "Menü: "+menu(menuIndex)
  Case 1
    Debug "Menü: "+menu(menuIndex)
  Case 2
    Debug "Menü: "+menu(menuIndex)
  Case 3
    Debug "Menü: "+menu(menuIndex)
EndSelect
Rokur
Beiträge: 167
Registriert: 29.12.2005 09:58
Computerausstattung: Intel Core2 Quad (4x2,4 GHz), 4096 MB RAM, GForce 8800GTX 786 MB
Windows XP 32 Bit, PureBasic 4.40 (x86)

Beitrag von Rokur »

Überarbeitete Version, inkl. Beispiel für Untermenüs:

Code ist jetzt in einer Datei und direkt aus der IDE lauffähig

Code: Alles auswählen

#app = "Menü-Test"

If Not InitSprite() Or Not InitKeyboard()
  Debug "Fehler beim Initialisieren von DirectX!"
  End
EndIf

If Not OpenScreen(800,600,32,#app)
  Debug "Fehler beim Öffnen des Screens!"
  End
EndIf

;Menü

#menuFrontColor = #Yellow
#menuBackColor = #Black
#menuSelectedColor = #Red
#menuAbstandY = 50
#menuStartX = 100
#menuStartY = 300
#menuTitleStartX = 50
#menuTitleStartY = 50
#menuTitleFontSize = 50
#menuSubTitleStartX = 50
#menuSubTitleStartY = 200
#menuSubTitleFontSize = 40
#menuItemFontSize = 20
Global menuTitleFont = LoadFont(#PB_Any, "Arial", #menuTitleFontSize, #PB_Font_Bold)
Global menuSubTitleFont = LoadFont(#PB_Any, "Arial", #menuSubTitleFontSize, #PB_Font_Bold)
Global menuItemFont = LoadFont(#PB_Any, "Arial", #menuItemFontSize, #PB_Font_Bold)

Procedure.l showMenu(title.s, Array menu.s(1), index.l)
  ;Zeigt ein Menü an und gibt den ausgewählten Eintrag zurück, oder -1 wenn nichts ausgewählt wurde
  Define i.l = 0
  Define menuIndex.l = index
  Define menuY.l = #menuStartY
  
  ;Index in gültigen Bereich setzen
  If menuIndex < 0
    menuIndex = 0
  ElseIf menuIndex > ArraySize(menu())
    menuIndex = ArraySize(menu())
  EndIf
  
  ;Menü-Schleife
  Repeat
    ;Eingabe
    ExamineKeyboard()
    If KeyboardReleased(#PB_Key_Escape)
      menuIndex = -1
      Break
    ElseIf KeyboardReleased(#PB_Key_Return)
      Break
    ElseIf KeyboardReleased(#PB_Key_Up)
      menuIndex-1
      If menuIndex < 0
        menuIndex = 0
      EndIf
    ElseIf KeyboardReleased(#PB_Key_Down)
      menuIndex+1
      If menuIndex > ArraySize(menu())
        menuIndex = ArraySize(menu())
      EndIf
    EndIf
    ;Ausgabe
    ClearScreen(#menuBackColor)
    StartDrawing(ScreenOutput())
      ;Titel
      DrawingFont(FontID(menuTitleFont))
      DrawText(#menuTitleStartX,#menuTitleStartY,#app,#menuFrontColor,#menuBackColor)
      ;Menüname
      DrawingFont(FontID(menuSubTitleFont))
      DrawText(#menuSubTitleStartX,#menuSubTitleStartY,title,#menuFrontColor,#menuBackColor)
      ;Menüpunkte
      DrawingFont(FontID(menuItemFont))
      menuY.l = #menuStartY
      DrawingMode(#PB_2DDrawing_Outlined)
      For i = 0 To ArraySize(menu())
        If i = menuIndex
          DrawText(#menuStartX, menuY, menu(i), #menuSelectedColor, #menuBackColor)
          Circle(#menuStartX-5-#menuItemFontSize,menuY+(#menuItemFontSize/2), #menuItemFontSize/2, #menuSelectedColor)
          Circle(#menuStartX+10+(#menuItemFontSize/2)+TextWidth(menu(i)),menuY+(#menuItemFontSize/2), #menuItemFontSize/2, #menuSelectedColor)
        Else
          DrawText(#menuStartX, menuY, menu(i), #menuFrontColor, #menuBackColor)
        EndIf
        menuY+#menuAbstandY
      Next i
      ;Sonstiges
    StopDrawing()
    ;
    FlipBuffers()
    Delay(1)
  ForEver
  
  ProcedureReturn menuIndex
EndProcedure

;Hauptmenü
Dim menuMain.s(4)
menuMain(0) = "Neues Spiel"
menuMain(1) = "Spiel laden"
menuMain(2) = "Spiel speichern"
menuMain(3) = "Optionen"
menuMain(4) = "Beenden"
Define menuIndexMain.l = 0
Repeat
  menuIndexMain.l = showMenu("Hauptmenü", menuMain(), menuIndexMain)
  Select menuIndexMain
    Case -1 ;Escape gedrückt
      Break
    Case 0 ;Neues Spiel
      Debug "Menü: "+menuMain(menuIndexMain)
    Case 1 ;Spiel laden
      Debug "Menü: "+menuMain(menuIndexMain)
    Case 2 ;Spiel speichern
      Debug "Menü: "+menuMain(menuIndexMain)
    Case 3 ;Optionen
      Gosub menuOptions
    Case 4 ;Beenden
      Break
    Default
      Break
  EndSelect
ForEver

Goto skipMenu ;Subroutinen überspringen

menuOptions:
  Dim menuOpt.s(0)
  menuOpt(0) = "Zurück"
  Define menuIndexOpt.l = 0
  Repeat
    menuIndexOpt = showMenu("Optionen", menuOpt(), menuIndexOpt)
    Select menuIndexOpt
      Case 0
        Break
      Default
        Break
    EndSelect
  ForEver
Return

menuNewGame:
Return

menuLoadGame:
Return

menuSaveGame:
Return

skipMenu:
Benutzeravatar
ZeHa
Beiträge: 4760
Registriert: 15.09.2004 23:57
Wohnort: Friedrichshafen
Kontaktdaten:

Beitrag von ZeHa »

Nicht schlecht, allerdings waere es etwas sauberer, nicht innerhalb der showMenu()-Funktion eine Menue-Schleife zu haben, sondern dies in eine renderMenu()- und controlMenu()-Funktion aufzuteilen, die der Spieleprogrammierer in seiner Hauptschleife selbst staendig aufruft.

Also statt so...

Code: Alles auswählen

Proc showMenu()
    Repeat : ...render and control menu... : ForEver
EndProc
...eher so:

Code: Alles auswählen

Proc renderMenu()
    ...render menu once...
EndProc

Proc controlMenu()
    ...check controls for menu once...
EndProc

Proc gameLoop()
    Repeat
        If state = #MENU
            renderMenu()
            event = controlMenu()

            Select event
                ; handle menu events
            EndSelect
        EndIf

        If state = #GAME
            renderGame()
            controlGame()
            etc()
        EndIf

        FlipBuffers()
    Forever
EndProc
Natuerlich nur ein grobes Beispiel, aber ich denke man versteht, wie es gemeint ist.
Bild     Bild

ZeHa hat bisher kein Danke erhalten.
Klicke hier, wenn Du wissen möchtest, woran ihm das vorbeigeht.
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag von Andesdaf »

schönes Beispiel :allright:

@ZeHa: weis nicht, ob du dir dafür ein Makro gemacht hast aber in allgemeinen
Codes würde ich Procedure lieber ausschreiben, ist sonst verwirrend.
Win11 x64 | PB 6.20
Benutzeravatar
ZeHa
Beiträge: 4760
Registriert: 15.09.2004 23:57
Wohnort: Friedrichshafen
Kontaktdaten:

Beitrag von ZeHa »

Ja das ist bei mir ein Makro, aber im obigen Falle hab ich das nur gemacht weil ich zu faul zum Tippen war ;) soll ja nur ein kurzes Beispiel sein um das Prinzip zu zeigen, kompilieren tut das Ding so eh nicht
Bild     Bild

ZeHa hat bisher kein Danke erhalten.
Klicke hier, wenn Du wissen möchtest, woran ihm das vorbeigeht.
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag von Andesdaf »

war bloß ein Hinweis, sieht halt etwas komisch aus.
Win11 x64 | PB 6.20
Benutzeravatar
Bisonte
Beiträge: 2470
Registriert: 01.04.2007 20:18

Beitrag von Bisonte »

Flackert das "Menü-Test" nur bei mir oder ist das allgemein so ?

Gotos und Gosubs ? brrr ;)
PureBasic 6.21 (Windows x86/x64) | Windows11 Pro x64 | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | GeForce RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag von Andesdaf »

> Flackert das "Menü-Test" nur bei mir oder ist das allgemein so ?
Bei mir flackert nichts.
Win11 x64 | PB 6.20
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

> Gotos und Gosubs ? brrr

wo?
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag von Andesdaf »

> wo?

Code: Alles auswählen

Repeat
  menuIndexMain.l = showMenu("Hauptmenü", menuMain(), menuIndexMain)
  Select menuIndexMain
    Case -1 ;Escape gedrückt
      Break
    Case 0 ;Neues Spiel
      Debug "Menü: "+menuMain(menuIndexMain)
    Case 1 ;Spiel laden
      Debug "Menü: "+menuMain(menuIndexMain)
    Case 2 ;Spiel speichern
      Debug "Menü: "+menuMain(menuIndexMain)
    Case 3 ;Optionen
      Gosub menuOptions ; <<<<<<<<<<<<<<<
    Case 4 ;Beenden
      Break
    Default
      Break
  EndSelect
ForEver

Goto skipMenu ;<<<<<<<<<<<<<< Subroutinen überspringen
Win11 x64 | PB 6.20
Antworten