📄 frmstris.frm
字号:
VERSION 5.00
Begin VB.Form frmStris
AutoRedraw = -1 'True
Caption = "Stris"
ClientHeight = 5820
ClientLeft = 165
ClientTop = 450
ClientWidth = 11250
Icon = "frmStris.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5820
ScaleWidth = 11250
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkBalls
Caption = "&Extent with balls"
Height = 285
Left = 2160
TabIndex = 17
Top = 5295
Width = 1575
End
Begin VB.CommandButton cmdStartStop
Caption = "&Start"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 315
TabIndex = 16
Top = 5175
Width = 1515
End
Begin VB.PictureBox picBg
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1920
Left = 7365
ScaleHeight = 128
ScaleMode = 3 'Pixel
ScaleWidth = 128
TabIndex = 7
Top = 990
Visible = 0 'False
Width = 1920
End
Begin VB.Timer tmrPlay
Left = 7305
Top = 1005
End
Begin VB.Timer Tmr1
Left = 7305
Top = 360
End
Begin VB.PictureBox picSqrs
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2175
Left = 7335
Picture = "frmStris.frx":030A
ScaleHeight = 145
ScaleMode = 3 'Pixel
ScaleWidth = 16
TabIndex = 6
Top = 2910
Visible = 0 'False
Width = 240
End
Begin VB.PictureBox P1
AutoRedraw = -1 'True
Height = 4860
Left = 2100
ScaleHeight = 320
ScaleMode = 3 'Pixel
ScaleWidth = 329
TabIndex = 1
Top = 150
Width = 4995
End
Begin VB.PictureBox P2
AutoRedraw = -1 'True
Height = 1020
Left = 540
ScaleHeight = 64
ScaleMode = 3 'Pixel
ScaleWidth = 64
TabIndex = 0
Top = 870
Width = 1020
End
Begin VB.Image imgHelp
Appearance = 0 'Flat
Height = 480
Left = 810
MouseIcon = "frmStris.frx":1048
MousePointer = 99 'Custom
Picture = "frmStris.frx":1352
ToolTipText = "Help"
Top = 4410
Width = 480
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Speed"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 270
Index = 3
Left = 300
TabIndex = 11
Top = 3825
Width = 855
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Level"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 270
Index = 2
Left = 300
TabIndex = 10
Top = 3405
Width = 855
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Lines"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 270
Index = 1
Left = 300
TabIndex = 9
Top = 3000
Width = 885
End
Begin VB.Label lbl
BackStyle = 0 'Transparent
Caption = "Score"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 360
Index = 0
Left = 585
TabIndex = 8
Top = 2025
Width = 975
End
Begin VB.Image Image1
Height = 480
Left = 195
Picture = "frmStris.frx":165C
Top = 135
Width = 480
End
Begin VB.Label lblSpeed
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 330
Index = 0
Left = 1170
TabIndex = 5
Top = 3795
Width = 570
End
Begin VB.Label lblLevel
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 330
Index = 0
Left = 1170
TabIndex = 4
Top = 3390
Width = 570
End
Begin VB.Label lblLines
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 330
Index = 0
Left = 1170
TabIndex = 3
Top = 2985
Width = 570
End
Begin VB.Label lblScore
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0000000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 390
Index = 0
Left = 300
TabIndex = 2
Top = 2385
Width = 1515
End
Begin VB.Label lblLines
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 330
Index = 1
Left = 1200
TabIndex = 14
Top = 2985
Width = 570
End
Begin VB.Label lblLevel
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 330
Index = 1
Left = 1200
TabIndex = 13
Top = 3390
Width = 570
End
Begin VB.Label lblSpeed
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 330
Index = 1
Left = 1200
TabIndex = 12
Top = 3795
Width = 570
End
Begin VB.Label lblScore
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0000000"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 390
Index = 1
Left = 300
TabIndex = 15
Top = 2400
Width = 1515
End
End
Attribute VB_Name = "frmStris"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'*** playing Field ***
Dim mField(31, 21) As Long
'*** objects / 'pieces' build with '4 squares' ***
Dim obj(8, 6) As Long ' objectdata
Dim nxtobjnr As Long, objnr As Long
Dim ox As Long, oy As Long ' place in mField
Dim hox(3) As Long ' rel. place of squares now
Dim hoy(3) As Long
Dim nox(3) As Long ' rel. place of squares next (preview)
Dim noy(3) As Long
Dim vox(3) As Long ' 4! squares to remember (to erase previous)
Dim voy(3) As Long
Dim vobjfl As Long
Dim SLevel(99) As STRISLEVEL
'*** other ***
Dim Score As Long, Level As Long, Lines As Long, vLin As Long
Dim mTime As Single ' the speed of the falling pieces (increasing from start-speed)
Dim Stat As Long ' is a piece still moveable
Dim KeyPze As Boolean ' =False when SPACE key is pushed = piece falls fast
Dim Playing As Boolean ' game is on, no pauzing currently
Dim ContFl As Boolean ' ok to continue flag
Dim StartLevel As Long, StartedAt As Long
Dim PieceMode As Long ' determines the no. of pieces-types
' 7='without balls' 8='with balls'
Dim Gr As Long ' size of one square in a piece = constant
Dim px1 As Long, px2 As Long ' size of the playing field of the current level
Dim py1 As Long, py2 As Long
Private Sub GameOver()
Dim I As Long
ReDim names(1 To 7) As String, scores(1 To 7) As Long
Dim txt As String
' turn everything off
Playing = False
KeyPreview = False
KeyPze = True
tmrPlay.Enabled = False
Tmr1.Enabled = False
'judge score
names(1) = "Super ": scores(1) = 1000000
names(2) = "Expert ": scores(2) = 800000
names(3) = "Experienced ": scores(3) = 600000
names(4) = "Good ": scores(4) = 400000
names(5) = "Pupil ": scores(5) = 200000
names(6) = "Beginner ": scores(6) = 100000
names(7) = "Poor ": scores(7) = 50000
For I = 1 To 7
If Score > scores(I) Then Exit For
Next I
If I > 7 Then I = 7
DialogTitle = "Stris - Game over"
txt = "With a score of " & Format(Score) & vbCrLf
txt = txt & "your achievement is situated" & vbCrLf
txt = txt & "on the niveau :" & vbCrLf & vbCrLf
txt = txt & names(I) & vbCrLf
DialogText = txt
frmDial.Show 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -