⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 module1.bas

📁 我们是厦门理工学院的学生,因为我们急需贵网站的一分重要资料下载,希望能给予下载权限,虽然上传的原码比较普通,但希望站长能给予谅解,
💻 BAS
字号:
Attribute VB_Name = "Module1"
Option Explicit

Public LeiCol As Integer
Public LeiRow As Integer
Public LeiNums As Integer
Public LeiNums1 As Integer
Public MeW As Integer, MeH As Integer, MeFlag As Boolean
Public lei(0 To 31, 0 To 25) As Integer
Public JieDian(0 To 31, 0 To 25) As Integer
Public lei1(720) As Integer

Public TimeNums As Integer
Public LeiFlag As Boolean
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public tongjiflag As Boolean
Public TongjiIndex As Integer

Public jibie As Integer
Public leiname(2) As String
Public leitime(2) As String



Public Sub SetSize(row As Integer, col As Integer)
 LeiCol = col
 LeiRow = row
 With Form1
 '------------------------
    .picBar.Width = 16 * col + 1
    .picBar.Height = 16 * row + 1
    
     MeFlag = True
    .Width = (.picBar.Width + 17) * 15 + 120
    .Height = (.picBar.Height + 62) * 15 + 690
    
    .img2.Left = .picBar.Left + .picBar.Width - 3
    .img1.Left = .img2.Left - 50
    .img3.Left = .img2.Left - 2
     
    .img4.Top = .picBar.Top + .picBar.Height - 2
    .img5.Top = .img4.Top
    .img3.Top = .img4.Top
    
   
    MeW = .Width
    MeH = .Height
    MeFlag = False
    .imgNew.Left = .ScaleWidth / 2 - .imgNew.Width / 2
    
    
    .LeiNumBar(1).Left = .img1.Left + 6
    .TimeNum(0).Left = .img1.Left + 6
    .TimeNum(1).Left = .TimeNum(0).Left + 13
    .TimeNum(2).Left = .TimeNum(1).Left + 13
    
    '------------------------------------------------------------------
   Dim i As Integer, j As Integer
   .imgLei(0).Picture = .ImageList1.ListImages(1).Picture
  For i = 1 To row
   For j = 1 To col
     'If i = row And j = col Then GoTo exitfor
     .imgLei(((i - 1) * col + j - 1)).Picture = .ImageList1.ListImages(1).Picture
     .imgLei((i - 1) * col + j - 1).Left = (j - 1) * (.imgLei(0).Width)
     .imgLei((i - 1) * col + j - 1).Top = (i - 1) * (.imgLei(0).Height)
   Next j
  Next i
exitfor:
    
    .imgLei((i - 1) * col + j - 1).Left = (j - 1) * (.imgLei(0).Width)
    .imgLei((i - 1) * col + j - 1).Top = (i - 1) * (.imgLei(0).Height)
   
 End With
 '-------------------------
   BuLei
 '-------------------------
 
End Sub
Public Sub BuLei()
 
 Dim n As Integer
 Dim x As Integer
 Dim i As Integer
 Dim j As Integer
 
 Randomize (Timer)
 For i = 0 To LeiCol + 1
  For j = 0 To LeiRow + 1
    lei(i, j) = 0
  Next j, i
  
  For i = 0 To LeiCol * LeiRow
   lei1(i) = 0
  Next i
  
  n = 0
  lei1(n) = Rnd * LeiCol * LeiRow
  
 While n < LeiNums
  x = Rnd * LeiCol * LeiRow
  If rndTest(x, n) Then
    n = n + 1
    lei1(n) = x
  End If
 Wend
 
 For i = 0 To LeiNums - 1
   lei((lei1(i) Mod LeiCol) + 1, lei1(i) \ LeiCol + 1) = 9
 Next i
 
 For i = 1 To LeiRow
   For j = 1 To LeiCol
     If lei(j, i) <> 9 Then
        lei(j, i) = slei(j, i)
     End If
   Next j
 Next i
 
 
 
 
End Sub

Public Function slei(ByVal x As Integer, ByVal y As Integer) As Integer
  Dim n As Integer
  If lei(x - 1, y - 1) = 9 Then n = n + 1
  If lei(x, y - 1) = 9 Then n = n + 1
  If lei(x + 1, y - 1) = 9 Then n = n + 1
  
  If lei(x - 1, y) = 9 Then n = n + 1
  If lei(x + 1, y) = 9 Then n = n + 1
  
  If lei(x - 1, y + 1) = 9 Then n = n + 1
  If lei(x, y + 1) = 9 Then n = n + 1
  If lei(x + 1, y + 1) = 9 Then n = n + 1
   slei = n
End Function
Public Function rndTest(ByVal x As Integer, ByVal n As Integer) As Boolean
  Dim i As Integer
  
  For i = 0 To n
       If x = lei1(i) Then rndTest = False: Exit Function
  Next i
  rndTest = True
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -