home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch14 / frmsleep.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  4.5 KB  |  128 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSleep 
  3.    Caption         =   "Sleeper"
  4.    ClientHeight    =   1455
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4395
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   1455
  10.    ScaleWidth      =   4395
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton cmdSleep 
  13.       Caption         =   "GoodNight"
  14.       Height          =   465
  15.       Left            =   1350
  16.       TabIndex        =   2
  17.       Top             =   720
  18.       Width           =   1545
  19.    End
  20.    Begin VB.TextBox txtSeconds 
  21.       Height          =   375
  22.       Left            =   2160
  23.       TabIndex        =   0
  24.       Text            =   "15"
  25.       Top             =   180
  26.       Width           =   1725
  27.    End
  28.    Begin VB.Label Label1 
  29.       Alignment       =   1  'Right Justify
  30.       Caption         =   "How Long Should I Sleep?"
  31.       Height          =   285
  32.       Left            =   180
  33.       TabIndex        =   1
  34.       Top             =   270
  35.       Width           =   1905
  36.    End
  37. Attribute VB_Name = "frmSleep"
  38. Attribute VB_GlobalNameSpace = False
  39. Attribute VB_Creatable = False
  40. Attribute VB_PredeclaredId = True
  41. Attribute VB_Exposed = False
  42. Option Explicit
  43. ' Copyright 
  44.  1997 by Desaware Inc. All Rights Reserved
  45. Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
  46. Private Declare Function OpenWaitableTimer Lib "kernel32" Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
  47. Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal hTimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
  48. Private Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long)
  49. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  50. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  51. Private Const ERROR_ALREADY_EXISTS = 183&
  52. Private Const WAIT_OBJECT_0 = 0
  53. Private Const WAIT_TIMEOUT = &H102&
  54. Private Type FILETIME
  55.         dwLowDateTime As Long
  56.         dwHighDateTime As Long
  57. End Type
  58. Dim TimerObjectHandle&
  59. Private Sub cmdSleep_Click()
  60.    GoToSleep False
  61. End Sub
  62. Private Sub Form_Load()
  63.    Dim res&
  64.    Dim ft As FILETIME
  65.    TimerObjectHandle = CreateWaitableTimer(0, True, "Ch14SleeperTimer")
  66.    If Err.LastDllError = ERROR_ALREADY_EXISTS Then
  67.       ' Another app already created the timer,
  68.       ' we may need to go to sleep now
  69.       GoToSleep True
  70.    Else
  71.       ft.dwLowDateTime = -1
  72.       ft.dwHighDateTime = -1
  73.       res = SetWaitableTimer(TimerObjectHandle, ft, 0, 0, 0, 0)
  74.    End If
  75. End Sub
  76. ' Function to go to sleep.
  77. ' Slightly different behavior if called during form load
  78. Public Sub GoToSleep(ByVal IsLoading As Boolean)
  79.    Dim ft As FILETIME
  80.    Dim IsBusy As Long
  81.    Dim delay As Double
  82.    Dim delaylow As Double
  83.    Dim Unit32 As Double
  84.    Dim res&
  85.    ' Is object signaled now?
  86.    IsBusy = WaitForSingleObject(TimerObjectHandle, 0)
  87.       
  88.    ' We know WAIT_OBJECT_0 is 0, so False indicates signaled
  89.    If IsLoading Then
  90.       If IsBusy Then
  91.          MsgBox "Hey! Everyone else is asleep already! I'm going to join them!", vbOKOnly, "I'm Tired"
  92.       Else
  93.          ' It's not active
  94.          Exit Sub
  95.       End If
  96.    End If
  97.    ' Update in case state changed during message box
  98.    IsBusy = WaitForSingleObject(TimerObjectHandle, 0)
  99.    If Not IsBusy Then
  100.       ' Set the timer
  101.       Unit32 = CDbl(&H10000) * CDbl(&H10000)
  102.       delay = CDbl(txtSeconds.Text)
  103.       delay = delay * 1000 * 10000
  104.       ' Delay is now 100ns
  105.          
  106.       ft.dwHighDateTime = -CLng(delay / Unit32) - 1
  107.       
  108.       delaylow = -Unit32 * (delay / Unit32 - Fix(delay / Unit32))
  109.       If delaylow < CDbl(&H80000000) Then
  110.          delaylow = Unit32 + delaylow
  111.       End If
  112.       ft.dwLowDateTime = CLng(delaylow)
  113.       
  114.       res = SetWaitableTimer(TimerObjectHandle, ft, 0, 0, 0, 0)
  115.    End If
  116.    Me.Hide
  117.    App.TaskVisible = False
  118.    IsBusy = WaitForSingleObject(TimerObjectHandle, -1)
  119.    frmMorning.Move Me.Left, Me.Top
  120.    frmMorning.Show vbModal
  121.    Me.Show
  122.    App.TaskVisible = True
  123. End Sub
  124. ' Close the handle on unload
  125. Private Sub Form_Unload(Cancel As Integer)
  126.    Call CloseHandle(TimerObjectHandle)
  127. End Sub
  128.