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
  • 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.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_lermite222
Messages postés
492
Date d'inscription
jeudi 5 avril 2007
Statut
Membre
Dernière intervention
2 juillet 2012
4
11 mars 2011 à 17:25
Salut Mig,
C'est l'un des buts de la démo.
Cordialement.
Lermite.
mig211
Messages postés
5
Date d'inscription
mardi 26 décembre 2006
Statut
Membre
Dernière intervention
11 mars 2011

11 mars 2011 à 17:02
merci c'est très intéressant, et pour moi particulièrement cette sub : Sub RoundCorners()

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.