您所在位置：主题：用QB写的俄罗斯方块：）
woshihanjin
[专家分：2510] 发布于 2004-04-02 02:17:00
很久以前就写的了，有的机器在消层时可能会有停顿的问题，不想改了。直接copy出去存为.bas文件，用dos下自带的qbasic打开，按F5就可以运行了。修改CONST UnitMax 的值，并在DATA段添加相应的数据（依次为名称、宽、高、色彩（1到15）、具体数据（0表示空，1表示实，按先行后列的格式））就可以扩展功能（各种各样的方块）了。想写小游戏的朋友可以参考，不过当时写的代码实在是不好意思啊！
下面是截图（virtual pc上做的）
[img]http://www.wodutom.com/coolwindows/block.JPG[/img]
DEFINT A-Z
CONST TRUE = 1
CONST FALSE = 0
CONST Interrupt = 1
CONST Normal = 0
CONST Public2Private = 0
CONST Private2Public = 1
CONST High = 20
CONST Wide = 10
CONST perSide = 2
CONST Top = 50
CONST Left = 180
CONST HighPixel = 400
CONST WidePixel = 200
CONST ToUp = 0
CONST ToDown = 2
CONST ToLeft = 1
CONST ToRight = 3
CONST KeyUp = 72
CONST KeyDown = 80
CONST KeyLeft = 75
CONST KeyRight = 77
CONST KeySpace = 32
CONST KeyEnter = 13
CONST KeyESC = 27
CONST KeyBackSpace = 8
CONST KeyTab = 9
CONST KeyANY = -1
CONST KeyNone = 256
CONST ScanEnter = 28 'ɨÃèÂë
CONST ScanESC = 1
CONST GetNormal = 0 '¶Á¼üÅÌ»º³å·½Ê½
CONST GetLast = 1
CONST FalshDelay = 2000
CONST LineDelay = 8000
CONST MoveDelayTime = 3500
CONST Black = 1
CONST Grey = 0
CONST Bright = 2
CONST Dark = 3
CONST Falsh = 4
CONST Red = 4
CONST Green = 5
CONST Blue = 6
CONST Yellow = 7
CONST Pin = 8
CONST Sky = 9
CONST DeepGreen = 10
CONST DeepRed = 11
CONST TypeHigh = 0
CONST TypeLow = 1
CONST TypeNothing = 2
CONST SaveRecord = 0
CONST SaveHighest = 1
CONST ReadRecord = 2
CONST ReadOther = 3
CONST ReadHighestScore = 4
CONST ReadHighestLevel = 5
CONST DeleteRecord = 6
CONST CreateRecord = 7
CONST FindRecord = 8
CONST Must = 1
CONST WarnSound = 1000
CONST ErrSound = 1200
CONST MaxDiffcult = 30
CONST NewRecord = 1
CONST UnitMax = 7
CONST ToBlack = 1
CONST CloseScreen = 0
TYPE SPRITE
Names AS STRING * 4
Left AS INTEGER
Top AS INTEGER
w AS INTEGER
h AS INTEGER
c AS INTEGER
Direction AS INTEGER
Offset AS INTEGER
sPoint AS INTEGER
END TYPE
TYPE FileRecord
Names AS STRING * 6
Score AS INTEGER
Level AS INTEGER
END TYPE
DIM SHARED perLevel AS INTEGER
DIM SHARED perWide AS INTEGER
DIM SHARED perHigh AS INTEGER
DIM SHARED Table(High, Wide) AS INTEGER
DIM SHARED MoveDelay(MaxDiffcult) AS INTEGER
DIM SHARED isTrue AS INTEGER
DIM SHARED PicUnit(UnitMax) AS SPRITE
DIM SHARED BasePic(5000) AS INTEGER
DIM SHARED NowUnit AS SPRITE
DIM SHARED NextUnit AS SPRITE
DIM SHARED TempSprite AS SPRITE
DIM SHARED Diffcult AS INTEGER
DIM SHARED TempRecord AS FileRecord
DIM SHARED PublicValue AS INTEGER
DIM SHARED AttribCustom AS INTEGER
DIM SHARED LevelCustom AS INTEGER
DIM SHARED ScoreCustom AS INTEGER
DIM SHARED NameCustom AS STRING * 6
DIM SHARED NameScore AS STRING * 6
DIM SHARED NameLevel AS STRING * 6
DIM SHARED HighestScore AS INTEGER
DIM SHARED HighestLevel AS INTEGER
DIM SHARED TotleRecord AS INTEGER
DECLARE FUNCTION RefurbishTable% () 'Return number of clear lines
DECLARE FUNCTION Delay% (DelayTimes AS INTEGER, InterruptKey AS INTEGER) 'Return weather interrupt or not
DECLARE FUNCTION GetKey% (Way AS INTEGER) 'Return KeyASCcode
DECLARE FUNCTION GetScan% () 'Return KeySCANcode
DECLARE FUNCTION GetX% (From AS INTEGER, Class AS INTEGER) 'Return X changed
DECLARE FUNCTION GetY% (From AS INTEGER, Class AS INTEGER) 'Return Y changed
DECLARE FUNCTION GetSize% (SizeOf AS INTEGER, sWide AS INTEGER, sHigh AS INTEGER) 'Return a Size to save back
DECLARE FUNCTION GetName$ (Leng AS INTEGER, nX AS INTEGER, nY AS INTEGER, nColor AS INTEGER, nCUE AS STRING, nMinAsc AS INTEGER, nMaxAsc AS INTEGER, nType AS INTEGER) 'Return a String
DECLARE FUNCTION Pause% (ContinueKey AS INTEGER) 'Return a KeyASCcode
DECLARE FUNCTION GetMassage% (mLeft AS INTEGER, mTop AS INTEGER, Massage AS STRING, TxColor AS INTEGER, KeyJump AS INTEGER) 'Send a massage
DECLARE FUNCTION isNext% () 'Return weather can go down or left or right
DECLARE FUNCTION isDirect% ()
DECLARE FUNCTION isHighScore% (Score AS INTEGER) 'Return weather the Score is the Highest
DECLARE FUNCTION isHighLevel% (Level AS INTEGER) 'Return weather the Level is the Highest
DECLARE FUNCTION Record% (rType AS INTEGER) 'Return the answer of Oprating Record
DECLARE FUNCTION Choose% (cX AS INTEGER, cY AS INTEGER, cMassage AS STRING, cColor AS INTEGER) 'Return Y or N
DECLARE FUNCTION ToLand% ()
DECLARE SUB Initdata ()
DECLARE SUB RefurbishUnit (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DECLARE SUB RefurbishRect (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DECLARE SUB RefurbishLine (rLine AS INTEGER, rColor AS INTEGER)
DECLARE SUB RefurbishScreen ()
DECLARE SUB SPRITEDirectionChange ()
DECLARE SUB ShowSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DECLARE SUB CleanSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DECLARE SUB ShowTable (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DECLARE SUB DrawBox (bLeft AS INTEGER, bTop AS INTEGER, bWide AS INTEGER, bHigh AS INTEGER, bType AS INTEGER)
DECLARE SUB WarnInfo (WarnRecord AS INTEGER)
DECLARE SUB ErrInfo (ErrRecord AS INTEGER)
DECLARE SUB CurInfo (CurRecord AS INTEGER)
DECLARE SUB DialogBox (DialogRecord AS INTEGER)
DECLARE SUB ShowRecord (RecordNumber AS INTEGER)
DECLARE SUB pEnd (UseWay AS INTEGER)
DECLARE SUB Setup ()
DECLARE SUB Manage ()
DECLARE SUB Control ()
DECLARE SUB InitFace ()
DECLARE SUB Help ()
'Name Wide High Color
DATA "Line","Rect","LefN","RigN","Lef7","Rig7","Soil","NNNN"
DATA 1,2,3,3,2,2,3,2
DATA 4,2,2,2,3,3,2,2
DATA 5,6,7,8,9,10,11,12
DATA 1,1,1,1 ,1,1,1,1 ,1,1,1,1 ,1,1,1,1
DATA 1,1,1,1 ,1,1,1,1 ,1,1,1,1 ,1,1,1,1
DATA 1,1,0,0,1,1 ,0,1,1,1,1,0 ,1,1,0,0,1,1 ,0,1,1,1,1,0
DATA 0,1,1,1,1,0 ,1,0,1,1,0,1 ,0,1,1,1,1,0 ,1,0,1,1,0,1
DATA 1,1,0,1,0,1 ,1,1,1,1,0,0 ,1,0,1,0,1,1 ,0,0,1,1,1,1
DATA 1,1,1,0,1,0 ,1,0,0,1,1,1 ,0,1,0,1,1,1 ,1,1,1,0,0,1
DATA 0,1,0,1,1,1 ,0,1,1,1,0,1 ,1,1,1,0,1,0 ,1,0,1,1,1,0
DATA 1,1,0,1 ,1,1,1,0 ,1,0,1,1 ,0,1,1,1
SCREEN 12
DIM Temp AS INTEGER
Diffcult = 0
Initdata
isTrue = TRUE
DO
FOR i = 0 TO High: FOR j = 0 TO Wide: Table(i, j) = 0: NEXT: NEXT
IF isTrue = TRUE THEN
Temp = ToLand
SELECT CASE Temp
CASE 1: CALL Setup
CASE 2: CALL Manage
CASE 3: CALL pEnd(CloseScreen)
CASE 4: CALL pEnd(ToBlack)
CASE 5: CLS : END
CASE 6: CALL Help
END SELECT
END IF
IF Temp = 0 THEN
InitFace
Control
END IF
LOOP
END
FUNCTION Choose% (cX AS INTEGER, cY AS INTEGER, cMassage AS STRING, cColor AS INTEGER)
DIM Ret AS STRING * 1
COLOR cColor: LOCATE cY, cX: PRINT cMassage; "(y/n)?"
Ret = CHR$(Pause(KeyANY))
IF Ret = "y" OR Ret = "Y" THEN Choose% = TRUE ELSE Choose% = FALSE
LOCATE cY, cX: PRINT SPACE$(LEN(cMassage)); " "
END FUNCTION
SUB CleanSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DIM xTemp AS INTEGER, yTemp AS INTEGER, xPoint AS INTEGER, yPoint AS INTEGER
TempSprite = UnitInfor
SPRITEDirectionChange
xTemp = TempSprite.w: yTemp = TempSprite.h
FOR i = 0 TO yTemp - 1: FOR j = 0 TO xTemp - 1
xPoint = addX + (j + TempSprite.Left - 1) * perWide
yPoint = addY + (i + TempSprite.Top - 1) * perHigh
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN LINE (xPoint, yPoint)-(xPoint + perWide, yPoint + perHigh), Grey, BF
NEXT: NEXT
END SUB
SUB Control
DIM Time AS SINGLE
DIM cDown AS INTEGER, cLeft AS INTEGER, cRight AS INTEGER
DIM Temp AS INTEGER, ActiveLevel AS INTEGER
DIM TName AS STRING * 6
RANDOMIZE TIMER
NowUnit = PicUnit(CINT(RND * UnitMax))
NextUnit = PicUnit(CINT(RND * UnitMax))
NowUnit.Left = (Wide - NowUnit.w) / 2
NowUnit.Top = 1
NextUnit.Left = 1: NextUnit.Top = 1
CALL DrawBox(Left + 300 - 2, Top + 20 - 2, NextUnit.w * perWide + 4, NextUnit.h * perHigh + 4, TypeLow)
CALL ShowSPRITE(NowUnit, Left, Top)
CALL ShowSPRITE(NextUnit, Left + 300, Top + 20)
DO
Time = 0
isTrue = FALSE
DO
TName = NameCustom
i = isNext
IF i >= 4 THEN cLeft = FALSE: i = i - 4 ELSE cLeft = TRUE
IF i >= 2 THEN cRight = FALSE: i = i - 2 ELSE cRight = TRUE
IF i = 1 THEN cDown = FALSE ELSE cDown = TRUE
SELECT CASE GetKey(GetLast)
CASE KeyUp: CALL CurInfo(2): i = GetMassage(275, 220, "Pause", Red, KeyANY): CALL CurInfo(0)
CASE KeyDown
IF cDown = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Top = NowUnit.Top + 1
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE KeyLeft
IF cLeft = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Left = NowUnit.Left - 1
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE KeyRight
IF cRight = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Left = NowUnit.Left + 1
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE KeyEnter
IF isDirect = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Direction = (NowUnit.Direction + 1) MOD 4
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE ASC("h"): Help
CASE ASC("H"): Help
CASE ASC("r"): IF Record%(ReadRecord) <> NewRecord THEN CALL ShowRecord(AttribCustom)
CASE ASC("R"): IF Record%(ReadRecord) <> NewRecord THEN CALL ShowRecord(AttribCustom)
CASE ASC("l"): NameCustom = GetName$(6, 55, 17, Red, "Load Name:", 0, 255, Normal): i = Record%(ReadOther): CALL DialogBox(0): IF i <> NewRecord THEN CALL ShowRecord(i)
CASE ASC("d"): i = Record%(DeleteRecord)
CASE ASC("D"): i = Record%(DeleteRecord)
'CASE KeySpace: CLS : END
CASE KeyESC
IF Choose(55, 17, "Exit", Red) = TRUE THEN
LevelCustom = 0
ScoreCustom = 0
Diffcult = 0
isTrue = TRUE
EXIT SUB
END IF
END SELECT
Time = Time + 1
NameCustom = TName
LOOP UNTIL INT(Time) >= MoveDelay(Diffcult)
IF cDown = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Top = NowUnit.Top + 1
CALL ShowSPRITE(NowUnit, Left, Top)
ELSE
IF NowUnit.Top = 1 OR Diffcult = MaxDiffcult - 1 THEN
IF NowUnit.Top = 1 THEN t$ = "GAME OVER" ELSE t$ = "YOU WIN"
CALL CurInfo(2): i = GetMassage(275, 220, t$, Red, KeyANY): CALL CurInfo(0)
IF Choose(55, 17, "Save", Red) = TRUE THEN
TempRecord.Score = ScoreCustom
TempRecord.Level = LevelCustom
TempRecord.Names = NameCustom
i = Record%(SaveHighest)
END IF
LevelCustom = 0
ScoreCustom = 0
Diffcult = 0
isTrue = FALSE: EXIT SUB
END IF
TempSprite = NowUnit
SPRITEDirectionChange
FOR i = 0 TO TempSprite.h - 1: FOR j = 0 TO TempSprite.w - 1
IF Table(TempSprite.Top + i, TempSprite.Left + j) = FALSE THEN Table(TempSprite.Top + i, TempSprite.Left + j) = BasePic(TempSprite.sPoint + i * TempSprite.w + j)
NEXT: NEXT
RefurbishScreen
Temp = RefurbishTable
isTrue = TRUE
FOR i = 1 TO Wide
IF Table(High, i) = 1 THEN isTrue = FALSE: EXIT FOR
NEXT
ActiveLevel = ActiveLevel + Temp
IF ActiveLevel >= perLevel THEN ActiveLevel = ActiveLevel - perLevel: Diffcult = Diffcult + 1
LevelCustom = LevelCustom + Temp
ScoreCustom = ScoreCustom + Temp * Temp * (Diffcult + 1)
IF isTrue = TRUE THEN ScoreCustom = ScoreCustom + 20 * (Diffcult + 1)
NowUnit = NextUnit
NowUnit.Left = (Wide - NowUnit.w) / 2
NowUnit.Top = 1
CALL CleanSPRITE(NextUnit, Left + 300, Top + 20)
CALL DrawBox(Left + 300 - 2, Top + 20 - 2, NextUnit.w * perWide + 4, NextUnit.h * perHigh + 4, TypeNothing)
NextUnit = PicUnit(CINT(RND * UnitMax))
NextUnit.Left = 1: NextUnit.Top = 1
CALL DrawBox(Left + 300 - 2, Top + 20 - 2, NextUnit.w * perWide + 4, NextUnit.h * perHigh + 4, TypeLow)
CALL ShowSPRITE(NowUnit, Left, Top)
CALL ShowSPRITE(NextUnit, Left + 300, Top + 20)
COLOR Pin
LOCATE 8, 2: PRINT ScoreCustom
LOCATE 11, 2: PRINT LevelCustom
LOCATE 14, 2: PRINT Diffcult
END IF
LOOP
END SUB
SUB CurInfo (CurRecord AS INTEGER)
LOCATE 14, 55: COLOR Yellow
SELECT CASE CurRecord
CASE 0: CurContent$ = "Press 'H' for help "
CASE 1: CurContent$ = "Press 'P' to retrun"
CASE 2: CurContent$ = "Press any key to return"
CASE ELSE: CurContent$ = " "
END SELECT
PRINT CurContent$
END SUB
FUNCTION Delay% (DelayTimes AS INTEGER, InterruptKey AS INTEGER)
DIM Delays AS SINGLE
Delay% = Normal
FOR Delays = 0 TO DelayTimes
IF INP(&H60) = InterruptKey THEN Delay% = Interrupt: EXIT FOR
i$ = INKEY$
NEXT
END FUNCTION
SUB DialogBox (DialogRecord AS INTEGER)
COLOR Red: LOCATE 17, 55
SELECT CASE DialogRecord
CASE 1: Dialog$ = "Saved!"
CASE 2: Dialog$ = "UnSaved!"
CASE 3: Dialog$ = "Delected!"
CASE 4: Dialog$ = "UnDeleted!"
CASE 5: Dialog$ = "NoDeleted!"
CASE 6
CASE 7
CASE ELSE: Dialog$ = " "
END SELECT
PRINT Dialog$
END SUB
SUB DrawBox (bLeft AS INTEGER, bTop AS INTEGER, bWide AS INTEGER, bHigh AS INTEGER, bType AS INTEGER)
DIM bColor(2) AS INTEGER
bColor(0) = Grey
SELECT CASE bType
CASE TypeHigh: bColor(1) = Bright: bColor(2) = Dark
CASE TypeLow: bColor(1) = Dark: bColor(2) = Bright
CASE TypeNothing: bColor(1) = Grey: bColor(2) = Grey
END SELECT
LINE (bLeft + perSide, bTop + perSide)-(bLeft + bWide - perSide, bTop + bHigh - perSide), bColor(0), BF
LINE (bLeft + (perSide - 1), bTop + (perSide - 1))-(bLeft + bWide - (perSide - 1), bTop + (perSide - 1)), bColor(1)
LINE (bLeft + (perSide - 1), bTop + (perSide - 1))-(bLeft + (perSide - 1), bTop + bHigh - (perSide - 1)), bColor(1)
LINE (bLeft + bWide - (perSide - 1), bTop + bHigh - (perSide - 1))-(bLeft + (perSide - 1), bTop + bHigh - (perSide - 1)), bColor(2)
LINE (bLeft + bWide - (perSide - 1), bTop + bHigh - (perSide - 1))-(bLeft + bWide - (perSide - 1), bTop + (perSide - 1)), bColor(2)
END SUB
SUB ErrInfo (ErrRecord AS INTEGER)
SOUND ErrSound, .5
SELECT CASE ErrRecord
CASE ELSE: ErrContent$ = "Unknow Error!"
END SELECT
i = GetMassage((630 - LEN(ErrContent$) * 8) / 2, 230, ErrContent$, Red, KeyEnter)
END
END SUB
FUNCTION GetKey% (Way AS INTEGER)
i$ = "": j$ = ""
IF Way = GetNormal THEN i$ = INKEY$ ELSE DO: i$ = j$: j$ = INKEY$: LOOP UNTIL j$ = ""
IF LEN(i$) THEN
IF LEFT$(i$, 1) = CHR$(0) THEN GetKey% = ASC(RIGHT$(i$, 1)) ELSE GetKey% = ASC(i$)
END IF
END FUNCTION
FUNCTION GetMassage% (mLeft AS INTEGER, mTop AS INTEGER, Massage AS STRING, TxColor AS INTEGER, KeyJump AS INTEGER)
DIM mHigh AS INTEGER, mWide AS INTEGER
mLeft = INT(mLeft / 8) * 8
mTop = INT(mTop / 16) * 16 - 4
mWide = (LEN(Massage) + 2) * 8
mHigh = 24
DIM SaveBox(GetSize(8, mWide, mHigh)) AS DOUBLE
GET (mLeft, mTop)-(mLeft + mWide, mTop + 24), SaveBox
CALL DrawBox(mLeft, mTop, mWide, mHigh, TypeHigh)
CALL DrawBox(mLeft + 4, mTop + 2, mWide - 8, mHigh - 4, TypeLow)
COLOR TxColor: LOCATE (mTop + 2) / 16 + 1, mLeft / 8 + 2: PRINT Massage
GetMassage% = Pause(KeyJump)
PUT (mLeft, mTop), SaveBox, PSET
ERASE SaveBox
END FUNCTION
FUNCTION GetName$ (Leng AS INTEGER, nX AS INTEGER, nY AS INTEGER, nColor AS INTEGER, nCUE AS STRING, nMinAsc AS INTEGER, nMaxAsc AS INTEGER, nType AS INTEGER)
DIM LenTemp AS INTEGER
DIM iASC AS INTEGER, aASC AS INTEGER
iASC = nMinAsc: aASC = nMaxAsc
IF iASC > aASC THEN SWAP iASC, aASC
IF iASC < 32 THEN iASC = 32
IF aASC > 127 THEN aASC = 127
IF iASC > 126 THEN iASC = 126
IF aASC < 33 THEN aASC = 33
Temp$ = ""
DO
COLOR nColor: LOCATE nY, nX: PRINT nCUE + Temp$ + SPACE$(Leng - LenTemp + 1)
Get$ = INPUT$(1)
LenTemp = LEN(Temp$)
SELECT CASE ASC(Get$)
CASE KeyEnter: IF nType = Must THEN IF LEN(Temp$) <> Leng THEN CALL WarnInfo(1) ELSE GetName$ = Temp$: EXIT DO ELSE GetName$ = Temp$: EXIT DO
CASE KeyBackSpace: IF LenTemp >= 1 THEN Temp$ = LEFT$(Temp$, LenTemp - 1)
CASE iASC TO aASC: IF LenTemp < Leng THEN Temp$ = Temp$ + Get$ ELSE CALL WarnInfo(2)
END SELECT
LOOP
END FUNCTION
FUNCTION GetScan%
GetScan% = INP(&H60)
i$ = INKEY$
END FUNCTION
FUNCTION GetSize% (SizeOf AS INTEGER, sWide AS INTEGER, sHigh AS INTEGER)
GetSize% = (sWide / 16 * sHigh + (sWide + sHigh) / 2) * 8 / SizeOf
END FUNCTION
FUNCTION GetX% (From AS INTEGER, Class AS INTEGER)
IF Class = Public2Private THEN GetX% = (From - Left) / perWide ELSE GetX% = From * perWide + Left
END FUNCTION
FUNCTION GetY% (From AS INTEGER, Class AS INTEGER)
IF Class = Public2Private THEN GetY% = (From - Top) / perHigh ELSE GetY% = From * perHigh + Top
END FUNCTION
SUB Help
DIM hLeft AS INTEGER, hTop AS INTEGER, hWide AS INTEGER, hHigh AS INTEGER
hLeft = 110: hTop = 92: hWide = (320 - hLeft) * 2: hHigh = (240 - hTop) * 2
DIM SaveHelp(GetSize(8, hWide, hHigh)) AS DOUBLE
GET (hLeft, hTop)-(hLeft + hWide, hTop + hHigh), SaveHelp
CALL DrawBox(hLeft, hTop, hWide, hHigh, TypeHigh)
CALL DrawBox(hLeft + 5, hTop + 20, hWide - 10, hHigh - 25, TypeLow)
CALL DrawBox(hLeft + 10, hTop + 30, hWide - 250, hHigh - 45, TypeHigh)
CALL DrawBox(hLeft + 15, hTop + 55, hWide - 260, hHigh - 75, TypeLow)
CALL DrawBox(hLeft + 190, hTop + 30, hWide - 200, hHigh - 110, TypeHigh)
CALL DrawBox(hLeft + 195, hTop + 55, hWide - 210, hHigh - 140, TypeLow)
CALL DrawBox(hLeft + 190, hTop + 220, hWide - 200, hHigh - 235, TypeHigh)
COLOR Black: LOCATE 7, 38: PRINT "Help"
COLOR Blue: LOCATE 9, 17: PRINT "Control Instruction"
COLOR Blue: LOCATE 9, 44: PRINT "Game Instruction"
COLOR Yellow
LOCATE 11, 18: PRINT CHR$(26); ":Right"
LOCATE 12, 18: PRINT CHR$(27); ":Left"
LOCATE 13, 18: PRINT CHR$(25); ":Down"
LOCATE 14, 18: PRINT CHR$(24); ":Pause"
LOCATE 15, 18: PRINT "Enter:Rotate"
LOCATE 16, 18: PRINT "ESC:Exit"
LOCATE 17, 18: PRINT "H(h):Help"
LOCATE 18, 18: PRINT "R(r):ReadRecord"
LOCATE 19, 18: PRINT "L(l):LoadRecord"
LOCATE 20, 18: PRINT "D(d):DeleteRecord"
COLOR Black
LOCATE 11, 40: PRINT "Special name:"
COLOR DeepGreen
LOCATE 12, 40: PRINT "Setup:Set some details"
LOCATE 13, 40: PRINT "Manage:Manage the records"
LOCATE 14, 40: PRINT "Help:Get help"
LOCATE 15, 40: PRINT "End:End of the program"
COLOR Pin
LOCATE 21, 42: PRINT "Copyright 1999.08.28"
LOCATE 23, 48: PRINT "Han Jin"
i = Pause(KeyANY)
PUT (hLeft, hTop), SaveHelp, PSET
END SUB
SUB Initdata
DIM NewFile AS INTEGER
perLevel = 30
perHigh = HighPixel / High
perWide = WidePixel / Wide
FOR i = 0 TO MaxDiffcult: MoveDelay(i) = MoveDelayTime / SQR(i + 1): NEXT
OUT &H3C6, 255
OUT &H3C8, Black: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, Grey: OUT &H3C9, 48: OUT &H3C9, 48: OUT &H3C9, 48
OUT &H3C8, Bright: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
OUT &H3C8, Dark: OUT &H3C9, 20: OUT &H3C9, 20: OUT &H3C9, 20
OUT &H3C8, Falsh: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, Green: OUT &H3C9, 0: OUT &H3C9, 63: OUT &H3C9, 0
OUT &H3C8, Blue: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 63
OUT &H3C8, Yellow: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 0
OUT &H3C8, Pin: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 63
OUT &H3C8, Sky: OUT &H3C9, 0: OUT &H3C9, 63: OUT &H3C9, 63
OUT &H3C8, DeepGreen: OUT &H3C9, 10: OUT &H3C9, 32: OUT &H3C9, 10
OUT &H3C8, DeepRed: OUT &H3C9, 32: OUT &H3C9, 10: OUT &H3C9, 10
FOR i = 0 TO UnitMax: READ PicUnit(i).Names: NEXT
FOR i = 0 TO UnitMax: READ PicUnit(i).w: NEXT
FOR i = 0 TO UnitMax: READ PicUnit(i).h: NEXT
FOR i = 0 TO UnitMax: READ PicUnit(i).c: NEXT
FOR i = 1 TO UnitMax: PicUnit(i).Offset = PicUnit(i - 1).Offset + PicUnit(i - 1).w * PicUnit(i - 1).h * 4: NEXT
FOR i = 0 TO PicUnit(UnitMax).Offset + PicUnit(UnitMax).w * PicUnit(UnitMax).h * 4 - 1: READ BasePic(i): NEXT
OPEN "Els.Sav" FOR RANDOM AS #1 LEN = LEN(TempRecord)
GET #1, 1, TempRecord
IF TempRecord.Score = 1 OR TempRecord.Score = 0 THEN NewFile = TRUE ELSE NewFile = FALSE
IF NewFile = TRUE THEN
TempRecord.Names = "******"
TempRecord.Score = 1
TempRecord.Level = 0
PUT #1, 1, TempRecord
TotleRecord = 1
HighestScore = 0
HighestLevel = 0
NameScore = ""
NameLevel = ""
ELSE
GET #1, 1, TempRecord
TotleRecord = TempRecord.Score
i = Record%(ReadHighestScore)
GET #1, i, TempRecord
HighestScore = TempRecord.Score
NameScore = TempRecord.Names
i = Record%(ReadHighestLevel)
GET #1, i, TempRecord
HighestLevel = TempRecord.Level
NameLevel = TempRecord.Names
END IF
END SUB
SUB InitFace
CLS
CALL DrawBox(220, 14, 150, 20, TypeHigh)
COLOR Black
LOCATE 2, 31: PRINT "Russia Diamonds"
COLOR DeepRed
CALL DrawBox(Left - 2, Top - 2, perWide * Wide + 4, perHigh * High + 4, TypeLow)
LOCATE 4, 2: PRINT "User Name:": CALL DrawBox(5, 62, 80, 20, TypeLow)
LOCATE 7, 2: PRINT "User Score:": CALL DrawBox(5, 110, 80, 20, TypeLow)
LOCATE 10, 2: PRINT "User Level:": CALL DrawBox(5, 158, 80, 20, TypeLow)
LOCATE 13, 2: PRINT "User Diffcult:": CALL DrawBox(5, 206, 80, 20, TypeLow)
LOCATE 13, 55: PRINT "Operate guide:": CALL DrawBox(429, 206, 200, 20, TypeLow)
LOCATE 16, 55: PRINT "Dialog box:": CALL DrawBox(429, 254, 200, 20, TypeLow)
LOCATE 4, 63: PRINT "Next Unit"
COLOR Pin
LOCATE 5, 2: PRINT NameCustom
LOCATE 8, 2: PRINT " 0"
LOCATE 11, 2: PRINT " 0"
LOCATE 14, 2: PRINT Diffcult
COLOR DeepGreen
LOCATE 17, 2: PRINT "Highest Score:": CALL DrawBox(5, 270, 80, 20, TypeLow)
LOCATE 20, 2: PRINT "Name:": CALL DrawBox(5, 318, 80, 20, TypeLow)
LOCATE 23, 2: PRINT "Highest Level:": CALL DrawBox(5, 366, 80, 20, TypeLow)
LOCATE 26, 2: PRINT "Name:": CALL DrawBox(5, 414, 80, 20, TypeLow)
COLOR Blue
LOCATE 18, 2: PRINT HighestScore
LOCATE 21, 2: PRINT NameScore
LOCATE 24, 2: PRINT HighestLevel
LOCATE 27, 2: PRINT NameLevel
COLOR Black: LOCATE 2, 2
IF AttribCustom = NewRecord THEN PRINT "New User" ELSE PRINT "Old User"
CALL CurInfo(0)
END SUB
FUNCTION isDirect%
isDirect% = TRUE
TempSprite = NowUnit
TempSprite.Direction = (TempSprite.Direction + 1) MOD 4
SPRITEDirectionChange
IF TempSprite.Left + TempSprite.w - 1 > Wide THEN isDirect% = FALSE: EXIT FUNCTION
IF TempSprite.Top + TempSprite.h - 1 > High THEN isDirect% = FALSE: EXIT FUNCTION
FOR i = 0 TO TempSprite.h - 1: FOR j = 0 TO TempSprite.w - 1
IF Table(TempSprite.Top + i, TempSprite.Left + j) = TRUE AND BasePic(TempSprite.sPoint + i * TempSprite.w + j) = TRUE THEN isDirect% = FALSE: EXIT FOR
NEXT: NEXT
END FUNCTION
FUNCTION isHighLevel% (Level AS INTEGER)
isHighLevel% = TRUE
FOR i = 2 TO TotleRecords
GET #1, i, TempRecord
IF TempRecord.Level > Level THEN isHighLevel% = FASLE: EXIT FOR
NEXT
END FUNCTION
FUNCTION isHighScore% (Score AS INTEGER)
isHighScore% = TRUE
FOR i = 2 TO TotleRecords
GET #1, i, TempRecord
IF TempRecord.Score > Score THEN isHighScore% = FASLE: EXIT FOR
NEXT
END FUNCTION
FUNCTION isNext%
DIM xTemp AS INTEGER, yTemp AS INTEGER
DIM retValue AS INTEGER
TempSprite = NowUnit
SPRITEDirectionChange
xTemp = TempSprite.w: yTemp = TempSprite.h
DIM isDown(xTemp) AS INTEGER
DIM isLeft(yTemp) AS INTEGER
DIM isRight(yTemp) AS INTEGER
FOR i = 0 TO xTemp - 1: FOR j = 0 TO yTemp - 1
IF BasePic(TempSprite.sPoint + j * xTemp + i) = 1 THEN isDown(i + 1) = j + 1
NEXT: NEXT
FOR i = 1 TO xTemp
IF TempSprite.Top + isDown(i) > High THEN
retValue = retValue + 1: EXIT FOR
ELSEIF Table(TempSprite.Top + isDown(i), TempSprite.Left + i - 1) = TRUE THEN retValue = retValue + 1: EXIT FOR
END IF
NEXT
FOR i = 0 TO yTemp - 1: FOR j = 0 TO xTemp - 1
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN isRight(i + 1) = j + 1
NEXT: NEXT
FOR i = 1 TO yTemp
IF TempSprite.Left + xTemp > Wide THEN
retValue = retValue + 2: EXIT FOR
ELSEIF Table(TempSprite.Top + i - 1, TempSprite.Left + isRight(i)) = TRUE THEN retValue = retValue + 2: EXIT FOR
END IF
NEXT
FOR i = 0 TO yTemp - 1: FOR j = xTemp - 1 TO 0 STEP -1
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN isLeft(i + 1) = j + 1
NEXT: NEXT
FOR i = 1 TO yTemp
IF TempSprite.Left = 1 THEN
retValue = retValue + 4: EXIT FOR
ELSEIF Table(TempSprite.Top + i - 1, TempSprite.Left + isLeft(i) - 2) = TRUE THEN retValue = retValue + 4: EXIT FOR
END IF
NEXT
ERASE isDown, isLeft, isRight
isNext% = retValue
END FUNCTION
SUB Manage
DIM TempName AS STRING * 7, TempScore AS STRING * 9, TempLevel AS STRING * 4
CLS : COLOR Blue
LOCATE 1, 37: PRINT "Manage"
CALL DrawBox(20, 30, 200, 20, TypeHigh)
CALL DrawBox(20, 60, 200, 400, TypeHigh)
CALL DrawBox(25, 85, 190, 370, TypeLow)
LOCATE 3, 9: PRINT "Totle User:"; TotleRecord - 1
LOCATE 5, 5: PRINT "Name Score Level"
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
TempName = TempRecord.Names
TempScore = STR$(TempRecord.Score)
TempLevel = STR$(TempRecord.Level)
LOCATE 5 + i MOD 24, 5: PRINT TempName; TempScore; TempLevel
NEXT
i = Pause(KeyANY)
END SUB
FUNCTION Pause% (ContinueKey AS INTEGER)
DO:
a$ = INPUT$(1)
IF ContinueKey = KeyANY THEN EXIT DO
IF ASC(a$) = ContinueKey THEN EXIT DO
IF ContinueKey >= 65 AND ContinueKey < 90 THEN
IF ASC(a$) = ContinueKey OR ASC(a$) = ContinueKey + 32 THEN EXIT DO
ELSEIF ContinueKey >= 97 AND ContinueKey < 123 THEN
IF ASC(a$) = ContinueKey OR ASC(a$) = ContinueKey - 32 THEN EXIT DO
END IF
LOOP
Pause% = ASC(a$)
END FUNCTION
SUB pEnd (UseWay AS INTEGER)
SELECT CASE UseWay
CASE CloseScreen
RANDOMIZE TIMER
IF CINT(RND) = 0 THEN
FOR i = 0 TO 320
LINE (i, 0)-(i, 479), Black
LINE (639 - i, 0)-(639 - i, 479), Black
j = Delay(100, KeyESC)
NEXT
ELSE
FOR i = 0 TO 240
LINE (0, i)-(639, i), Black
LINE (0, 479 - i)-(639, 479 - i), Black
j = Delay(100, KeyESC)
NEXT
END IF
FOR i = 0 TO 14: PALETTE i, 0: NEXT
CASE ToBlack
DIM ColorTable(14, 2) AS SINGLE
DIM perSub(14, 2) AS SINGLE
DIM Waste AS SINGLE
FOR i = 0 TO 14: OUT &H3C7, i: FOR j = 0 TO 2
ColorTable(i, j) = INP(&H3C9)
perSub(i, j) = ColorTable(i, j) / 63
NEXT: NEXT
FOR Waste = 1 TO 63 STEP .2: FOR i = 0 TO 14
OUT &H3C8, i
FOR j = 0 TO 2: OUT &H3C9, ColorTable(i, j) - perSub(i, j) * Waste: NEXT
NEXT: j = Delay(50, KeyNone): NEXT
ERASE ColorTable
ERASE perSub
END SELECT
COLOR 15
END
END SUB
FUNCTION Record% (rType AS INTEGER)
COLOR Red
DIM SwapRecord AS FileRecord, Other AS INTEGER, Temp AS INTEGER
IF PublicValue > TotleRecord THEN PublicValue = TotleRecord
IF PublicValue < 2 THEN PublicValue = 2
SELECT CASE rType
CASE SaveRecord
IF AttribCustom = NewRecord THEN
PUT #1, TotleRecord + 1, TempRecord
TotleRecord = TotleRecord + 1
AttribCustom = TotleRecord
CALL DialogBox(1)
Record% = TRUE
ELSEIF Choose(55, 17, "Coverd old", Red) = TRUE THEN
PUT #1, AttribCustom, TempRecord
CALL DialogBox(1)
Record% = TRUE
ELSE
CALL DialogBox(2)
Record% = FALSE
END IF
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
CASE SaveHighest
Record% = TRUE
IF AttribCustom = NewRecord THEN
PUT #1, TotleRecord + 1, TempRecord
TotleRecord = TotleRecord + 1
AttribCustom = TotleRecord
CALL DialogBox(1)
ELSEIF Choose(55, 17, "Coverd old", Red) = TRUE THEN
GET #1, AttribCustom, SwapRecord
IF TempRecord.Score < SwapRecord.Score THEN TempRecord.Score = SwapRecord.Score
IF TempRecord.Level < SwapRecord.Level THEN TempRecord.Level = SwapRecord.Level
PUT #1, AttribCustom, TempRecord
CALL DialogBox(1)
ELSE
CALL DialogBox(2)
Record% = FALSE
END IF
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
CASE ReadRecord
IF AttribCustom <> NewRecord THEN GET #1, AttribCustom, TempRecord ELSE LOCATE 17, 55: PRINT "No Record!": i = Pause(KeyANY): LOCATE 17, 55: PRINT " "
Record% = AttribCustom
CASE ReadOther
Other = Record(FindRecord)
IF Other <> NewRecord THEN GET #1, Other, TempRecord ELSE LOCATE 17, 55: PRINT "Can't Find!": i = Pause(KeyANY): LOCATE 17, 55: PRINT " "
Record% = Other
CASE ReadHighestScore
Temp = 0
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
IF TempRecord.Score > Temp THEN Temp = TempRecord.Score: Record% = i
NEXT
CASE ReadHighestLevel
Temp = 0
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
IF TempRecord.Level > Temp THEN Temp = TempRecord.Level: Record% = i
NEXT
CASE DeleteRecord
Record% = FALSE
IF AttribCustom <> NewRecord THEN
IF Choose(55, 17, "Delete it", Red) = TRUE THEN
GET #1, TotleRecord, TempRecord
PUT #1, AttribCustom, TempRecord
TotleRecord = TotleRecord - 1
AttribCustom = NewRecord
CALL DialogBox(3)
Record% = TRUE
ELSE CALL DialogBox(4)
END IF
ELSE CALL DialogBox(5)
END IF
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
CASE CreateRecord
AttribCustom = Record(FindRecord)
IF AttribCustom = NewRecord THEN TotleRecord = TotleRecord + 1
Record% = AttribCustom
CASE FindRecord
Record% = NewRecord
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
IF TempRecord.Names = NameCustom THEN Record% = i: EXIT FOR
NEXT
END SELECT
GET #1, 1, TempRecord
TempRecord.Score = TotleRecord
PUT #1, 1, TempRecord
CALL DialogBox(0)
END FUNCTION
SUB RefurbishLine (rLine AS INTEGER, rColor AS INTEGER)
FOR i = 1 TO Wide
CALL RefurbishUnit(i, rLine, rColor)
NEXT
END SUB
SUB RefurbishRect (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DIM uLeft AS INTEGER, uTop AS INTEGER
uLeft = rX
uTop = rY
LINE (uLeft + perSide, uTop + perSide)-(uLeft + perWide - perSide, uTop + perHigh - perSide), rColor, BF
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Bright
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Bright
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Dark
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Dark
END SUB
SUB RefurbishScreen
FOR i = 1 TO High: FOR j = 1 TO Wide
CALL RefurbishUnit(j, i, Grey)
NEXT: NEXT
EXIT SUB
END SUB
FUNCTION RefurbishTable%
DIM LineCount AS INTEGER, TrueLine AS INTEGER
LineCount = 0
DO
TrueLine = 0
FOR i = High TO 1 STEP -1
isTrue = TRUE
FOR j = 1 TO Wide
IF Table(i, j) = FALSE THEN isTrue = FALSE: EXIT FOR
NEXT
IF isTrue = TRUE THEN TrueLine = i: EXIT FOR
NEXT
IF TrueLine > 0 THEN
FOR i = 0 TO 1
CALL RefurbishLine(TrueLine, Falsh)
IF (Delay(FalshDelay, ScanESC) = Interrupt) THEN EXIT FUNCTION
CALL RefurbishLine(TrueLine, Grey)
IF (Delay(FalshDelay, ScanESC) = Interrupt) THEN EXIT FUNCTION
NEXT
LineCount = LineCount + 1
FOR i = TrueLine TO 1 STEP -1: FOR j = 1 TO Wide
Table(i, j) = Table(i - 1, j)
NEXT: NEXT
FOR i = 1 TO Wide: Table(1, i) = 0: NEXT
IF (Delay(LineDelay, ScanESC) = Interrupt) THEN EXIT FUNCTION
CALL RefurbishScreen
ELSE EXIT DO
END IF
LOOP
RefurbishTable% = LineCount
END FUNCTION
SUB RefurbishUnit (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DIM uLeft AS INTEGER, uTop AS INTEGER
uLeft = Left + (rX - 1) * perWide
uTop = Top + (rY - 1) * perHigh
IF Table(rY, rX) = TRUE THEN
LINE (uLeft + perSide, uTop + perSide)-(uLeft + perWide - perSide, uTop + perHigh - perSide), rColor, BF
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Bright
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Bright
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Dark
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Dark
ELSE
LINE (uLeft, uTop)-(uLeft + perWide, uTop + perHigh), Grey, BF
END IF
END SUB
SUB Setup
CLS : COLOR Blue
CALL DrawBox(260, 14, 103, 20, TypeHigh)
CALL DrawBox(50, 50, 540, 400, TypeLow)
CALL DrawBox(380, 61, 40, 20, TypeLow)
CALL DrawBox(428, 93, 40, 20, TypeLow)
LOCATE 2, 35: PRINT "Setup Data"
LOCATE 5, 22: PRINT "Start Diffcult(Default=0):"
LOCATE 7, 22: PRINT "Upgrade need floors(Default=30):"
COLOR Black: LOCATE 5, 20: PRINT CHR$(15)
DO
Diffcult = VAL(GetName$(2, 49, 5, DeepGreen, "", ASC("0"), ASC("9"), Normal))
IF Diffcult > 30 THEN CALL WarnInfo(3) ELSE EXIT DO
LOOP
COLOR Black: LOCATE 5, 20: PRINT " ": LOCATE 7, 20: PRINT CHR$(15)
perLevel = VAL(GetName$(2, 55, 7, DeepGreen, "", ASC("0"), ASC("9"), Normal))
END SUB
SUB ShowRecord (RecordNumber AS INTEGER)
DIM SL AS INTEGER, ST AS INTEGER, SW AS INTEGER, SH AS INTEGER
SL = 224: ST = 200: SW = (320 - SL) * 2: SH = (240 - ST) * 2
DIM SaveShow(GetSize(8, SW, SH)) AS DOUBLE
GET (SL, ST)-(SL + SW, ST + SH), SaveShow
CALL DrawBox(SL, ST, SW, SH, TypeHigh)
CALL DrawBox(SL + 5, ST + 5, 55, 20, TypeLow)
CALL DrawBox(SL + 5, ST + 25, 55, SH - 30, TypeLow)
CALL DrawBox(SL + 65, ST + 5, 55, 20, TypeLow)
CALL DrawBox(SL + 65, ST + 25, 55, SH - 30, TypeLow)
CALL DrawBox(SL + 125, ST + 5, 55, 20, TypeLow)
CALL DrawBox(SL + 125, ST + 25, 55, SH - 30, TypeLow)
COLOR Black
LOCATE 14, 31: PRINT "Name"
LOCATE 14, 38: PRINT "Score"
LOCATE 14, 45: PRINT "Level"
COLOR Blue
GET #1, RecordNumber, TempRecord
LOCATE 16, 30: PRINT TempRecord.Names
LOCATE 16, 38: PRINT STR$(TempRecord.Score)
LOCATE 16, 45: PRINT STR$(TempRecord.Level)
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
PUT (SL, ST), SaveShow, PSET
END SUB
SUB ShowSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DIM xTemp AS INTEGER, yTemp AS INTEGER
TempSprite = UnitInfor
SPRITEDirectionChange
xTemp = TempSprite.w: yTemp = TempSprite.h
FOR i = 0 TO yTemp - 1: FOR j = 0 TO xTemp - 1
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN CALL RefurbishRect(addX + (j + TempSprite.Left - 1) * perWide, addY + (i + TempSprite.Top - 1) * perHigh, TempSprite.c)
NEXT: NEXT
END SUB
SUB SPRITEDirectionChange
DIM xTemp AS INTEGER, yTemp AS INTEGER
SELECT CASE TempSprite.Direction
CASE ToLeft: xTemp = TempSprite.h: yTemp = TempSprite.w
CASE ToRight: xTemp = TempSprite.h: yTemp = TempSprite.w
CASE ToUp: xTemp = TempSprite.w: yTemp = TempSprite.h
CASE ToDown: xTemp = TempSprite.w: yTemp = TempSprite.h
END SELECT
TempSprite.w = xTemp: TempSprite.h = yTemp
TempSprite.sPoint = TempSprite.Offset + TempSprite.Direction * TempSprite.w * TempSprite.h
END SUB
FUNCTION ToLand%
CLS
ToLand% = 0
CALL DrawBox(240, 14, 150, 20, TypeHigh)
COLOR Black
LOCATE 2, 33: PRINT "Russia Diamonds"
COLOR Blue
CALL DrawBox(100, 202, 440, 60, TypeHigh)
LOCATE 15, 15: PRINT "Please input your name:"
CALL DrawBox(320, 222, 80, 20, TypeLow)
NameCustom = GetName$(6, 42, 15, DeepGreen, "", 0, 255, Normal)
SELECT CASE NameCustom
CASE "Setup ": ToLand% = 1
CASE "Manage": ToLand% = 2
CASE "End ": ToLand% = 3
CASE "end ": ToLand% = 4
CASE "END ": ToLand% = 5
CASE "Help ": ToLand% = 6
CASE ELSE: AttribCustom = Record%(FindRecord)
END SELECT
END FUNCTION
SUB WarnInfo (WarnRecord AS INTEGER)
SOUND WarnSound, .5
SELECT CASE WarnRecord
CASE 1: WarnContent$ = "You must input more letters to create your name!"
CASE 2: WarnContent$ = "Length reach the limit!"
CASE 3: WarnContent$ = "Diffcult must between 0 and 30!"
CASE ELSE: WarnContent$ = "Unknow warn!"
END SELECT
i = GetMassage((630 - LEN(WarnContent$) * 8) / 2, 230, WarnContent$, Yellow, KeyEnter)
END SUB
下面是截图（virtual pc上做的）
[img]http://www.wodutom.com/coolwindows/block.JPG[/img]
DEFINT A-Z
CONST TRUE = 1
CONST FALSE = 0
CONST Interrupt = 1
CONST Normal = 0
CONST Public2Private = 0
CONST Private2Public = 1
CONST High = 20
CONST Wide = 10
CONST perSide = 2
CONST Top = 50
CONST Left = 180
CONST HighPixel = 400
CONST WidePixel = 200
CONST ToUp = 0
CONST ToDown = 2
CONST ToLeft = 1
CONST ToRight = 3
CONST KeyUp = 72
CONST KeyDown = 80
CONST KeyLeft = 75
CONST KeyRight = 77
CONST KeySpace = 32
CONST KeyEnter = 13
CONST KeyESC = 27
CONST KeyBackSpace = 8
CONST KeyTab = 9
CONST KeyANY = -1
CONST KeyNone = 256
CONST ScanEnter = 28 'ɨÃèÂë
CONST ScanESC = 1
CONST GetNormal = 0 '¶Á¼üÅÌ»º³å·½Ê½
CONST GetLast = 1
CONST FalshDelay = 2000
CONST LineDelay = 8000
CONST MoveDelayTime = 3500
CONST Black = 1
CONST Grey = 0
CONST Bright = 2
CONST Dark = 3
CONST Falsh = 4
CONST Red = 4
CONST Green = 5
CONST Blue = 6
CONST Yellow = 7
CONST Pin = 8
CONST Sky = 9
CONST DeepGreen = 10
CONST DeepRed = 11
CONST TypeHigh = 0
CONST TypeLow = 1
CONST TypeNothing = 2
CONST SaveRecord = 0
CONST SaveHighest = 1
CONST ReadRecord = 2
CONST ReadOther = 3
CONST ReadHighestScore = 4
CONST ReadHighestLevel = 5
CONST DeleteRecord = 6
CONST CreateRecord = 7
CONST FindRecord = 8
CONST Must = 1
CONST WarnSound = 1000
CONST ErrSound = 1200
CONST MaxDiffcult = 30
CONST NewRecord = 1
CONST UnitMax = 7
CONST ToBlack = 1
CONST CloseScreen = 0
TYPE SPRITE
Names AS STRING * 4
Left AS INTEGER
Top AS INTEGER
w AS INTEGER
h AS INTEGER
c AS INTEGER
Direction AS INTEGER
Offset AS INTEGER
sPoint AS INTEGER
END TYPE
TYPE FileRecord
Names AS STRING * 6
Score AS INTEGER
Level AS INTEGER
END TYPE
DIM SHARED perLevel AS INTEGER
DIM SHARED perWide AS INTEGER
DIM SHARED perHigh AS INTEGER
DIM SHARED Table(High, Wide) AS INTEGER
DIM SHARED MoveDelay(MaxDiffcult) AS INTEGER
DIM SHARED isTrue AS INTEGER
DIM SHARED PicUnit(UnitMax) AS SPRITE
DIM SHARED BasePic(5000) AS INTEGER
DIM SHARED NowUnit AS SPRITE
DIM SHARED NextUnit AS SPRITE
DIM SHARED TempSprite AS SPRITE
DIM SHARED Diffcult AS INTEGER
DIM SHARED TempRecord AS FileRecord
DIM SHARED PublicValue AS INTEGER
DIM SHARED AttribCustom AS INTEGER
DIM SHARED LevelCustom AS INTEGER
DIM SHARED ScoreCustom AS INTEGER
DIM SHARED NameCustom AS STRING * 6
DIM SHARED NameScore AS STRING * 6
DIM SHARED NameLevel AS STRING * 6
DIM SHARED HighestScore AS INTEGER
DIM SHARED HighestLevel AS INTEGER
DIM SHARED TotleRecord AS INTEGER
DECLARE FUNCTION RefurbishTable% () 'Return number of clear lines
DECLARE FUNCTION Delay% (DelayTimes AS INTEGER, InterruptKey AS INTEGER) 'Return weather interrupt or not
DECLARE FUNCTION GetKey% (Way AS INTEGER) 'Return KeyASCcode
DECLARE FUNCTION GetScan% () 'Return KeySCANcode
DECLARE FUNCTION GetX% (From AS INTEGER, Class AS INTEGER) 'Return X changed
DECLARE FUNCTION GetY% (From AS INTEGER, Class AS INTEGER) 'Return Y changed
DECLARE FUNCTION GetSize% (SizeOf AS INTEGER, sWide AS INTEGER, sHigh AS INTEGER) 'Return a Size to save back
DECLARE FUNCTION GetName$ (Leng AS INTEGER, nX AS INTEGER, nY AS INTEGER, nColor AS INTEGER, nCUE AS STRING, nMinAsc AS INTEGER, nMaxAsc AS INTEGER, nType AS INTEGER) 'Return a String
DECLARE FUNCTION Pause% (ContinueKey AS INTEGER) 'Return a KeyASCcode
DECLARE FUNCTION GetMassage% (mLeft AS INTEGER, mTop AS INTEGER, Massage AS STRING, TxColor AS INTEGER, KeyJump AS INTEGER) 'Send a massage
DECLARE FUNCTION isNext% () 'Return weather can go down or left or right
DECLARE FUNCTION isDirect% ()
DECLARE FUNCTION isHighScore% (Score AS INTEGER) 'Return weather the Score is the Highest
DECLARE FUNCTION isHighLevel% (Level AS INTEGER) 'Return weather the Level is the Highest
DECLARE FUNCTION Record% (rType AS INTEGER) 'Return the answer of Oprating Record
DECLARE FUNCTION Choose% (cX AS INTEGER, cY AS INTEGER, cMassage AS STRING, cColor AS INTEGER) 'Return Y or N
DECLARE FUNCTION ToLand% ()
DECLARE SUB Initdata ()
DECLARE SUB RefurbishUnit (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DECLARE SUB RefurbishRect (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DECLARE SUB RefurbishLine (rLine AS INTEGER, rColor AS INTEGER)
DECLARE SUB RefurbishScreen ()
DECLARE SUB SPRITEDirectionChange ()
DECLARE SUB ShowSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DECLARE SUB CleanSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DECLARE SUB ShowTable (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DECLARE SUB DrawBox (bLeft AS INTEGER, bTop AS INTEGER, bWide AS INTEGER, bHigh AS INTEGER, bType AS INTEGER)
DECLARE SUB WarnInfo (WarnRecord AS INTEGER)
DECLARE SUB ErrInfo (ErrRecord AS INTEGER)
DECLARE SUB CurInfo (CurRecord AS INTEGER)
DECLARE SUB DialogBox (DialogRecord AS INTEGER)
DECLARE SUB ShowRecord (RecordNumber AS INTEGER)
DECLARE SUB pEnd (UseWay AS INTEGER)
DECLARE SUB Setup ()
DECLARE SUB Manage ()
DECLARE SUB Control ()
DECLARE SUB InitFace ()
DECLARE SUB Help ()
'Name Wide High Color
DATA "Line","Rect","LefN","RigN","Lef7","Rig7","Soil","NNNN"
DATA 1,2,3,3,2,2,3,2
DATA 4,2,2,2,3,3,2,2
DATA 5,6,7,8,9,10,11,12
DATA 1,1,1,1 ,1,1,1,1 ,1,1,1,1 ,1,1,1,1
DATA 1,1,1,1 ,1,1,1,1 ,1,1,1,1 ,1,1,1,1
DATA 1,1,0,0,1,1 ,0,1,1,1,1,0 ,1,1,0,0,1,1 ,0,1,1,1,1,0
DATA 0,1,1,1,1,0 ,1,0,1,1,0,1 ,0,1,1,1,1,0 ,1,0,1,1,0,1
DATA 1,1,0,1,0,1 ,1,1,1,1,0,0 ,1,0,1,0,1,1 ,0,0,1,1,1,1
DATA 1,1,1,0,1,0 ,1,0,0,1,1,1 ,0,1,0,1,1,1 ,1,1,1,0,0,1
DATA 0,1,0,1,1,1 ,0,1,1,1,0,1 ,1,1,1,0,1,0 ,1,0,1,1,1,0
DATA 1,1,0,1 ,1,1,1,0 ,1,0,1,1 ,0,1,1,1
SCREEN 12
DIM Temp AS INTEGER
Diffcult = 0
Initdata
isTrue = TRUE
DO
FOR i = 0 TO High: FOR j = 0 TO Wide: Table(i, j) = 0: NEXT: NEXT
IF isTrue = TRUE THEN
Temp = ToLand
SELECT CASE Temp
CASE 1: CALL Setup
CASE 2: CALL Manage
CASE 3: CALL pEnd(CloseScreen)
CASE 4: CALL pEnd(ToBlack)
CASE 5: CLS : END
CASE 6: CALL Help
END SELECT
END IF
IF Temp = 0 THEN
InitFace
Control
END IF
LOOP
END
FUNCTION Choose% (cX AS INTEGER, cY AS INTEGER, cMassage AS STRING, cColor AS INTEGER)
DIM Ret AS STRING * 1
COLOR cColor: LOCATE cY, cX: PRINT cMassage; "(y/n)?"
Ret = CHR$(Pause(KeyANY))
IF Ret = "y" OR Ret = "Y" THEN Choose% = TRUE ELSE Choose% = FALSE
LOCATE cY, cX: PRINT SPACE$(LEN(cMassage)); " "
END FUNCTION
SUB CleanSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DIM xTemp AS INTEGER, yTemp AS INTEGER, xPoint AS INTEGER, yPoint AS INTEGER
TempSprite = UnitInfor
SPRITEDirectionChange
xTemp = TempSprite.w: yTemp = TempSprite.h
FOR i = 0 TO yTemp - 1: FOR j = 0 TO xTemp - 1
xPoint = addX + (j + TempSprite.Left - 1) * perWide
yPoint = addY + (i + TempSprite.Top - 1) * perHigh
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN LINE (xPoint, yPoint)-(xPoint + perWide, yPoint + perHigh), Grey, BF
NEXT: NEXT
END SUB
SUB Control
DIM Time AS SINGLE
DIM cDown AS INTEGER, cLeft AS INTEGER, cRight AS INTEGER
DIM Temp AS INTEGER, ActiveLevel AS INTEGER
DIM TName AS STRING * 6
RANDOMIZE TIMER
NowUnit = PicUnit(CINT(RND * UnitMax))
NextUnit = PicUnit(CINT(RND * UnitMax))
NowUnit.Left = (Wide - NowUnit.w) / 2
NowUnit.Top = 1
NextUnit.Left = 1: NextUnit.Top = 1
CALL DrawBox(Left + 300 - 2, Top + 20 - 2, NextUnit.w * perWide + 4, NextUnit.h * perHigh + 4, TypeLow)
CALL ShowSPRITE(NowUnit, Left, Top)
CALL ShowSPRITE(NextUnit, Left + 300, Top + 20)
DO
Time = 0
isTrue = FALSE
DO
TName = NameCustom
i = isNext
IF i >= 4 THEN cLeft = FALSE: i = i - 4 ELSE cLeft = TRUE
IF i >= 2 THEN cRight = FALSE: i = i - 2 ELSE cRight = TRUE
IF i = 1 THEN cDown = FALSE ELSE cDown = TRUE
SELECT CASE GetKey(GetLast)
CASE KeyUp: CALL CurInfo(2): i = GetMassage(275, 220, "Pause", Red, KeyANY): CALL CurInfo(0)
CASE KeyDown
IF cDown = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Top = NowUnit.Top + 1
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE KeyLeft
IF cLeft = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Left = NowUnit.Left - 1
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE KeyRight
IF cRight = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Left = NowUnit.Left + 1
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE KeyEnter
IF isDirect = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Direction = (NowUnit.Direction + 1) MOD 4
CALL ShowSPRITE(NowUnit, Left, Top)
END IF
CASE ASC("h"): Help
CASE ASC("H"): Help
CASE ASC("r"): IF Record%(ReadRecord) <> NewRecord THEN CALL ShowRecord(AttribCustom)
CASE ASC("R"): IF Record%(ReadRecord) <> NewRecord THEN CALL ShowRecord(AttribCustom)
CASE ASC("l"): NameCustom = GetName$(6, 55, 17, Red, "Load Name:", 0, 255, Normal): i = Record%(ReadOther): CALL DialogBox(0): IF i <> NewRecord THEN CALL ShowRecord(i)
CASE ASC("d"): i = Record%(DeleteRecord)
CASE ASC("D"): i = Record%(DeleteRecord)
'CASE KeySpace: CLS : END
CASE KeyESC
IF Choose(55, 17, "Exit", Red) = TRUE THEN
LevelCustom = 0
ScoreCustom = 0
Diffcult = 0
isTrue = TRUE
EXIT SUB
END IF
END SELECT
Time = Time + 1
NameCustom = TName
LOOP UNTIL INT(Time) >= MoveDelay(Diffcult)
IF cDown = TRUE THEN
CALL CleanSPRITE(NowUnit, Left, Top)
NowUnit.Top = NowUnit.Top + 1
CALL ShowSPRITE(NowUnit, Left, Top)
ELSE
IF NowUnit.Top = 1 OR Diffcult = MaxDiffcult - 1 THEN
IF NowUnit.Top = 1 THEN t$ = "GAME OVER" ELSE t$ = "YOU WIN"
CALL CurInfo(2): i = GetMassage(275, 220, t$, Red, KeyANY): CALL CurInfo(0)
IF Choose(55, 17, "Save", Red) = TRUE THEN
TempRecord.Score = ScoreCustom
TempRecord.Level = LevelCustom
TempRecord.Names = NameCustom
i = Record%(SaveHighest)
END IF
LevelCustom = 0
ScoreCustom = 0
Diffcult = 0
isTrue = FALSE: EXIT SUB
END IF
TempSprite = NowUnit
SPRITEDirectionChange
FOR i = 0 TO TempSprite.h - 1: FOR j = 0 TO TempSprite.w - 1
IF Table(TempSprite.Top + i, TempSprite.Left + j) = FALSE THEN Table(TempSprite.Top + i, TempSprite.Left + j) = BasePic(TempSprite.sPoint + i * TempSprite.w + j)
NEXT: NEXT
RefurbishScreen
Temp = RefurbishTable
isTrue = TRUE
FOR i = 1 TO Wide
IF Table(High, i) = 1 THEN isTrue = FALSE: EXIT FOR
NEXT
ActiveLevel = ActiveLevel + Temp
IF ActiveLevel >= perLevel THEN ActiveLevel = ActiveLevel - perLevel: Diffcult = Diffcult + 1
LevelCustom = LevelCustom + Temp
ScoreCustom = ScoreCustom + Temp * Temp * (Diffcult + 1)
IF isTrue = TRUE THEN ScoreCustom = ScoreCustom + 20 * (Diffcult + 1)
NowUnit = NextUnit
NowUnit.Left = (Wide - NowUnit.w) / 2
NowUnit.Top = 1
CALL CleanSPRITE(NextUnit, Left + 300, Top + 20)
CALL DrawBox(Left + 300 - 2, Top + 20 - 2, NextUnit.w * perWide + 4, NextUnit.h * perHigh + 4, TypeNothing)
NextUnit = PicUnit(CINT(RND * UnitMax))
NextUnit.Left = 1: NextUnit.Top = 1
CALL DrawBox(Left + 300 - 2, Top + 20 - 2, NextUnit.w * perWide + 4, NextUnit.h * perHigh + 4, TypeLow)
CALL ShowSPRITE(NowUnit, Left, Top)
CALL ShowSPRITE(NextUnit, Left + 300, Top + 20)
COLOR Pin
LOCATE 8, 2: PRINT ScoreCustom
LOCATE 11, 2: PRINT LevelCustom
LOCATE 14, 2: PRINT Diffcult
END IF
LOOP
END SUB
SUB CurInfo (CurRecord AS INTEGER)
LOCATE 14, 55: COLOR Yellow
SELECT CASE CurRecord
CASE 0: CurContent$ = "Press 'H' for help "
CASE 1: CurContent$ = "Press 'P' to retrun"
CASE 2: CurContent$ = "Press any key to return"
CASE ELSE: CurContent$ = " "
END SELECT
PRINT CurContent$
END SUB
FUNCTION Delay% (DelayTimes AS INTEGER, InterruptKey AS INTEGER)
DIM Delays AS SINGLE
Delay% = Normal
FOR Delays = 0 TO DelayTimes
IF INP(&H60) = InterruptKey THEN Delay% = Interrupt: EXIT FOR
i$ = INKEY$
NEXT
END FUNCTION
SUB DialogBox (DialogRecord AS INTEGER)
COLOR Red: LOCATE 17, 55
SELECT CASE DialogRecord
CASE 1: Dialog$ = "Saved!"
CASE 2: Dialog$ = "UnSaved!"
CASE 3: Dialog$ = "Delected!"
CASE 4: Dialog$ = "UnDeleted!"
CASE 5: Dialog$ = "NoDeleted!"
CASE 6
CASE 7
CASE ELSE: Dialog$ = " "
END SELECT
PRINT Dialog$
END SUB
SUB DrawBox (bLeft AS INTEGER, bTop AS INTEGER, bWide AS INTEGER, bHigh AS INTEGER, bType AS INTEGER)
DIM bColor(2) AS INTEGER
bColor(0) = Grey
SELECT CASE bType
CASE TypeHigh: bColor(1) = Bright: bColor(2) = Dark
CASE TypeLow: bColor(1) = Dark: bColor(2) = Bright
CASE TypeNothing: bColor(1) = Grey: bColor(2) = Grey
END SELECT
LINE (bLeft + perSide, bTop + perSide)-(bLeft + bWide - perSide, bTop + bHigh - perSide), bColor(0), BF
LINE (bLeft + (perSide - 1), bTop + (perSide - 1))-(bLeft + bWide - (perSide - 1), bTop + (perSide - 1)), bColor(1)
LINE (bLeft + (perSide - 1), bTop + (perSide - 1))-(bLeft + (perSide - 1), bTop + bHigh - (perSide - 1)), bColor(1)
LINE (bLeft + bWide - (perSide - 1), bTop + bHigh - (perSide - 1))-(bLeft + (perSide - 1), bTop + bHigh - (perSide - 1)), bColor(2)
LINE (bLeft + bWide - (perSide - 1), bTop + bHigh - (perSide - 1))-(bLeft + bWide - (perSide - 1), bTop + (perSide - 1)), bColor(2)
END SUB
SUB ErrInfo (ErrRecord AS INTEGER)
SOUND ErrSound, .5
SELECT CASE ErrRecord
CASE ELSE: ErrContent$ = "Unknow Error!"
END SELECT
i = GetMassage((630 - LEN(ErrContent$) * 8) / 2, 230, ErrContent$, Red, KeyEnter)
END
END SUB
FUNCTION GetKey% (Way AS INTEGER)
i$ = "": j$ = ""
IF Way = GetNormal THEN i$ = INKEY$ ELSE DO: i$ = j$: j$ = INKEY$: LOOP UNTIL j$ = ""
IF LEN(i$) THEN
IF LEFT$(i$, 1) = CHR$(0) THEN GetKey% = ASC(RIGHT$(i$, 1)) ELSE GetKey% = ASC(i$)
END IF
END FUNCTION
FUNCTION GetMassage% (mLeft AS INTEGER, mTop AS INTEGER, Massage AS STRING, TxColor AS INTEGER, KeyJump AS INTEGER)
DIM mHigh AS INTEGER, mWide AS INTEGER
mLeft = INT(mLeft / 8) * 8
mTop = INT(mTop / 16) * 16 - 4
mWide = (LEN(Massage) + 2) * 8
mHigh = 24
DIM SaveBox(GetSize(8, mWide, mHigh)) AS DOUBLE
GET (mLeft, mTop)-(mLeft + mWide, mTop + 24), SaveBox
CALL DrawBox(mLeft, mTop, mWide, mHigh, TypeHigh)
CALL DrawBox(mLeft + 4, mTop + 2, mWide - 8, mHigh - 4, TypeLow)
COLOR TxColor: LOCATE (mTop + 2) / 16 + 1, mLeft / 8 + 2: PRINT Massage
GetMassage% = Pause(KeyJump)
PUT (mLeft, mTop), SaveBox, PSET
ERASE SaveBox
END FUNCTION
FUNCTION GetName$ (Leng AS INTEGER, nX AS INTEGER, nY AS INTEGER, nColor AS INTEGER, nCUE AS STRING, nMinAsc AS INTEGER, nMaxAsc AS INTEGER, nType AS INTEGER)
DIM LenTemp AS INTEGER
DIM iASC AS INTEGER, aASC AS INTEGER
iASC = nMinAsc: aASC = nMaxAsc
IF iASC > aASC THEN SWAP iASC, aASC
IF iASC < 32 THEN iASC = 32
IF aASC > 127 THEN aASC = 127
IF iASC > 126 THEN iASC = 126
IF aASC < 33 THEN aASC = 33
Temp$ = ""
DO
COLOR nColor: LOCATE nY, nX: PRINT nCUE + Temp$ + SPACE$(Leng - LenTemp + 1)
Get$ = INPUT$(1)
LenTemp = LEN(Temp$)
SELECT CASE ASC(Get$)
CASE KeyEnter: IF nType = Must THEN IF LEN(Temp$) <> Leng THEN CALL WarnInfo(1) ELSE GetName$ = Temp$: EXIT DO ELSE GetName$ = Temp$: EXIT DO
CASE KeyBackSpace: IF LenTemp >= 1 THEN Temp$ = LEFT$(Temp$, LenTemp - 1)
CASE iASC TO aASC: IF LenTemp < Leng THEN Temp$ = Temp$ + Get$ ELSE CALL WarnInfo(2)
END SELECT
LOOP
END FUNCTION
FUNCTION GetScan%
GetScan% = INP(&H60)
i$ = INKEY$
END FUNCTION
FUNCTION GetSize% (SizeOf AS INTEGER, sWide AS INTEGER, sHigh AS INTEGER)
GetSize% = (sWide / 16 * sHigh + (sWide + sHigh) / 2) * 8 / SizeOf
END FUNCTION
FUNCTION GetX% (From AS INTEGER, Class AS INTEGER)
IF Class = Public2Private THEN GetX% = (From - Left) / perWide ELSE GetX% = From * perWide + Left
END FUNCTION
FUNCTION GetY% (From AS INTEGER, Class AS INTEGER)
IF Class = Public2Private THEN GetY% = (From - Top) / perHigh ELSE GetY% = From * perHigh + Top
END FUNCTION
SUB Help
DIM hLeft AS INTEGER, hTop AS INTEGER, hWide AS INTEGER, hHigh AS INTEGER
hLeft = 110: hTop = 92: hWide = (320 - hLeft) * 2: hHigh = (240 - hTop) * 2
DIM SaveHelp(GetSize(8, hWide, hHigh)) AS DOUBLE
GET (hLeft, hTop)-(hLeft + hWide, hTop + hHigh), SaveHelp
CALL DrawBox(hLeft, hTop, hWide, hHigh, TypeHigh)
CALL DrawBox(hLeft + 5, hTop + 20, hWide - 10, hHigh - 25, TypeLow)
CALL DrawBox(hLeft + 10, hTop + 30, hWide - 250, hHigh - 45, TypeHigh)
CALL DrawBox(hLeft + 15, hTop + 55, hWide - 260, hHigh - 75, TypeLow)
CALL DrawBox(hLeft + 190, hTop + 30, hWide - 200, hHigh - 110, TypeHigh)
CALL DrawBox(hLeft + 195, hTop + 55, hWide - 210, hHigh - 140, TypeLow)
CALL DrawBox(hLeft + 190, hTop + 220, hWide - 200, hHigh - 235, TypeHigh)
COLOR Black: LOCATE 7, 38: PRINT "Help"
COLOR Blue: LOCATE 9, 17: PRINT "Control Instruction"
COLOR Blue: LOCATE 9, 44: PRINT "Game Instruction"
COLOR Yellow
LOCATE 11, 18: PRINT CHR$(26); ":Right"
LOCATE 12, 18: PRINT CHR$(27); ":Left"
LOCATE 13, 18: PRINT CHR$(25); ":Down"
LOCATE 14, 18: PRINT CHR$(24); ":Pause"
LOCATE 15, 18: PRINT "Enter:Rotate"
LOCATE 16, 18: PRINT "ESC:Exit"
LOCATE 17, 18: PRINT "H(h):Help"
LOCATE 18, 18: PRINT "R(r):ReadRecord"
LOCATE 19, 18: PRINT "L(l):LoadRecord"
LOCATE 20, 18: PRINT "D(d):DeleteRecord"
COLOR Black
LOCATE 11, 40: PRINT "Special name:"
COLOR DeepGreen
LOCATE 12, 40: PRINT "Setup:Set some details"
LOCATE 13, 40: PRINT "Manage:Manage the records"
LOCATE 14, 40: PRINT "Help:Get help"
LOCATE 15, 40: PRINT "End:End of the program"
COLOR Pin
LOCATE 21, 42: PRINT "Copyright 1999.08.28"
LOCATE 23, 48: PRINT "Han Jin"
i = Pause(KeyANY)
PUT (hLeft, hTop), SaveHelp, PSET
END SUB
SUB Initdata
DIM NewFile AS INTEGER
perLevel = 30
perHigh = HighPixel / High
perWide = WidePixel / Wide
FOR i = 0 TO MaxDiffcult: MoveDelay(i) = MoveDelayTime / SQR(i + 1): NEXT
OUT &H3C6, 255
OUT &H3C8, Black: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, Grey: OUT &H3C9, 48: OUT &H3C9, 48: OUT &H3C9, 48
OUT &H3C8, Bright: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
OUT &H3C8, Dark: OUT &H3C9, 20: OUT &H3C9, 20: OUT &H3C9, 20
OUT &H3C8, Falsh: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, Green: OUT &H3C9, 0: OUT &H3C9, 63: OUT &H3C9, 0
OUT &H3C8, Blue: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 63
OUT &H3C8, Yellow: OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 0
OUT &H3C8, Pin: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 63
OUT &H3C8, Sky: OUT &H3C9, 0: OUT &H3C9, 63: OUT &H3C9, 63
OUT &H3C8, DeepGreen: OUT &H3C9, 10: OUT &H3C9, 32: OUT &H3C9, 10
OUT &H3C8, DeepRed: OUT &H3C9, 32: OUT &H3C9, 10: OUT &H3C9, 10
FOR i = 0 TO UnitMax: READ PicUnit(i).Names: NEXT
FOR i = 0 TO UnitMax: READ PicUnit(i).w: NEXT
FOR i = 0 TO UnitMax: READ PicUnit(i).h: NEXT
FOR i = 0 TO UnitMax: READ PicUnit(i).c: NEXT
FOR i = 1 TO UnitMax: PicUnit(i).Offset = PicUnit(i - 1).Offset + PicUnit(i - 1).w * PicUnit(i - 1).h * 4: NEXT
FOR i = 0 TO PicUnit(UnitMax).Offset + PicUnit(UnitMax).w * PicUnit(UnitMax).h * 4 - 1: READ BasePic(i): NEXT
OPEN "Els.Sav" FOR RANDOM AS #1 LEN = LEN(TempRecord)
GET #1, 1, TempRecord
IF TempRecord.Score = 1 OR TempRecord.Score = 0 THEN NewFile = TRUE ELSE NewFile = FALSE
IF NewFile = TRUE THEN
TempRecord.Names = "******"
TempRecord.Score = 1
TempRecord.Level = 0
PUT #1, 1, TempRecord
TotleRecord = 1
HighestScore = 0
HighestLevel = 0
NameScore = ""
NameLevel = ""
ELSE
GET #1, 1, TempRecord
TotleRecord = TempRecord.Score
i = Record%(ReadHighestScore)
GET #1, i, TempRecord
HighestScore = TempRecord.Score
NameScore = TempRecord.Names
i = Record%(ReadHighestLevel)
GET #1, i, TempRecord
HighestLevel = TempRecord.Level
NameLevel = TempRecord.Names
END IF
END SUB
SUB InitFace
CLS
CALL DrawBox(220, 14, 150, 20, TypeHigh)
COLOR Black
LOCATE 2, 31: PRINT "Russia Diamonds"
COLOR DeepRed
CALL DrawBox(Left - 2, Top - 2, perWide * Wide + 4, perHigh * High + 4, TypeLow)
LOCATE 4, 2: PRINT "User Name:": CALL DrawBox(5, 62, 80, 20, TypeLow)
LOCATE 7, 2: PRINT "User Score:": CALL DrawBox(5, 110, 80, 20, TypeLow)
LOCATE 10, 2: PRINT "User Level:": CALL DrawBox(5, 158, 80, 20, TypeLow)
LOCATE 13, 2: PRINT "User Diffcult:": CALL DrawBox(5, 206, 80, 20, TypeLow)
LOCATE 13, 55: PRINT "Operate guide:": CALL DrawBox(429, 206, 200, 20, TypeLow)
LOCATE 16, 55: PRINT "Dialog box:": CALL DrawBox(429, 254, 200, 20, TypeLow)
LOCATE 4, 63: PRINT "Next Unit"
COLOR Pin
LOCATE 5, 2: PRINT NameCustom
LOCATE 8, 2: PRINT " 0"
LOCATE 11, 2: PRINT " 0"
LOCATE 14, 2: PRINT Diffcult
COLOR DeepGreen
LOCATE 17, 2: PRINT "Highest Score:": CALL DrawBox(5, 270, 80, 20, TypeLow)
LOCATE 20, 2: PRINT "Name:": CALL DrawBox(5, 318, 80, 20, TypeLow)
LOCATE 23, 2: PRINT "Highest Level:": CALL DrawBox(5, 366, 80, 20, TypeLow)
LOCATE 26, 2: PRINT "Name:": CALL DrawBox(5, 414, 80, 20, TypeLow)
COLOR Blue
LOCATE 18, 2: PRINT HighestScore
LOCATE 21, 2: PRINT NameScore
LOCATE 24, 2: PRINT HighestLevel
LOCATE 27, 2: PRINT NameLevel
COLOR Black: LOCATE 2, 2
IF AttribCustom = NewRecord THEN PRINT "New User" ELSE PRINT "Old User"
CALL CurInfo(0)
END SUB
FUNCTION isDirect%
isDirect% = TRUE
TempSprite = NowUnit
TempSprite.Direction = (TempSprite.Direction + 1) MOD 4
SPRITEDirectionChange
IF TempSprite.Left + TempSprite.w - 1 > Wide THEN isDirect% = FALSE: EXIT FUNCTION
IF TempSprite.Top + TempSprite.h - 1 > High THEN isDirect% = FALSE: EXIT FUNCTION
FOR i = 0 TO TempSprite.h - 1: FOR j = 0 TO TempSprite.w - 1
IF Table(TempSprite.Top + i, TempSprite.Left + j) = TRUE AND BasePic(TempSprite.sPoint + i * TempSprite.w + j) = TRUE THEN isDirect% = FALSE: EXIT FOR
NEXT: NEXT
END FUNCTION
FUNCTION isHighLevel% (Level AS INTEGER)
isHighLevel% = TRUE
FOR i = 2 TO TotleRecords
GET #1, i, TempRecord
IF TempRecord.Level > Level THEN isHighLevel% = FASLE: EXIT FOR
NEXT
END FUNCTION
FUNCTION isHighScore% (Score AS INTEGER)
isHighScore% = TRUE
FOR i = 2 TO TotleRecords
GET #1, i, TempRecord
IF TempRecord.Score > Score THEN isHighScore% = FASLE: EXIT FOR
NEXT
END FUNCTION
FUNCTION isNext%
DIM xTemp AS INTEGER, yTemp AS INTEGER
DIM retValue AS INTEGER
TempSprite = NowUnit
SPRITEDirectionChange
xTemp = TempSprite.w: yTemp = TempSprite.h
DIM isDown(xTemp) AS INTEGER
DIM isLeft(yTemp) AS INTEGER
DIM isRight(yTemp) AS INTEGER
FOR i = 0 TO xTemp - 1: FOR j = 0 TO yTemp - 1
IF BasePic(TempSprite.sPoint + j * xTemp + i) = 1 THEN isDown(i + 1) = j + 1
NEXT: NEXT
FOR i = 1 TO xTemp
IF TempSprite.Top + isDown(i) > High THEN
retValue = retValue + 1: EXIT FOR
ELSEIF Table(TempSprite.Top + isDown(i), TempSprite.Left + i - 1) = TRUE THEN retValue = retValue + 1: EXIT FOR
END IF
NEXT
FOR i = 0 TO yTemp - 1: FOR j = 0 TO xTemp - 1
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN isRight(i + 1) = j + 1
NEXT: NEXT
FOR i = 1 TO yTemp
IF TempSprite.Left + xTemp > Wide THEN
retValue = retValue + 2: EXIT FOR
ELSEIF Table(TempSprite.Top + i - 1, TempSprite.Left + isRight(i)) = TRUE THEN retValue = retValue + 2: EXIT FOR
END IF
NEXT
FOR i = 0 TO yTemp - 1: FOR j = xTemp - 1 TO 0 STEP -1
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN isLeft(i + 1) = j + 1
NEXT: NEXT
FOR i = 1 TO yTemp
IF TempSprite.Left = 1 THEN
retValue = retValue + 4: EXIT FOR
ELSEIF Table(TempSprite.Top + i - 1, TempSprite.Left + isLeft(i) - 2) = TRUE THEN retValue = retValue + 4: EXIT FOR
END IF
NEXT
ERASE isDown, isLeft, isRight
isNext% = retValue
END FUNCTION
SUB Manage
DIM TempName AS STRING * 7, TempScore AS STRING * 9, TempLevel AS STRING * 4
CLS : COLOR Blue
LOCATE 1, 37: PRINT "Manage"
CALL DrawBox(20, 30, 200, 20, TypeHigh)
CALL DrawBox(20, 60, 200, 400, TypeHigh)
CALL DrawBox(25, 85, 190, 370, TypeLow)
LOCATE 3, 9: PRINT "Totle User:"; TotleRecord - 1
LOCATE 5, 5: PRINT "Name Score Level"
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
TempName = TempRecord.Names
TempScore = STR$(TempRecord.Score)
TempLevel = STR$(TempRecord.Level)
LOCATE 5 + i MOD 24, 5: PRINT TempName; TempScore; TempLevel
NEXT
i = Pause(KeyANY)
END SUB
FUNCTION Pause% (ContinueKey AS INTEGER)
DO:
a$ = INPUT$(1)
IF ContinueKey = KeyANY THEN EXIT DO
IF ASC(a$) = ContinueKey THEN EXIT DO
IF ContinueKey >= 65 AND ContinueKey < 90 THEN
IF ASC(a$) = ContinueKey OR ASC(a$) = ContinueKey + 32 THEN EXIT DO
ELSEIF ContinueKey >= 97 AND ContinueKey < 123 THEN
IF ASC(a$) = ContinueKey OR ASC(a$) = ContinueKey - 32 THEN EXIT DO
END IF
LOOP
Pause% = ASC(a$)
END FUNCTION
SUB pEnd (UseWay AS INTEGER)
SELECT CASE UseWay
CASE CloseScreen
RANDOMIZE TIMER
IF CINT(RND) = 0 THEN
FOR i = 0 TO 320
LINE (i, 0)-(i, 479), Black
LINE (639 - i, 0)-(639 - i, 479), Black
j = Delay(100, KeyESC)
NEXT
ELSE
FOR i = 0 TO 240
LINE (0, i)-(639, i), Black
LINE (0, 479 - i)-(639, 479 - i), Black
j = Delay(100, KeyESC)
NEXT
END IF
FOR i = 0 TO 14: PALETTE i, 0: NEXT
CASE ToBlack
DIM ColorTable(14, 2) AS SINGLE
DIM perSub(14, 2) AS SINGLE
DIM Waste AS SINGLE
FOR i = 0 TO 14: OUT &H3C7, i: FOR j = 0 TO 2
ColorTable(i, j) = INP(&H3C9)
perSub(i, j) = ColorTable(i, j) / 63
NEXT: NEXT
FOR Waste = 1 TO 63 STEP .2: FOR i = 0 TO 14
OUT &H3C8, i
FOR j = 0 TO 2: OUT &H3C9, ColorTable(i, j) - perSub(i, j) * Waste: NEXT
NEXT: j = Delay(50, KeyNone): NEXT
ERASE ColorTable
ERASE perSub
END SELECT
COLOR 15
END
END SUB
FUNCTION Record% (rType AS INTEGER)
COLOR Red
DIM SwapRecord AS FileRecord, Other AS INTEGER, Temp AS INTEGER
IF PublicValue > TotleRecord THEN PublicValue = TotleRecord
IF PublicValue < 2 THEN PublicValue = 2
SELECT CASE rType
CASE SaveRecord
IF AttribCustom = NewRecord THEN
PUT #1, TotleRecord + 1, TempRecord
TotleRecord = TotleRecord + 1
AttribCustom = TotleRecord
CALL DialogBox(1)
Record% = TRUE
ELSEIF Choose(55, 17, "Coverd old", Red) = TRUE THEN
PUT #1, AttribCustom, TempRecord
CALL DialogBox(1)
Record% = TRUE
ELSE
CALL DialogBox(2)
Record% = FALSE
END IF
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
CASE SaveHighest
Record% = TRUE
IF AttribCustom = NewRecord THEN
PUT #1, TotleRecord + 1, TempRecord
TotleRecord = TotleRecord + 1
AttribCustom = TotleRecord
CALL DialogBox(1)
ELSEIF Choose(55, 17, "Coverd old", Red) = TRUE THEN
GET #1, AttribCustom, SwapRecord
IF TempRecord.Score < SwapRecord.Score THEN TempRecord.Score = SwapRecord.Score
IF TempRecord.Level < SwapRecord.Level THEN TempRecord.Level = SwapRecord.Level
PUT #1, AttribCustom, TempRecord
CALL DialogBox(1)
ELSE
CALL DialogBox(2)
Record% = FALSE
END IF
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
CASE ReadRecord
IF AttribCustom <> NewRecord THEN GET #1, AttribCustom, TempRecord ELSE LOCATE 17, 55: PRINT "No Record!": i = Pause(KeyANY): LOCATE 17, 55: PRINT " "
Record% = AttribCustom
CASE ReadOther
Other = Record(FindRecord)
IF Other <> NewRecord THEN GET #1, Other, TempRecord ELSE LOCATE 17, 55: PRINT "Can't Find!": i = Pause(KeyANY): LOCATE 17, 55: PRINT " "
Record% = Other
CASE ReadHighestScore
Temp = 0
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
IF TempRecord.Score > Temp THEN Temp = TempRecord.Score: Record% = i
NEXT
CASE ReadHighestLevel
Temp = 0
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
IF TempRecord.Level > Temp THEN Temp = TempRecord.Level: Record% = i
NEXT
CASE DeleteRecord
Record% = FALSE
IF AttribCustom <> NewRecord THEN
IF Choose(55, 17, "Delete it", Red) = TRUE THEN
GET #1, TotleRecord, TempRecord
PUT #1, AttribCustom, TempRecord
TotleRecord = TotleRecord - 1
AttribCustom = NewRecord
CALL DialogBox(3)
Record% = TRUE
ELSE CALL DialogBox(4)
END IF
ELSE CALL DialogBox(5)
END IF
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
CASE CreateRecord
AttribCustom = Record(FindRecord)
IF AttribCustom = NewRecord THEN TotleRecord = TotleRecord + 1
Record% = AttribCustom
CASE FindRecord
Record% = NewRecord
FOR i = 2 TO TotleRecord
GET #1, i, TempRecord
IF TempRecord.Names = NameCustom THEN Record% = i: EXIT FOR
NEXT
END SELECT
GET #1, 1, TempRecord
TempRecord.Score = TotleRecord
PUT #1, 1, TempRecord
CALL DialogBox(0)
END FUNCTION
SUB RefurbishLine (rLine AS INTEGER, rColor AS INTEGER)
FOR i = 1 TO Wide
CALL RefurbishUnit(i, rLine, rColor)
NEXT
END SUB
SUB RefurbishRect (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DIM uLeft AS INTEGER, uTop AS INTEGER
uLeft = rX
uTop = rY
LINE (uLeft + perSide, uTop + perSide)-(uLeft + perWide - perSide, uTop + perHigh - perSide), rColor, BF
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Bright
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Bright
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Dark
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Dark
END SUB
SUB RefurbishScreen
FOR i = 1 TO High: FOR j = 1 TO Wide
CALL RefurbishUnit(j, i, Grey)
NEXT: NEXT
EXIT SUB
END SUB
FUNCTION RefurbishTable%
DIM LineCount AS INTEGER, TrueLine AS INTEGER
LineCount = 0
DO
TrueLine = 0
FOR i = High TO 1 STEP -1
isTrue = TRUE
FOR j = 1 TO Wide
IF Table(i, j) = FALSE THEN isTrue = FALSE: EXIT FOR
NEXT
IF isTrue = TRUE THEN TrueLine = i: EXIT FOR
NEXT
IF TrueLine > 0 THEN
FOR i = 0 TO 1
CALL RefurbishLine(TrueLine, Falsh)
IF (Delay(FalshDelay, ScanESC) = Interrupt) THEN EXIT FUNCTION
CALL RefurbishLine(TrueLine, Grey)
IF (Delay(FalshDelay, ScanESC) = Interrupt) THEN EXIT FUNCTION
NEXT
LineCount = LineCount + 1
FOR i = TrueLine TO 1 STEP -1: FOR j = 1 TO Wide
Table(i, j) = Table(i - 1, j)
NEXT: NEXT
FOR i = 1 TO Wide: Table(1, i) = 0: NEXT
IF (Delay(LineDelay, ScanESC) = Interrupt) THEN EXIT FUNCTION
CALL RefurbishScreen
ELSE EXIT DO
END IF
LOOP
RefurbishTable% = LineCount
END FUNCTION
SUB RefurbishUnit (rX AS INTEGER, rY AS INTEGER, rColor AS INTEGER)
DIM uLeft AS INTEGER, uTop AS INTEGER
uLeft = Left + (rX - 1) * perWide
uTop = Top + (rY - 1) * perHigh
IF Table(rY, rX) = TRUE THEN
LINE (uLeft + perSide, uTop + perSide)-(uLeft + perWide - perSide, uTop + perHigh - perSide), rColor, BF
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Bright
LINE (uLeft + (perSide - 1), uTop + (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Bright
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + (perSide - 1), uTop + perHigh - (perSide - 1)), Dark
LINE (uLeft + perWide - (perSide - 1), uTop + perHigh - (perSide - 1))-(uLeft + perWide - (perSide - 1), uTop + (perSide - 1)), Dark
ELSE
LINE (uLeft, uTop)-(uLeft + perWide, uTop + perHigh), Grey, BF
END IF
END SUB
SUB Setup
CLS : COLOR Blue
CALL DrawBox(260, 14, 103, 20, TypeHigh)
CALL DrawBox(50, 50, 540, 400, TypeLow)
CALL DrawBox(380, 61, 40, 20, TypeLow)
CALL DrawBox(428, 93, 40, 20, TypeLow)
LOCATE 2, 35: PRINT "Setup Data"
LOCATE 5, 22: PRINT "Start Diffcult(Default=0):"
LOCATE 7, 22: PRINT "Upgrade need floors(Default=30):"
COLOR Black: LOCATE 5, 20: PRINT CHR$(15)
DO
Diffcult = VAL(GetName$(2, 49, 5, DeepGreen, "", ASC("0"), ASC("9"), Normal))
IF Diffcult > 30 THEN CALL WarnInfo(3) ELSE EXIT DO
LOOP
COLOR Black: LOCATE 5, 20: PRINT " ": LOCATE 7, 20: PRINT CHR$(15)
perLevel = VAL(GetName$(2, 55, 7, DeepGreen, "", ASC("0"), ASC("9"), Normal))
END SUB
SUB ShowRecord (RecordNumber AS INTEGER)
DIM SL AS INTEGER, ST AS INTEGER, SW AS INTEGER, SH AS INTEGER
SL = 224: ST = 200: SW = (320 - SL) * 2: SH = (240 - ST) * 2
DIM SaveShow(GetSize(8, SW, SH)) AS DOUBLE
GET (SL, ST)-(SL + SW, ST + SH), SaveShow
CALL DrawBox(SL, ST, SW, SH, TypeHigh)
CALL DrawBox(SL + 5, ST + 5, 55, 20, TypeLow)
CALL DrawBox(SL + 5, ST + 25, 55, SH - 30, TypeLow)
CALL DrawBox(SL + 65, ST + 5, 55, 20, TypeLow)
CALL DrawBox(SL + 65, ST + 25, 55, SH - 30, TypeLow)
CALL DrawBox(SL + 125, ST + 5, 55, 20, TypeLow)
CALL DrawBox(SL + 125, ST + 25, 55, SH - 30, TypeLow)
COLOR Black
LOCATE 14, 31: PRINT "Name"
LOCATE 14, 38: PRINT "Score"
LOCATE 14, 45: PRINT "Level"
COLOR Blue
GET #1, RecordNumber, TempRecord
LOCATE 16, 30: PRINT TempRecord.Names
LOCATE 16, 38: PRINT STR$(TempRecord.Score)
LOCATE 16, 45: PRINT STR$(TempRecord.Level)
CALL CurInfo(2): i = Pause(KeyANY): CALL CurInfo(0)
PUT (SL, ST), SaveShow, PSET
END SUB
SUB ShowSPRITE (UnitInfor AS SPRITE, addX AS INTEGER, addY AS INTEGER)
DIM xTemp AS INTEGER, yTemp AS INTEGER
TempSprite = UnitInfor
SPRITEDirectionChange
xTemp = TempSprite.w: yTemp = TempSprite.h
FOR i = 0 TO yTemp - 1: FOR j = 0 TO xTemp - 1
IF BasePic(TempSprite.sPoint + i * xTemp + j) = 1 THEN CALL RefurbishRect(addX + (j + TempSprite.Left - 1) * perWide, addY + (i + TempSprite.Top - 1) * perHigh, TempSprite.c)
NEXT: NEXT
END SUB
SUB SPRITEDirectionChange
DIM xTemp AS INTEGER, yTemp AS INTEGER
SELECT CASE TempSprite.Direction
CASE ToLeft: xTemp = TempSprite.h: yTemp = TempSprite.w
CASE ToRight: xTemp = TempSprite.h: yTemp = TempSprite.w
CASE ToUp: xTemp = TempSprite.w: yTemp = TempSprite.h
CASE ToDown: xTemp = TempSprite.w: yTemp = TempSprite.h
END SELECT
TempSprite.w = xTemp: TempSprite.h = yTemp
TempSprite.sPoint = TempSprite.Offset + TempSprite.Direction * TempSprite.w * TempSprite.h
END SUB
FUNCTION ToLand%
CLS
ToLand% = 0
CALL DrawBox(240, 14, 150, 20, TypeHigh)
COLOR Black
LOCATE 2, 33: PRINT "Russia Diamonds"
COLOR Blue
CALL DrawBox(100, 202, 440, 60, TypeHigh)
LOCATE 15, 15: PRINT "Please input your name:"
CALL DrawBox(320, 222, 80, 20, TypeLow)
NameCustom = GetName$(6, 42, 15, DeepGreen, "", 0, 255, Normal)
SELECT CASE NameCustom
CASE "Setup ": ToLand% = 1
CASE "Manage": ToLand% = 2
CASE "End ": ToLand% = 3
CASE "end ": ToLand% = 4
CASE "END ": ToLand% = 5
CASE "Help ": ToLand% = 6
CASE ELSE: AttribCustom = Record%(FindRecord)
END SELECT
END FUNCTION
SUB WarnInfo (WarnRecord AS INTEGER)
SOUND WarnSound, .5
SELECT CASE WarnRecord
CASE 1: WarnContent$ = "You must input more letters to create your name!"
CASE 2: WarnContent$ = "Length reach the limit!"
CASE 3: WarnContent$ = "Diffcult must between 0 and 30!"
CASE ELSE: WarnContent$ = "Unknow warn!"
END SELECT
i = GetMassage((630 - LEN(WarnContent$) * 8) / 2, 230, WarnContent$, Yellow, KeyEnter)
END SUB
