Es ist halt sehr schade das es kein ResizeScreen() gibt.
Hat hier jemand Win/Linux/MacOS - Api-Tipps !
Hier mal noch ein kleines Beispiel:
Code: Alles auswählen
; Mein kleiner fehlerhafter Maus-Menü-Test
UsePNGImageDecoder()
InitSprite() : InitMouse() : InitKeyboard()
Enumeration
#MWin
#CursorSprite
EndEnumeration
Structure WinPos
x.i
y.i
h.i
w.i
EndStructure
Global MWin.WinPos
MWin\x = 0
MWin\y = 0
MWin\w = 800
MWin\h = 600
Structure MPoint
x.d
y.d
EndStructure
Structure MText
x.d
y.d
w.d
h.d
sel.i
txt.s
EndStructure
Global Dim SelMenu.MText(2)
Global CMouse.MPoint
Procedure.b OverMenu(*MousePos.MPoint, *SelMenu.MText)
If ((*MousePos\x >= *SelMenu\x) And (*MousePos\x <= (*SelMenu\x + *SelMenu\w)) And (*MousePos\y >= *SelMenu\y) And (*MousePos\y <= *SelMenu\y + *SelMenu\h))
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.b ScreenOpen()
If OpenWindowedScreen(WindowID(#MWin),0,0,WindowWidth(#MWin),WindowHeight(#MWin),0,0,0)
SetFrameRate(60)
If Not CatchSprite(#CursorSprite, ?Cursor)
End
EndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure ResizeScreen()
CloseScreen() ;???
ScreenOpen()
EndProcedure
Procedure.b DrawMenu()
Protected Dim Text.s(2)
SelMenu(0)\txt = "Auflösung 800 x 600 (4:3)"
SelMenu(1)\txt = "Auflösung 1024 x 768 (4:3)"
SelMenu(2)\txt = "Auflösung 1366 × 768 (16:9)"
If StartDrawing(ScreenOutput())
For i = 0 To 2
SelMenu(i)\w = TextWidth(SelMenu(i)\txt)
SelMenu(i)\h = TextHeight(SelMenu(i)\txt)
SelMenu(i)\x = MWin\w / 2 -(SelMenu(i)\w / 2)
SelMenu(i)\y = MWin\h / 2 -(i*40) + SelMenu(i)\h
SelMenu(i)\sel = i
If(OverMenu(@CMouse, @SelMenu(i)))
DrawText(SelMenu(i)\x, SelMenu(i)\y, SelMenu(i)\txt, RGB(255,255,0))
If MouseButton(#PB_MouseButton_Left)
If SelMenu(i)\sel = 0
MWin\w = 800 : MWin\h = 600
ElseIf SelMenu(i)\sel = 1
MWin\w = 1024 : MWin\h = 768
ElseIf SelMenu(i)\sel = 2
MWin\w = 1366 : MWin\h = 768
EndIf
ResizeWindow(#MWin, #PB_Ignore, #PB_Ignore, MWin\w, MWin\h)
EndIf
Else
DrawText(SelMenu(i)\x, SelMenu(i)\y, SelMenu(i)\txt, RGB(255,255,255))
EndIf
Next i
StopDrawing()
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
;Main
If OpenWindow(#MWin,MWin\x,MWin\y,MWin\w,MWin\h,"Maus-Menü",#PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
BindEvent( #PB_Event_SizeWindow, @ResizeScreen(), #MWin, #PB_All, #PB_All )
If ScreenOpen()
Repeat
ExamineMouse()
ReleaseMouse(#False)
CMouse\x = MouseX()
CMouse\y = MouseY()
ExamineKeyboard()
ClearScreen(RGB(0,0,0))
DrawMenu()
DisplayTransparentSprite(#CursorSprite, CMouse\x, CMouse\y)
FlipBuffers():Delay(10)
Repeat
EventID = WindowEvent()
Select EventID
Case #PB_Event_CloseWindow
End
EndSelect
Until EventID = 0
Until KeyboardPushed(#PB_Key_Escape) Or EventID = #PB_Event_CloseWindow
EndIf
EndIf
DataSection
Cursor:
Data.q $0A1A0A0D474E5089,$524448490D000000,$170000000F000000,$82315B0000000208,$4E527406000000EB
Data.q $6E00000000000053,$70090000009107A6,$00C40E0000735948,$1B0E2B9501C40E00,$544144497D000000
Data.q $20C00DCB919D8D38,$498758F20CD2C50C,$44A87A1160ED8A18,$086D921B94F90A51,$0E804A5280174510
Data.q $BDA1E15E18C60008,$A082DB4AC25DA4C2,$0A3E96C26B4BE10D,$87AE10B4282F7A27,$36EB4A530389AD6E
Data.q $58A7FD6D956B5CE7,$679E4A63382F69E9,$9E538D16D999BDF5,$88C39AAAEEF7A889,$7FBFE00F2C4EEB3C
Data.q $8A09FED3D844A903,$4E454900000000F8,$000000826042AE44
EndDataSection