OpenSpace > petite classe VB comme ça

OpenSpace > Zone Ordinateurs > Programmation

PoP

23/08/2002 12:37

CODE

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

Persistable = 0 'NotPersistable

DataBindingBehavior = 0 'vbNone

DataSourceBehavior = 0 'vbNone

MTSTransactionMode = 0 'NotAnMTSObject

END

Attribute VB_Name = "Stopwatch"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

' *

' * Copyright (C) 2002 Marc Poppleton

' * surfing.pop@free.fr

' *

' * This program is free software; you can redistribute it and/or

' * modify it under the terms of the GNU General Public License

' * as published by the Free Software Foundation; either version 2

' * of the License, or any later version.

' *

' * This program is distributed in the hope that it will be useful,

' * but WITHOUT ANY WARRANTY; without even the implied warranty of

' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

' * GNU General Public License for more details.

' *

' * You should have received a copy of the GNU General Public License

' * along with this program; if not, write to the Free Software

' * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

' *

Private Declare Function GetTickCount Lib "kernel32" () As Long ' @description: returns number of ticks since system booted

Private strtime As String ' @description: local copy of textual representation of delay between lngnow and lngstart

Private lngstart As Long ' @description: number of ticks when stopwatch started

Private lngnow As Long ' @description: actual number of ticks

Private blnrunning As Boolean ' @description: application running or not

Private blnholding As Boolean ' @description: stopwatch in hold or not

' @name: Class_Initialize

' @range: Private

' @arguments: none

' @type: none

' @description: Mostly Harmless

Private Sub Class_Initialize()

strtime = ""

lngstart = 0

lngnow = 0

blnrunning = False

blnholding = False

End Sub

' @name: ticksToTime

' @range: Private

' @arguments: Long

' @type: String

' @description: This function returns a string corresponding to a dd/hh/mm/ss (days, hours, minutes, seconds) format of the parameter

Private Function ticksToTime(lngticks As Long) As String

Dim strhundredth As String

Dim strseconds As String

Dim strminutes As String

Dim strhours As String

Dim strdays As String

Dim dblswap As Double

dblswap = lngticks / 86400000

strdays = leadingZero(Int(dblswap))

dblswap = (dblswap - strdays) * 24

strhours = leadingZero(Int(dblswap))

dblswap = (dblswap - strhours) * 60

strminutes = leadingZero(Int(dblswap))

dblswap = (dblswap - strminutes) * 60

strseconds = leadingZero(Int(dblswap))

dblswap = (dblswap - strseconds) * 100

strhundredth = leadingZero(Int(dblswap))

ticksToTime = strdays & ":" & strhours & ":" & strminutes & ":" & strseconds & ":" & strhundredth

End Function

' @name: leadingZero

' @range: Private

' @arguments: Integer

' @type: String

' @description: This function returns a string corresponding to a 00 format of the parameter

Private Function leadingZero(intinput As Integer) As String

Dim stranswer As String

If intinput < 10 Then

stranswer = "0" & intinput

Else

stranswer = intinput

End If

leadingZero = stranswer

End Function

' @name: time

' @range: Public Property

' @arguments: none

' @type: String

' @description: Seems obvious, no?

Public Property Get time() As String

time = strtime

End Property

' @name: running

' @range: Public Property

' @arguments: none

' @type: Boolean

' @description: Hu, now what could running be...Ah ah, telling the truth about the stopwatch running!

Public Property Get running() As Boolean

running = blnrunning

End Property

' @name: holding

' @range: Public Property

' @arguments: none

' @type: Boolean

' @description: You know on those fancy stopwatches you have a "Hold" button that lets you freeze the display so you can note it down or something? Well, this tells you if the stopwatch is in "hold mode" or not

Public Property Get holding() As Boolean

holding = blnholding

End Property

' @name: reset

' @range: Public Sub

' @arguments: none

' @type: none

' @description: now that's a hard one! No very useful but...every stopwatch has one so why can't mine?

Public Sub reset()

If Not (blnrunning) Then

strtime = ""

lngstart = 0

lngnow = 0

blnrunning = False

blnhold = False

End If

End Sub

' @name: hold

' @range: Public Sub

' @arguments: none

' @type: none

' @description: turn on or off the "hold mode"

Public Sub hold()

If blnholding Then

blnholding = False

Else

blnholding = True

End If

End Sub

' @name: halt

' @range: Public Sub

' @arguments: none

' @type: none

' @description: I wanted to call it Stop in the first place but you can't given it's already used. This stops the stopwatch

Public Sub halt()

blnrunning = False

End Sub

' @name: start

' @range: Public Sub

' @arguments: none

' @type: none

' @description: Could this have something to do with getting the stopwatch running?

Public Sub start()

blnrunning = True

lngstart = GetTickCount

While blnrunning

DoEvents

lngnow = GetTickCount

If Not (blnholding) Then

strtime = ticksToTime((lngnow - lngstart))

End If

Wend

End Sub

Sha

23/08/2002 17:41

Tain comment c'est documenté, j'ai honte moi, maintenant !