clock.ctl

来自「吃豆子游戏的源代码。 嘿嘿」· CTL 代码 · 共 182 行

VERSION 5.00
Begin VB.UserControl ProgBar 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   ClientHeight    =   3630
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5145
   ControlContainer=   -1  'True
   ScaleHeight     =   3630
   ScaleWidth      =   5145
   Begin VB.PictureBox Pic 
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Left            =   0
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   0
      Top             =   0
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   6
      Left            =   3555
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   7
      Top             =   2835
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   5
      Left            =   990
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   6
      Top             =   3060
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   4
      Left            =   3735
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   5
      Top             =   1440
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   3
      Left            =   315
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   4
      Top             =   1620
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   2
      Left            =   1980
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   3
      Top             =   1800
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   1
      Left            =   3240
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   2
      Top             =   135
      Visible         =   0   'False
      Width           =   1485
   End
   Begin VB.PictureBox Timer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00004080&
      BorderStyle     =   0  'None
      Height          =   1485
      Index           =   0
      Left            =   1665
      ScaleHeight     =   1485
      ScaleWidth      =   1485
      TabIndex        =   1
      Top             =   45
      Visible         =   0   'False
      Width           =   1485
   End
End
Attribute VB_Name = "ProgBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Sub UserControl_Initialize()
 Pic.Picture = Timer(0) 'set the default value
 'make the timer round
 Call SetWindowRgn(UserControl.hwnd, CreateEllipticRgn(0, 0, (Pic.Width / Screen.TwipsPerPixelX) + 1, Int(Pic.Height / Screen.TwipsPerPixelY) + 1), True)
End Sub
'make sure the timer can only be one size
Private Sub UserControl_Resize()
 Width = Pic.Width
 Height = Pic.Height
End Sub
'set the current timer value
Public Sub Value(newVal As Integer)
On Error Resume Next
 If newVal > 7 Or newVal < 0 Then Exit Sub 'make sure there in no invalid number
 BitBlt Pic.hDC, 0, 0, 100, 100, Timer(newVal).hDC, 0, 0, SRCCOPY 'draw the current picture (used bitblt to get rid of flashing side-effect)
 If newVal = 7 Then ' the clock has reached the max, so go back to 0
   For I = 6 To 0 Step -1 'go backwards through the clock
    BitBlt Pic.hDC, 0, 0, 100, 100, Timer(I).hDC, 0, 0, SRCCOPY 'draw the image
    Call Pause(0.05) 'wait .05 seconds (fixes more flashing problems)
   Next I
   Exit Sub
 End If
End Sub
'load these pictures if the timer is for drunkness
Public Sub LoadUserPicDRUNK()
 LoadPic UserControl.Timer, "timer0", 0, "usercontrols"
 LoadPic UserControl.Timer, "timer1", 1, "usercontrols"
 LoadPic UserControl.Timer, "timer2", 2, "usercontrols"
 LoadPic UserControl.Timer, "timer3", 3, "usercontrols"
 LoadPic UserControl.Timer, "timer4", 4, "usercontrols"
 LoadPic UserControl.Timer, "timer5", 5, "usercontrols"
 LoadPic UserControl.Timer, "timer6", 6, "usercontrols"
 Pic.Picture = Timer(0) 'set the default value
End Sub
'load these pictures if the timer is for protection
Public Sub LoadUserPicSHIELD()
 LoadPic UserControl.Timer, "shieldtimer0", 0, "usercontrols"
 LoadPic UserControl.Timer, "shieldtimer1", 1, "usercontrols"
 LoadPic UserControl.Timer, "shieldtimer2", 2, "usercontrols"
 LoadPic UserControl.Timer, "shieldtimer3", 3, "usercontrols"
 LoadPic UserControl.Timer, "shieldtimer4", 4, "usercontrols"
 LoadPic UserControl.Timer, "shieldtimer5", 5, "usercontrols"
 LoadPic UserControl.Timer, "shieldtimer6", 6, "usercontrols"
 Pic.Picture = Timer(0) 'set the default value
End Sub