11-22-2025, 05:35 PM
Here the final cut of Tool Testing Screen Modes :
as you can see in the Working in progress section of this forum I asked help for solving my mistakes raising up an uncontrolled mouse events.
I got the help of Steve and Petr with different methods solving the issue.
So, back to the school, I followed their ideas and methods and here there are the 2 version of the tool:
Steve's method
Petr's method
Thanks for testing your OS for SCREEN modes.
If issues arise please post to developer team.
as you can see in the Working in progress section of this forum I asked help for solving my mistakes raising up an uncontrolled mouse events.
I got the help of Steve and Petr with different methods solving the issue.
So, back to the school, I followed their ideas and methods and here there are the 2 version of the tool:
Steve's method
Code: (Select All)
_Title "Lubuntu window's cohordinates bug"
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M1, M2, M3
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M1 = 0: M2 = 0: M3 = 0
Do While Action <> 99
WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
End
Sub test (Sm As String, F As String)
Cls
r = 1
Do
WaitStopMouseInput
mx = _MouseX
my = _MouseY
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print mx; " "; Int(my / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
Select Case Sm
Case "0"
' do not do graphic lines
Case Else
' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End Select
_Limit 20
Loop Until _MouseButton(2) = -1 Or InKey$ = Chr$(27)
WaitStopMouseInput
Screen 0
Cls
End Sub
Sub WaitStopMouseInput
Do While _MouseInput
Loop ' loop to clean mouse input buffer
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
'up action
S = S + 1
If S > 10 Then S = 0
Case 2
' down action
S = S - 1
If S < 0 Then S = 10
Case 3, 99
' execute action or exit
Exit Sub
End Select
A = 0 ' it restores neutral value of A
Select Case S
Case 0
Sm = "0"
F = "80/40 width * 25/43/50 height"
Case 1
Sm = "1"
F = " 320 200"
Case 2
Sm = "2"
F = "640 200"
Case 3
Sm = "7"
F = "320 200"
Case 4
Sm = "8"
F = "640 200"
Case 5
Sm = "9"
F = "640 200"
Case 6
Sm = "10"
F = "640 350"
Case 7
Sm = "11"
F = "640 480"
Case 8
Sm = "12"
F = "640 480"
Case 9
Sm = "13"
F = "320 200"
Case 10
Sm = "32bit"
F = "variable W & H "
End Select
Loop
End Sub
Function TakeInput (Action As Integer)
Action = 0
WaitStopMouseInput
C$ = InKey$
If (C$ = Chr$(27) Or ((_MouseButton(1) = -1) And (_MouseButton(2) = -1))) Then Action = 99
If (C$ = "U" Or (_MouseButton(1) = 0 And M1 = -1)) Then Action = 1
If (C$ = "D" Or (_MouseButton(2) = 0 And M2 = -1)) Then Action = 2
If (C$ = Chr$(13) Or (_MouseButton(3) = 0 And M3 = -1)) Then Action = 3
M1 = _MouseButton(1): M2 = _MouseButton(2): M3 = _MouseButton(3) ' store actual state of mouse buttons
TakeInput = Action
End Function
Petr's method
Code: (Select All)
_Title "Lubuntu window's cohordinates bug"
''Screen Text Graphics Colors Video Text Default
'' Mode Rows Columns Width Height Attrib. BPP Pages Block QB64 Font
'' 0 25/43/50 80/40 No graphics 16/16 DAC 4 0-7 ----- _FONT 16
'' 1 25 40 320 200 16/4 BG 4 none 8 X 8 _FONT 8
'' 2 25 80 640 200 2/mono 1 none 8 X 8 _FONT 8
'' .................................................................................
'' 7 25 40 320 200 16/16 DAC 4 0-7 8 X 8 _FONT 8
'' 8 25 80 640 200 16/16 4 0-3 8 X 8 _FONT 8
'' 9 25 80 640 350 16/64 DAC 4 0-1 8 X 14 _FONT 14
'' 10 25 80 640 350 4/2 GScale 2 none 8 X 14 _FONT 14
'' 11 30/60 80 640 480 2/mono 1 none 8 X 16 _FONT 16
'' 12 30/60 80 640 480 16/262K 4 none 8 X 16 _FONT 16
'' 13 25 40 320 200 256/65K 8 none 8 X 8 _FONT 8
'' _NEWIMAGE width. height, 32
Randomize Timer
Dim ScrM As Integer, ScrMod As String, FeaT As String, Action As Integer
Dim Shared As Integer M(1 To 3)
ScrM = 0: ScrMod = "0": FeaT = "80/40 width * 25/43/50 height": Action = 0
M(1) = 0: M(2) = 0: M(3) = 0 ' 0 = no event 1 = inclicking 2 = click
Do While Action <> 99
WaitStopMouseInput
Mainscreen
Mainloop ScrM, ScrMod, FeaT, Action
WaitStopMouseInput
If Action = 3 Then
If ScrM = 10 Then
Screen _NewImage(1000, 800, 32)
Else
Screen Val(ScrMod)
End If
test ScrMod, FeaT
End If
Loop
End
Sub test (Sm As String, F As String)
Cls
r = 1
Do
M1 = 0: M2 = 0: M3 = 0
WaitStopMouseInput
mx = _MouseX
my = _MouseY
For row = 1 To 10
Select Case Sm
Case "32bit"
Color _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Case "2", "11"
Color 1
Case "10"
Color Int(Rnd * 3) + 1
Case Else
Color row
End Select
If Sm = "0" Then r = 1 Else r = _FontHeight
Locate row, 1
Print mx; " "; Int(my / r); " "; row
Next row
Locate 22
Print "Screen mode " + Sm + " " + F
Print "Press RIGHT mouse button or Escape key to exit";
Select Case Sm
Case "0"
' do not do graphic lines
Case Else
' it draws 2 lines to show vertexes and center of the screen, more a box on the edge of screen
Line (1, 1)-(_Width(0), _Height(0))
Line (_Width(0), 1)-(1, _Height(0))
Line (1, 1)-(_Width(0) - 1, _Height(0) - 1), , B
End Select
_Limit 20
Loop Until M(2) = 2 Or InKey$ = Chr$(27)
WaitStopMouseInput
Screen 0
Cls
End Sub
Sub WaitStopMouseInput
Do While _MouseInput
Loop ' loop to clean mouse input buffer
'here mousevent must be translated into program events
For i = 1 To 3
Select Case M(i)
Case 0
' no event status
If _MouseButton(i) = -1 Then M(i) = 1
Case 1
' inclicking status
If _MouseButton(i) = 0 Then M(i) = 2
Case 2
'click status
Rem nothing to do here for the program goal
End Select
Next
End Sub
Sub Mainscreen
Screen 0
Print "Tool for testing the setting of screen viewport on the window application"
Locate 3
Color 5
Print "press U for Previous Screen Mode and D for Following Screen Mode"
Print " Enter for testing selected Screen mode"
Color 4
Print "press Left button of mouse for Previous Screen Mode and Right button of "
Print " mouse for following Screen Mode"
Print " Middle button of mouse for testing selected Screen Mode"
Color 14
Print " press Escape key or together Left and Right mouse buttons for quitting"
Color 1
Locate 13
Print "SCREEN " + Space$(15) + " Features"
End Sub
Sub Mainloop (S As Integer, Sm As String, F As String, A As Integer)
Do
Locate 14, 1
Print Space$(80);
Locate 14, 1
Print " " + Sm + Space$(15 - (Len(Sm))) + F
While TakeInput(A) = 0
_Limit 20
Wend
Select Case A
Case 1
'up action
S = S + 1
If S > 10 Then S = 0
Case 2
' down action
S = S - 1
If S < 0 Then S = 10
Case 3, 99
' execute action or exit
Exit Sub
End Select
A = 0 ' it restores neutral value of A
Select Case S
Case 0
Sm = "0"
F = "80/40 width * 25/43/50 height"
Case 1
Sm = "1"
F = " 320 200"
Case 2
Sm = "2"
F = "640 200"
Case 3
Sm = "7"
F = "320 200"
Case 4
Sm = "8"
F = "640 200"
Case 5
Sm = "9"
F = "640 200"
Case 6
Sm = "10"
F = "640 350"
Case 7
Sm = "11"
F = "640 480"
Case 8
Sm = "12"
F = "640 480"
Case 9
Sm = "13"
F = "320 200"
Case 10
Sm = "32bit"
F = "variable W & H "
End Select
Loop
End Sub
Function TakeInput (Action As Integer)
Action = 0
WaitStopMouseInput
C$ = InKey$
If (C$ = Chr$(27) Or (M(1) = 1 And M(2) = 1)) Then Action = 99 'quitting
If (C$ = "U" Or M(1) = 2) Then Action = 1: M(1) = 0 'rolling up options
If (C$ = "D" Or M(2) = 2) Then Action = 2: M(2) = 0 ' rolling down options
If (C$ = Chr$(13) Or M(3) = 2) Then Action = 3: M(3) = 0 'executing selected options
TakeInput = Action
End Function
Thanks for testing your OS for SCREEN modes.
If issues arise please post to developer team.