Minuterie et divers api
Soyez le premier à donner votre avis sur cette source.
Vue 6 790 fois - Téléchargée 669 fois
Description
Des minuteries il y en a...
Celle-ci ajoute l'emploi de plusieurs API adaptées pour VB.Net
Déplacement de la forme avec...
Arrondi des angles de la formes avec...
Peu servir surtout pour les API listées.
Celle-ci ajoute l'emploi de plusieurs API adaptées pour VB.Net
- Beep.Pour un son rudimentaire.
Déplacement de la forme avec...
- ReleaseCapture()
- SendMessage
Arrondi des angles de la formes avec...
- CreateRoundRectRgn
- SetWindowRgn
- DeleteObject
Source / Exemple :
Option Explicit On
Public Class FrmMinuterie
Private Declare Function Beep Lib "kernel32" ( _
ByVal dwFreq As Integer, _
ByVal dwDuration As Integer) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal X3 As Integer, ByVal Y3 As Integer) As Integer
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Integer) As Integer
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Integer, ByVal hRgn As Integer, ByVal bRedraw As Boolean) As Integer
Dim MaxTp(2) As Integer
Dim B As Boolean
Dim BB As Boolean
Dim T As Integer
Private Sub Sonore(Optional ByVal NB As Integer = 1)
Dim i As Int32, g As Byte
For g = 1 To NB
For i = 700 To 50 Step -30
Call Beep(i, 10)
Next i
Next g
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Applique()
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
MaxTp(2) = MaxTp(2) - 1
If MaxTp(2) < 0 Then
MaxTp(2) = 59
MaxTp(1) = MaxTp(1) - 1
End If
If MaxTp(1) < 0 Then
MaxTp(1) = 59
MaxTp(0) = MaxTp(0) - 1
End If
If MaxTp(0) < 0 Then
'Décompte terminer
Label1.Text = "00:00:00"
Timer1.Enabled = False
Button1.Text = "Démarrer"
B = False
Me.Refresh()
If CkSON.Checked Then Sonore(3)
If CheckBox1.Checked Then Me.Dispose()
Exit Sub
End If
Label1.Text = Format(MaxTp(0), "00") & ":" & Format(MaxTp(1), "00") & ":" & Format(MaxTp(2), "00")
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
RoundCorners()
Timer1.Interval = 1000
End Sub
Function InitTemp() As String
Dim R As String
Dim i
Dim AR() As Integer = {3600, 60, 1}
Dim TB() As String = Split(TxBOX.Text, ":")
Try
R = "" : T = 0
For i = 0 To 2
MaxTp(i) = Val(TB(i))
T = T + (Val(TB(i)) * AR(i))
R = R & CStr(Microsoft.VisualBasic.Strings.Right("00" & Trim(TB(i)), 2)) & IIf(i < 2, ":", "")
Next
Catch
Return "" : Exit Function
End Try
If T < 1 Then Return "" : Exit Function
Return R
End Function
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
If Not B Then Exit Sub
BB = Not BB
Button2.Text = IIf(BB, "Continuer", "Pause")
If BB Then Timer1.Enabled = False Else Timer1.Enabled = B
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If e.Button = MouseButtons.Left Then
Me.Cursor = Cursors.SizeAll
ReleaseCapture()
SendMessage(Me.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
Me.Cursor = Cursors.Default
End If
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Me.Dispose()
End Sub
Public Sub RoundCorners()
Dim lRet As Long
With Me
lRet = CreateRoundRectRgn(0, 0, .Width, .Height, 100, 190)
Call SetWindowRgn(Me.Handle, lRet, True)
Call DeleteObject(lRet)
End With
End Sub
Private Sub TxBOX_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TxBOX.KeyDown
If e.KeyCode = 13 Then
Applique()
End If
End Sub
Sub Applique()
Dim R As String = InitTemp()
If R = "" Or T < 5 Then
MsgBox("Vous devez initialiser le temps du décompte. (Minimum 5 secondes")
Exit Sub
Else
Label1.Text = R
End If
Sonore()
B = Not B : Timer1.Enabled = B
Button1.Text = IIf(B, "Arrêter", "Démarrer")
BB = False : Button2.Text = "Pause"
End Sub
End Class
Conclusion :
Peu servir surtout pour les API listées.
- Messages postés
-
492
- Date d'inscription
- jeudi 5 avril 2007
- Statut
- Membre
- Dernière intervention
- 2 juillet 2012
411 mars 2011 à 17:25
C'est l'un des buts de la démo.
Cordialement.
Lermite.
11 mars 2011 à 17:02
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.