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 / classlib / desaware / dwtime.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  2.0 KB  |  61 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwTime"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. ' Class dwTime
  11. ' System time manipulation class
  12. ' Copyright (c) 1996 by Desaware Inc.
  13. ' Part of the Desaware API Classes Library
  14. ' All rights reserved
  15.  
  16. #If Win32 Then
  17. Private Declare Sub apiGetLocalTime Lib "kernel32" Alias "GetLocalTime" (lpSystemTime As SYSTEMTIME)
  18. Private Declare Function apiGetTickCount& Lib "kernel32" Alias "GetTickCount" ()
  19. Private Declare Function apiSetSystemTime& Lib "kernel32" Alias "SetSystemTime" (lpSystemTime As SYSTEMTIME)
  20. #Else
  21. Private Declare Function apiGetTickCount& Lib "user" Alias "GetTickCount" ()
  22. #End If 'WIN32
  23.  
  24.  
  25. Public Function GetLocalTime() As dwSystemTime
  26. Attribute GetLocalTime.VB_HelpID = 2344
  27. Attribute GetLocalTime.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  28. #If Win32 Then
  29.     Dim tmpSysTime As SYSTEMTIME
  30.     Dim tmpDwSysTime As New dwSystemTime
  31.  
  32.     apiGetLocalTime tmpSysTime
  33.     tmpDwSysTime.CopyFromSYSTEMTIME agGetAddressForObject(tmpSysTime)
  34.     Set GetLocalTime = tmpDwSysTime
  35. #Else
  36.     RaiseError DWERR_NOTINWIN16, "dwSystemTime"
  37. #End If
  38. End Function
  39.  
  40. Public Function GetTickCount() As Long
  41. Attribute GetTickCount.VB_HelpID = 2356
  42. Attribute GetTickCount.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  43.     GetTickCount = apiGetTickCount()
  44. End Function
  45.  
  46. Public Sub SetSystemTime(lpSystemTime As dwSystemTime)
  47. Attribute SetSystemTime.VB_HelpID = 2343
  48. Attribute SetSystemTime.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  49. #If Win32 Then
  50.     Dim tmpSysTime As SYSTEMTIME
  51.     Dim ret&
  52.  
  53.     lpSystemTime.CopyToSYSTEMTIME agGetAddressForObject(tmpSysTime)
  54.     ret& = apiSetSystemTime(tmpSysTime)
  55.     If ret& = 0 Then RaiseError DWERR_APIRESULT, "dwSystemTime"
  56. #Else
  57.     RaiseError DWERR_NOTINWIN16, "dwSystemTime"
  58. #End If
  59. End Sub
  60.  
  61.