回 帖 发 新 帖 刷新版面

主题:刚学QB,写了一个福彩双球选号程序,请大家批评。

'一年前学QB,试着写了这个双色球摇号的小程序,现在看来对有些代码不满意、不简洁,修改了一下,请各位批评
'----------------------------------------------------------------------------

DECLARE SUB abc5 (ssq$())
DECLARE SUB abc6 (ssq$())
DECLARE SUB abc3 (hq$(), ssq$())
DECLARE SUB abc4 (lq$(), ssq$())
DECLARE SUB abc1 ()
DECLARE SUB abc2 (hq$(), lq$())
DIM hq$(33), lq$(16), ssq$(7)
DO
  CALL abc1                   '画图形框,显示文字
  CALL abc2(hq$(), lq$())     '数组赋值
  CALL abc3(hq$(), ssq$())    '洗红球,输出红球到数组
  CALL abc4(lq$(), ssq$())    '洗蓝球,输出蓝球到数组
  CALL abc5(ssq$())           '号码排序
  CALL abc6(ssq$())           '号码显示
  DO
    LET k$ = INKEY$
  LOOP UNTIL k$ = CHR$(27) OR k$ = CHR$(13)
  IF k$ = CHR$(27) THEN
    CLS
    EXIT DO
  END IF
LOOP
END
DATA 01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33

SUB abc1
  CLS
  COLOR 14
  PRINT CHR$(12)
  LOCATE 7, 20, 0
  PRINT CHR$(218) + STRING$(40, 196) + CHR$(191)
  FOR i = 1 TO 10
    LOCATE , 20
    PRINT CHR$(179) + SPACE$(40) + CHR$(179)
  NEXT i
  LOCATE , 20
  PRINT CHR$(192) + STRING$(40, 196) + CHR$(217)
 
  COLOR 12
  LOCATE 10, 30
  PRINT "欢迎使用双色球选号程序"
  COLOR 15
  LOCATE 15, 28
  PRINT "Enter 选号         Esc 退出"
  SLEEP 1.5
  DO
    LET k$ = INKEY$
  LOOP UNTIL k$ = CHR$(13) OR k$ = CHR$(27)
  IF k$ = CHR$(27) THEN
    CLS
    END
  END IF
  CLS
END SUB

SUB abc2 (hq$(), lq$())
  RESTORE
  FOR a = 1 TO 33         '红球数组赋值
    READ hq$(a)
  NEXT a
 
  RESTORE
  FOR a = 1 TO 16         '蓝球数组赋值
    READ lq$(a)
  NEXT a
END SUB

SUB abc3 (hq$(), ssq$())
  LOCATE 8, 28
  FOR ssq = 0 TO 5
    FOR x = 1 TO 827
      RANDOMIZE TIMER
      LET a = INT(RND * (30 - ssq) + 2)      '随机设定洗球位置
      FOR y = 1 TO (33 - ssq) - a
        LET a = a + 1
        SWAP hq$(y), hq$(a)                  '交叉洗红球
      NEXT y
      LET a = 16 - ssq
      FOR z = 1 TO 16 - ssq
        LET a = a + 1
        SWAP hq$(z), hq$(a)                  '折叠洗红球
      NEXT z
    NEXT x
    COLOR 12
    PRINT USING "&  "; hq$(1);               '号码显示
    FOR kjhq = 1 TO 32 - ssq
      SWAP hq$(kjhq), hq$(kjhq + 1)          '将洗出的红球移到数组尾
    NEXT kjhq
  NEXT ssq
  FOR x = 1 TO 6
    LET ssq$(x) = hq$(27 + x)                '输出数据
  NEXT x
END SUB

SUB abc4 (lq$(), ssq$())
  FOR x = 1 TO 827
    RANDOMIZE TIMER
    LET a = INT(RND * 13 + 2)
    FOR y = 1 TO 16 - a
      LET a = a + 1
      SWAP lq$(y), lq$(a)           '洗蓝球
    NEXT y
    
    LET a = 8
    FOR z = 1 TO 8
      LET a = a + 1
      SWAP lq$(z), lq$(a)           '洗蓝球
    NEXT z
  NEXT x
  LOCATE 8, 52
  COLOR 9
  PRINT lq$(1)
  LET ssq$(7) = lq$(1)              '数组赋值
END SUB

SUB abc5 (ssq$())
  FOR x = 1 TO 5
    FOR y = x + 1 TO 6
      IF ssq$(x) > ssq$(y) THEN
        SWAP ssq$(x), ssq$(y)               '号码排序
      END IF
    NEXT y
  NEXT x
END SUB

SUB abc6 (ssq$())
  COLOR 12
  LOCATE 5, 32
  PRINT "希 望 您 中 500 万"
  LOCATE 12, 28
  FOR a = 1 TO 6
    PRINT USING "&  "; ssq$(a);        '号码显示
  NEXT a
  COLOR 9
  LOCATE 12, 52
  PRINT ssq$(7);
  COLOR 14
  LOCATE 13, 26
  PRINT STRING$(30, 196)               '画线
  LOCATE 11, 26
  PRINT STRING$(30, 196)               '画线
  COLOR 15
  LOCATE 16, 27
  PRINT "Enter 继续选号       Esc 退出"
END SUB

回复列表 (共12个回复)

11 楼

随机性很高!

12 楼

很 羡慕 你啊  这么 厉害  我对这么东西 是 文盲 哈哈 所以 起的名字 也是 文盲  
希望 哪位老师 能 教我 怎么用 你 这个程序 还有就是你能编出程序 也应该负责教怎么用 因为遇见向我这样的 文盲是看 不懂的 嘿嘿 。。。。我Q313221200 希望指教。。。最好帮我弄个 现成的 哈哈。。

我来回复

您尚未登录,请登录后再回复。点此登录或注册