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