Type POINT_FIX ‘δομή συντεταγμένων
X As Integer
Y As Integer
c_color As Long
End Type

Type CANAB_FIX ‘οριζεται η περιοχή σχεδίασης
X As Integer
Y As Integer
End Type

Type THESIS_FIX
‘ορισμός των κατειλημμένων θέσεων
XY() As Byte
End Type

Type TOUBLO_FIX ‘ορίζεται το τουβλάκι
POINT() As POINT_FIX
End Type

Type TOUBLA_FIX ‘όλλα τα τούβλα – στο πρόγραμμα υπάρχουν 6
TOUBLO() As TOUBLO_FIX
End Type

Type CONT_TION_FIX
‘δεδομένα για ταχύτητα παιχνιδιού , τούβλο σε κίνηση κτλ.

FLAG As Byte ‘ 0 = VGALE KAINOURIO
TIME_EVENT As Byte ‘GIA EPANEKINISI XRONOU
TIME_START As Double
TIME_VOL As Double
CUR_POS As POINT_FIX
CUR_TOUBLO As THESIS_FIX
max_x As Byte
max_y As Byte
min_x As Byte
min_y As Byte
ROT As Integer ‘0=NORMAL 1=+90 -1=-90 …
cur_delete As Byte
sum_bonus As Double
level As Byte
End Type

‘Δημόσια δεδομένα δεδομένων

Public CONT_TION As CONT_TION_FIX
Public TOUBLA As TOUBLA_FIX
Public CANAB As CANAB_FIX
Public thesis As THESIS_FIX
Public KEYASCII As Integer

‘συναρτήσεις

Private Sub Form_Load() ‘εκκίνηση προγράμματος
For a = 1 To 10
level.AddItem a
Next a

KEYASCII = -1
new_game (lev) ‘νέο παιχνίδι
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
‘καταχώρηση πλήκτρου που πατήθηκε σε περίπτωση του υπάρχει focus στην φόρμα
KEYASCII = KeyCode
End Sub

Private Sub show_graph() ‘εμφάνιση γραφικών

Pic.AutoRedraw = True
Pic.Cls

TMX = Pic.ScaleWidth / CANAB.X
TMY = Pic.ScaleHeight / CANAB.Y

For Y = 0 To CANAB.Y – 1
For X = 0 To CANAB.X – 1

‘THESIS.XY(X, Y) = Int(Rnd * 2)

col2 = RGB(220, 200, 50)
col = RGB(100, 150, 250)

If thesis.XY(X, Y) = 1 Then
X_X = TMX * X
Y_Y = TMY * Y

Pic.DrawWidth = 1

Pic.Line (X_X, Y_Y)-(X_X + TMX, Y_Y + TMY), col, B

Pic.DrawWidth = 5

Pic.Line (X_X + Int(TMX / 2), Y_Y + Int(TMY / 2))-(X_X + Int(TMX / 2), Y_Y + Int(TMY / 2)), col2, B

End If

Next X
Next Y

If CONT_TION.FLAG > 0 Then

For Y = 0 To 3
For X = 0 To 3

KT = CONT_TION.CUR_TOUBLO.XY(X, Y)

‘MsgBox “ERG”

If KT = 1 Then

X_X = TMX * (X + CONT_TION.CUR_POS.X)
Y_Y = TMY * (Y + CONT_TION.CUR_POS.Y)

Pic.DrawWidth = 1

Pic.Line (X_X, Y_Y)-(X_X + TMX, Y_Y + TMY), col, B

Pic.DrawWidth = 5
Pic.Line (X_X + Int(TMX / 2), Y_Y + Int(TMY / 2))-(X_X + Int(TMX / 2), Y_Y + Int(TMY / 2)), col2, B

End If

Next X
Next Y

End If

Pic.AutoRedraw = FalseEnd Sub

Private Sub make_touble() ‘υλοποίηση των τούβλων – ορισμός σχημάτων

ReDim TOUBLA.TOUBLO(5)

‘ * * # * *

‘ * * # * *

‘ * * # * *

‘ * * # * *

‘ * * * * *

With TOUBLA.TOUBLO(0)

ReDim TOUBLA.TOUBLO(0).POINT(3)

.POINT(0).X = 2: .POINT(0).Y = 0

.POINT(1).X = 2: .POINT(1).Y = 1

.POINT(2).X = 2: .POINT(2).Y = 2

.POINT(3).X = 2: .POINT(3).Y = 3

End With

‘ * * # # *

‘ * * # * *

‘ * * # * *

‘ * * * * *

‘ * * * * *

With TOUBLA.TOUBLO(1)

ReDim TOUBLA.TOUBLO(1).POINT(3)

.POINT(0).X = 2: .POINT(0).Y = 0

.POINT(1).X = 2: .POINT(1).Y = 1

.POINT(2).X = 2: .POINT(2).Y = 2

.POINT(3).X = 3: .POINT(3).Y = 0

End With

‘ * # # * *

‘ * * # * *

‘ * * # * *

‘ * * * * *

‘ * * * * *

With TOUBLA.TOUBLO(2)

ReDim TOUBLA.TOUBLO(2).POINT(3)

.POINT(0).X = 2: .POINT(0).Y = 0

.POINT(1).X = 2: .POINT(1).Y = 1

.POINT(2).X = 2: .POINT(2).Y = 2

.POINT(3).X = 1: .POINT(3).Y = 0

End With

‘ * # * * *

‘ * # # * *

‘ * * # * *

‘ * * * * *

‘ * * * * *

With TOUBLA.TOUBLO(3)

ReDim TOUBLA.TOUBLO(3).POINT(3)

.POINT(0).X = 1: .POINT(0).Y = 1

.POINT(1).X = 1: .POINT(1).Y = 2

.POINT(2).X = 2: .POINT(2).Y = 2

.POINT(3).X = 2: .POINT(3).Y = 3

End With

‘ * * * # *

‘ * * # # *

‘ * * # * *

‘ * * * * *

‘ * * * * *

With TOUBLA.TOUBLO(4)

ReDim TOUBLA.TOUBLO(4).POINT(3)

.POINT(0).X = 3: .POINT(0).Y = 0

.POINT(1).X = 3: .POINT(1).Y = 1

.POINT(2).X = 2: .POINT(2).Y = 1

.POINT(3).X = 2: .POINT(3).Y = 2

End With

‘ * * * * *

‘ * # # # *

‘ * # # # *

‘ * # # # *

‘ * * * * *

With TOUBLA.TOUBLO(5)

ReDim TOUBLA.TOUBLO(5).POINT(3)

.POINT(0).X = 1: .POINT(0).Y = 1

.POINT(1).X = 2: .POINT(1).Y = 1

.POINT(2).X = 1: .POINT(2).Y = 2

.POINT(3).X = 2: .POINT(3).Y = 2

End With

End Sub

Private Sub level_Click()

ss = MsgBox(“Θέλετε να ξεκινήσετε νέο παιχνίδι ?”, vbOKCancel)

If ss = vbOK Then

If level.ListIndex >= 0 Then

new_game (level.ListIndex)

End If

End If

Pic.SetFocus

End Sub

Private Sub new_game(lev) ‘νέο παιχνίδι

CONT_TION.level = lev

tim = 0.5 – lev / 20

CANABX = 10 + lev / 2

CANABY = Int(CANABX * Pic.ScaleHeight / Pic.ScaleWidth)

CONT_TION.TIME_VOL = tim

CANAB.X = CANABX

CANAB.Y = CANABY

CONT_TION.sum_bonus = 0

Label3.Caption = CONT_TION.sum_bonus

Call make_touble

ReDim thesis.XY(0, 0)

ReDim thesis.XY(CANAB.X, CANAB.Y)

CONT_TION.FLAG = 0

Call show_graph

End Sub

Private Sub Pic_KeyDown(KeyCode As Integer, Shift As Integer)

‘καταχώρηση πλήκτρου που πατήθηκε

KEYASCII = KeyCode

End Sub

‘χρονόμετρο για την κίνηση του τούβλου και τις ενέργειες του χρήστη

Private Sub Timer1_Timer()

If CONT_TION.FLAG = 0 Then

Randomize Timer

CONT_TION.CUR_POS.Y = 0

CONT_TION.CUR_POS.X = Int(CANAB.X / 5)

tt = Int(Rnd * 3)

ReDim CONT_TION.CUR_TOUBLO.XY(4, 4)

kk = Int(Rnd * (6))

For KK2 = 0 To UBound(TOUBLA.TOUBLO(kk).POINT())

X = TOUBLA.TOUBLO(kk).POINT(KK2).X

Y = TOUBLA.TOUBLO(kk).POINT(KK2).Y

CONT_TION.CUR_TOUBLO.XY(X, Y) = 1

Next KK2

Rem ‘find max y,max x

Call norm_min_max

CONT_TION.FLAG = 1

End If ‘FLAG=0

If CONT_TION.FLAG = 1 Then

If CONT_TION.TIME_EVENT = 0 Then

CONT_TION.TIME_START = Timer

CONT_TION.TIME_EVENT = 1

End If

If CONT_TION.TIME_EVENT = 1 Then

ff = Abs(Timer – CONT_TION.TIME_START)

If ff > CONT_TION.TIME_VOL Then

CONT_TION.TIME_EVENT = 0

flat = 0

If pro_fragm(0, 1) = False Then CONT_TION.CUR_POS.Y = CONT_TION.CUR_POS.Y + 1 Else flat = 1

If fragment() = True Or flat = 1 Then

Call freeze

CONT_TION.FLAG = 0

End If

End If

End If

End If

If KEYASCII = 39 Then

If pro_fragm(1, 0) = False Then CONT_TION.CUR_POS.X = CONT_TION.CUR_POS.X + 1

Call fragment

End If

If KEYASCII > 0 Then

If UCase(Chr$(KEYASCII)) = (“Z”) Then

rot_change (-1)

End If

If UCase$(Chr$(KEYASCII)) = (“X”) Then

rot_change (1)

End If

If KEYASCII = 37 Then

If pro_fragm(-1, 0) = False Then CONT_TION.CUR_POS.X = CONT_TION.CUR_POS.X – 1

Call fragment

End If

If KEYASCII = 40 Then

If pro_fragm(0, 1) = False Then CONT_TION.CUR_POS.Y = CONT_TION.CUR_POS.Y + 1

If fragment = True Or pro_fragm(0, 1) = True Then

Call freeze

CONT_TION.FLAG = 0

End If

End If

End If ‘ key>0

show_graph

KEYASCII = -1

End Sub

Private Sub norm_min_max() ‘διάφοροι έλεγχοι

rx = 0

ry = 0

rx2 = 4

ry2 = 4

For Y = 0 To 4

For X = 0 To 4

If CONT_TION.CUR_TOUBLO.XY(X, Y) = 1 Then

If X > rx Then rx = X

If Y > ry Then ry = Y

If X < rx2 Then rx2 = X

If Y < ry2 Then ry2 = Y

End If

Next X

Next Y

CONT_TION.max_x = rx

CONT_TION.max_y = ry

CONT_TION.min_x = rx2

CONT_TION.min_y = ry2

End Sub

Private Sub rot_change(rt) ‘περιστροφή τούβλου

Dim thes As THESIS_FIX

tt = 4

ReDim thes.XY(tt, tt)

For Y = 0 To tt

For X = 0 To tt

thes.XY(X, Y) = CONT_TION.CUR_TOUBLO.XY(X, Y)

’ss$ = ss$ + Str$(thes.XY(X, Y))

Next X

’ss$ = ss$ + Chr$(13) + Chr$(10)

Next Y

‘MsgBox ss$

ReDim bar(tt, tt)

For Y = 0 To tt

For X = 0 To tt

If rt = 1 Then k1 = tt – Y: k2 = X

If rt = -1 Then k1 = Y: k2 = tt – X

bar(X, Y) = thes.XY(k1, k2)

ss2$ = ss2$ + Str$(thes.XY(k1, k2))

Next X

ss2$ = ss2$ + Chr$(13) + Chr$(10)

Next Y

‘MsgBox ss2$

tx_min = 10

ty_min = 10

tx_max = 0

ty_max = 0

For Y = 0 To tt

For X = 0 To tt

If bar(X, Y) = 1 And tx_min > X Then tx_min = X

If bar(X, Y) = 1 And tx_max < X Then tx_max = X

If bar(X, Y) = 1 And ty_min > Y Then ty_min = Y

If bar(X, Y) = 1 And ty_max < Y Then ty_max = Y

Next

Next

For Y = 0 To tt

For X = 0 To tt

CONT_TION.CUR_TOUBLO.XY(X, Y) = 0

Next

Next

For Y = ty_min To ty_max

For X = tx_min To tx_max

CONT_TION.CUR_TOUBLO.XY(X – tx_min, Y – ty_min) = bar(X, Y)

’ss3$ = ss3$ + Str$(bar(X, Y))

Next X

’ss3$ = ss3$ + Chr$(10) + Chr$(13)

Next Y

‘MsgBox ss3$

Call norm_min_max

End Sub

Private Sub freeze() ‘πάγωμα του τούβλου όταν ακουμπάει σε άλλο η στο δάπεδο

‘MsgBox “ferg”

For Y = 0 To 4

For X = 0 To 4

tt = CONT_TION.CUR_TOUBLO.XY(X, Y)

tx = CONT_TION.CUR_POS.X + X

ty = CONT_TION.CUR_POS.Y + Y

If tt = 1 Then thesis.XY(tx, ty) = 1

Next X

Next Y

Call delete_rows

End Sub

Private Function fragment() As Boolean ‘διάφοροι έλεγχοι

If CONT_TION.CUR_POS.X + CONT_TION.max_x >= CANAB.X Then

CONT_TION.CUR_POS.X = CANAB.X – CONT_TION.max_x – 1

End If

If CONT_TION.CUR_POS.X + CONT_TION.min_x < 0 Then

CONT_TION.CUR_POS.X = -CONT_TION.min_x

End If

If CONT_TION.CUR_POS.Y + CONT_TION.max_y >= CANAB.Y Then

CONT_TION.CUR_POS.Y = CANAB.Y – CONT_TION.max_y – 1

fragment = True

End If

End Function

Private Function pro_fragm(mx, my) ‘διάφοροι έλεγχοι

For Y = 0 To 3

For X = 0 To 3

tt = CONT_TION.CUR_TOUBLO.XY(X, Y)

If tt = 1 Then

If CONT_TION.CUR_POS.X + X + mx < 0 Or CONT_TION.CUR_POS.Y + Y + my < 0 Then Exit Function

If CONT_TION.CUR_POS.X + X + mx <= CANAB.X Then

If thesis.XY(CONT_TION.CUR_POS.X + X + mx, CONT_TION.CUR_POS.Y + Y + my) = 1 Then

If CONT_TION.CUR_POS.Y = 0 Then

MsgBox “game over”

Call new_game(0)

End If

pro_fragm = True

End If

End If

End If

Next X

Next Y

End Function

Private Sub delete_rows() ‘διαγραφή γραμμών αν είναι συμπληρωμένες

Timer1.Enabled = False

Dim gg(1000)

Max = 0

For Y = 0 To CANAB.Y – 1

canc = 0

For X = 0 To CANAB.X – 1

If thesis.XY(X, Y) = 0 Then canc = 1: Exit For

Next X

If canc = 0 Then gg(Max) = Y: Max = Max + 1

Next Y

If Max > 0 Then

col2 = RGB(220, 200, 50)

col = RGB(100, 150, 250)

col3 = RGB(220, 0, 0)

TMX = Pic.ScaleWidth / CANAB.X

TMY = Pic.ScaleHeight / CANAB.Y

Pic.AutoRedraw = True

For bk = 0 To 5

If bk Mod 2 = 0 Then

colr = col3

colr2 = col3

Else

colr = col

colr2 = col2

End If

For b = 0 To Max – 1

Y = gg(b)

‘MsgBox “erg”

Y_Y = TMY * Y

For X = 0 To CANAB.X – 1

X_X = TMX * X

Pic.DrawWidth = 1

Pic.Line (X_X, Y_Y)-(X_X + TMX, Y_Y + TMY), colr, B

Pic.DrawWidth = 5

Pic.Line (X_X + Int(TMX / 2), Y_Y + Int(TMY / 2))-(X_X + Int(TMX / 2), Y_Y + Int(TMY / 2)), colr2, B

Next X

Next b

Pic.Refresh

ktt = Timer()

While Abs(ktt – Timer) < 0.05

Wend

Next bk

For b = 0 To Max – 1

Y = gg(b)

For ty = Y To 0 Step -1

For X = 0 To CANAB.X – 1

If ty = 0 Then thesis.XY(X, ty) = 0 Else thesis.XY(X, ty) = thesis.XY(X, ty – 1)

Next X

Next ty

‘Call delete_rows

Next b

End If

If Max > 0 Then

CONT_TION.sum_bonus = CONT_TION.sum_bonus + Val(Max ^ 2 * (CONT_TION.level + 1)) * 100

Label3.Caption = CONT_TION.sum_bonus

‘MsgBox “rhg”

End If

Timer1.Enabled = True

End Sub

Private Sub Timer2_Timer() ‘για κίνηση του spot

Static ff

Static mm

If mm = 0 Then ff = ff + 1

If ff > 80 Then mm = 1

If mm = 1 Then ff = ff – 1

If ff < 0 Then mm = 0: ff = 0

Form1.Caption = Space$(ff) + “Tertis – www.digitalnews.gr”

End Sub