VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   2028
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4752
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2028
   ScaleWidth      =   4752
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'ȱʡ
   Begin VB.Timer Timer4 
      Enabled         =   0   'False
      Left            =   3120
      Top             =   1680
   End
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   5
      Left            =   2640
      Top             =   1680
   End
   Begin VB.Timer Timer2 
      Interval        =   50
      Left            =   2160
      Top             =   1680
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   999
      Left            =   1680
      Top             =   1680
   End
   Begin VB.Label Label 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "00:00"
      BeginProperty Font 
         Name            =   ""
         Size            =   72
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   1695
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   4095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
Const SWP_NOSIZE = &H1

Const MINEDGELEN = 30
Const SCOLLSPEED = 300


Dim initTime As Double
Dim isMouseEnter As Boolean
Dim isDraging As Boolean
Dim stTime As Date, svTime As Date
Dim sideSlide As Byte
Dim scolling As Boolean
Dim scollDir As Boolean 'True->In False->Out
Dim holding As Long

Dim timerState As Integer
'1:30min 2:40min 3:45min 4:-


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        ReleaseCapture
        SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
        isDraging = True
    ElseIf Button = 2 Then
        If (timerState >= 0) Then
            StartBlack
        Else
            EndBlack
        End If
    End If
End Sub
Private Sub SetWindowsAlpha(alpha As Integer)
    SetLayeredWindowAttributes hwnd, 0, alpha, LWA_ALPHA
End Sub
Private Sub Form_Load()

    Dim rtn As Long
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
    SetWindowsFront
    SetWindowsAlpha 50
    stTime = Now()
    Timer1.Enabled = True
End Sub


Sub SetWindowsFront()
    'Dim tw As Long, th As Long
    'tw = Form1.Width
    'th = Form1.Height
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW + SWP_NOSIZE
    'Form1.Width = tw
    'Form1.Height = th
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    If (isDraging = True) Then
        OnDragFinish
        isDraging = False
    End If
    Exit Sub
    'Debug.Print Form1.Left & "+" & Form1.Top
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

    'MsgBox "get"
End Sub



Private Sub Label_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Form_MouseDown Button, Shift, x, y
End Sub

Private Sub Label_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Form_MouseUp Button, Shift, x, y
End Sub

Private Sub Label_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Form_MouseMove Button, Shift, x, y
End Sub

Sub OnMouseEntry()
    'Debug.Print ("Enter")
    If (IsFullyOut() = False And scolling = False) Then
        StartScollOut
    End If
End Sub

Sub OnMouseExit()
    'Debug.Print ("Exit")
    If (IsFullyIn() = False And scolling = False And holding = 0) Then
        StartScollIn
    ElseIf (holding <> 0) Then
        PopOut
    End If
End Sub
Sub StartScollIn()
    scolling = True
    scollDir = True
    Timer3.Enabled = True
End Sub
Sub StartScollOut()
    scolling = True
    scollDir = False
    Timer3.Enabled = True
End Sub
Sub StartBlack()
    'Recalc Screen Height and Width
    Form2.Left = 0
    Form2.Top = 0
    Form2.Width = Screen.Width
    Form2.Height = Screen.Height
    Form2.Show
    timerState = -timerState - 1
    svTime = Now() - stTime
    stTime = Now()
    Form1.BackColor = &H0&
    Label.ForeColor = &HFFFF&
    SetWindowsAlpha 255
    holding = -1
    Timer1_Timer
End Sub
Sub EndBlack()
    Form2.Hide
    If (timerState <> -10) Then
        timerState = -timerState - 2
        If (timerState < 0) Then timerState = 0
        stTime = Now() - svTime
    Else
        timerState = 0
        stTime = Now()
    End If
    svTime = 0
    Form1.BackColor = &H8000000F
    Label.ForeColor = &H0&
    SetWindowsAlpha 50
    holding = 0
    Timer1_Timer
End Sub

Sub PopOut()
    If (Form1.Left >= Screen.Width - Form1.Width) Then
        Form1.Left = Screen.Width - Form1.Width
    End If
    If (Form1.Left <= 0) Then
        Form1.Left = 0
    End If
    If (Form1.Top <= 0) Then
        Form1.Top = 0
    End If
End Sub
Sub OnDragFinish()
    'Debug.Print ("Finish")
    sideSlide = 0
    If (Form1.Left >= Screen.Width - Form1.Width) Then
        sideSlide = 3
        'Debug.Print 3
    End If
    If (Form1.Top >= Screen.Height - Form1.Height) Then
        Form1.Top = Screen.Height - Form1.Height
    End If
    If (Form1.Left <= 0) Then
        sideSlide = 1
        'Debug.Print 1
    End If
    If (Form1.Top <= 0) Then
        If (sideSlide = 1) Then Form1.Left = 0
        If (sideSlide = 3) Then Form1.Left = Screen.Width - Form1.Width
        sideSlide = 2
        'Debug.Print 2
    End If
    If (sideSlide > 0 And holding = 0) Then
        StartScollIn
    ElseIf (holding <> 0) Then
        PopOut
    End If
End Sub

Private Sub Timer1_Timer()
    Dim nwTime As Date
    nwTime = Now() - stTime
    If (Hour(nwTime) * 60 + Minute(nwTime) > 99) Then
        Label.Caption = "99:99" 'Set to Max Value
    Else
        Label.Caption = Format(Minute(nwTime) + 60 * Hour(nwTime), "00") & ":" & Format(Second(nwTime), "00")
    End If
    Select Case timerState
        Case 0:
            If (Minute(nwTime) >= 30 Or Hour(nwTime) >= 1) Then
                Form1.BackColor = &HFFFF&
                timerState = 1
                holding = 2000
                StartScollOut
            End If
        Case 1:
            If (Minute(nwTime) >= 40 Or Hour(nwTime) >= 1) Then
                Form1.BackColor = &HD0FF&
                SetWindowsAlpha 100
                timerState = 2
                holding = 2000
                StartScollOut
            End If
        Case 2:
            If (Minute(nwTime) >= 45 Or Hour(nwTime) >= 1) Then
                Form1.BackColor = &HB0FF&
                Label.ForeColor = &HC0&
                SetWindowsAlpha 150
                timerState = 3
                holding = -1
                StartScollOut
            End If
        Case Is < 0:
            If (timerState <> -10) Then
                If (Minute(nwTime) >= 5) Then
                    Label.ForeColor = &HFFFFFF
                    timerState = -10
                End If
            End If
                
    End Select

        
    'Debug.Print Format(nwTime, "hh:nn:ss")
End Sub
Function IsFullyIn() As Boolean
    Select Case sideSlide
        Case 1:
            IsFullyIn = Form1.Left <= MINEDGELEN - Form1.Width
            If (IsFullyIn) Then Form1.Left = MINEDGELEN - Form1.Width
        Case 2:
            IsFullyIn = Form1.Top <= MINEDGELEN - Form1.Height
            If (IsFullyIn) Then Form1.Top = MINEDGELEN - Form1.Height
        Case 3:
            IsFullyIn = Form1.Left >= Screen.Width - MINEDGELEN
            If (IsFullyIn) Then Form1.Left = Screen.Width - MINEDGELEN
    End Select
End Function
Function IsFullyOut() As Boolean
    Select Case sideSlide
        Case 1:
            IsFullyOut = Form1.Left >= -MINEDGELEN
            If (IsFullyOut) Then Form1.Left = -MINEDGELEN
        Case 2:
            IsFullyOut = Form1.Top >= -MINEDGELEN
            If (IsFullyOut) Then Form1.Top = -MINEDGELEN
        Case 3:
            IsFullyOut = Form1.Left <= Screen.Width - Form1.Width + MINEDGELEN
            If (IsFullyOut) Then Form1.Left = Screen.Width - Form1.Width + MINEDGELEN
    End Select
End Function
Sub ScollInDir()
    Dim tx As Long, ty As Long
    Select Case sideSlide
        Case 1:
            tx = SCOLLSPEED
        Case 2:
            ty = SCOLLSPEED
        Case 3:
            tx = -SCOLLSPEED
    End Select
    If (scollDir) Then
        tx = -tx: ty = -ty
    End If
    Form1.Left = Form1.Left + tx
    Form1.Top = Form1.Top + ty
End Sub
Private Sub Timer2_Timer()
    Dim gx1, gy1, gx2, gy2
    gx1 = ScaleX(Me.Left, vbTwips, vbPixels)
    gy1 = ScaleY(Me.Top, vbTwips, vbPixels)
    gx2 = ScaleX(Me.Width, vbTwips, vbPixels)
    gy2 = ScaleY(Me.Height, vbTwips, vbPixels)
    Me.Cls
    Dim lpPoint As POINTAPI
    GetCursorPos lpPoint
    'Label.Caption = "X=" & lpPoint.x & vbNewLine & "Y=" & lpPoint.y
    If lpPoint.x > gx1 And lpPoint.x < gx1 + gx2 And lpPoint.y > gy1 And lpPoint.y < gy1 + gy2 Then
        If isMouseEnter = False Then
            OnMouseEntry
            isMouseEnter = True
        End If
    Else
        If isMouseEnter = True Then
            OnMouseExit
            isMouseEnter = False
        End If
    End If
    If (holding > 0) Then
        holding = IIf(holding - 50 > 0, holding - 50, 0)
        If (holding = 0) Then
            StartScollIn
        End If
    End If
        
End Sub

Private Sub Timer3_Timer()

    If (scolling) Then
        If (scollDir) Then
            If (IsFullyIn()) Then
                scolling = False
                Timer3.Enabled = False
            Else
                ScollInDir
            End If
        Else
            If (IsFullyOut()) Then
                scolling = False
                Timer3.Enabled = False
            Else
                ScollInDir
            End If
        End If
    End If
            
End Sub