Soyez le premier à donner votre avis sur cette source.
Vue 3 385 fois - Téléchargée 360 fois
'///////////////////////////////////// 'Dans un controle nommé UpDown '///////////////////////////////////// Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Dim ButtonUpState As Byte Dim ButtonDownState As Byte Dim pressed As Byte Dim M_Value As Long Dim Clicked As Boolean Dim M_Largeur As Integer Dim M_Min As Long Dim M_Max As Long Public Event Change(NewValue) '0 normal 1 enfoncé Private Sub Augmente() If M_Value < M_Max Then M_Value = M_Value + 1 RaiseEvent Change(M_Value) redraw End Sub Private Sub Diminu() If M_Value > M_Min Then M_Value = M_Value - 1 RaiseEvent Change(M_Value) redraw End Sub Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyUp Then Augmente If KeyCode = vbKeyDown Then Diminu End Sub Private Sub Text1_LostFocus() Text1 = Int(Val(Text1)) M_Value = Int(Val(Text1)) If Int(Val(Text1)) > M_Max Then M_Value = M_Max If Int(Val(Text1)) < M_Min Then M_Value = M_Min RaiseEvent Change(M_Value) redraw End Sub Private Sub Timer1_Timer() 'acceleration progression de la vitesse de in/de crementation If Timer1.Interval <= 50 And Timer1.Interval > 1 Then Timer1.Interval = Timer1.Interval - 1 If Timer1.Interval = 100 Then Timer1.Interval = 50 If Timer1.Interval = 200 Then Timer1.Interval = 100 If Timer1.Interval = 300 Then Timer1.Interval = 200 If Timer1.Interval = 350 Then Timer1.Interval = 300 If Clicked Then If pressed = 0 Then Augmente Else Diminu End If redraw If Abs(GetKeyState(1)) < 2 Then UserControl_MouseUp 1, 0, 0, 0 End Sub Private Sub UserControl_DblClick() Clicked = True If pressed = 0 Then ButtonUpState = 1 Augmente Timer1.Interval = 350 End If If pressed = 1 Then ButtonDownState = 1 Diminu Timer1.Interval = 350 End If End Sub Private Sub UserControl_InitProperties() M_Largeur = 250 redraw End Sub Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Clicked = True If Y < UserControl.Height / 2 Then ButtonUpState = 1 Augmente pressed = 0 Timer1.Interval = 350 End If If Y > UserControl.Height / 2 Then ButtonDownState = 1 Diminu pressed = 1 Timer1.Interval = 350 End If redraw End Sub Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Changed = 0 If Button = 1 Then If X > UserControl.Width Or X < UserControl.Width - M_Largeur Then If ButtonUpState <> 0 Or ButtonDownState <> 0 Then Changed = 1 ButtonUpState = 0 ButtonDownState = 0 Else If Y < UserControl.Height / 2 And pressed = 0 Then If ButtonUpState <> 1 Then Changed = 1 ButtonUpState = 1 If Timer1.Interval > 0 Then Timer1_Timer End If If Y > UserControl.Height / 2 And pressed = 1 Then If ButtonDownState <> 1 Then Changed = 1 ButtonDownState = 1 If Timer1.Interval > 0 Then Timer1_Timer End If End If If Changed <> 0 Then redraw End If End Sub Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Clicked = False Timer1.Interval = 0 ButtonUpState = 0 ButtonDownState = 0 redraw End Sub Private Sub UserControl_Paint() redraw End Sub Private Sub UserControl_ReadProperties(PropBag As PropertyBag) M_Largeur = PropBag.ReadProperty("LargeurBoutons", 250) M_Value = PropBag.ReadProperty("Value", 5) M_Max = PropBag.ReadProperty("Max", 10) M_Min = PropBag.ReadProperty("Min", 0) redraw End Sub Private Sub UserControl_Resize() redraw End Sub Public Sub Refresh() redraw End Sub Private Sub redraw() On Local Error Resume Next Cls Text1.Width = UserControl.Width - M_Largeur - 30 Text1.Height = UserControl.Height If Text1.Height <> UserControl.Height Then UserControl.Height = Text1.Height 'pour aller plus vite w = UserControl.Width - 15 h = UserControl.Height - 15 m = Int((UserControl.Height - 15) / 2) 'm=milieu c = vbButtonFace 'c=clair s = vbButtonShadow 's=sombre If ButtonUpState = 0 Then Line (w - M_Largeur, 0)-(w - M_Largeur, m), 16777215 Line (w - M_Largeur - 15, 0)-(w - M_Largeur - 15, m), c Line (w - M_Largeur, 0)-(w, 0), 16777215 Line (w - M_Largeur + 15, 15)-(w, 15), c Line (w - M_Largeur, m)-(w, m), 0 Line (w - M_Largeur, m - 15)-(w, m - 15), s Line (w, 0)-(w, m), 0 Line (w - 15, 0)-(w - 15, m), s DessineTriangle Int(w - (M_Largeur / 2)) - 15, Int(m / 2) + 15, 1 Else Line (w - M_Largeur, 0)-(w - M_Largeur, m), 0 Line (w - M_Largeur - 15, 0)-(w - M_Largeur - 15, m), s Line (w - M_Largeur - 30, 0)-(w, 0), 0 Line (w - M_Largeur - 30, 15)-(w, 15), s Line (w - M_Largeur - 15, m)-(w, m), 16777215 Line (w - M_Largeur - 15, m - 15)-(w, m - 15), c Line (w, 0)-(w, m), 16777215 Line (w - 15, 0)-(w - 15, m), c DessineTriangle Int(w - (M_Largeur / 2)), Int(m / 2) + 30, 1 End If If ButtonDownState = 0 Then Line (w - M_Largeur, m)-(w - M_Largeur, h), 16777215 Line (w - M_Largeur - 15, m)-(w - M_Largeur - 15, h), c Line (w - M_Largeur, m)-(w, m), 16777215 Line (w - M_Largeur + 15, m + 15)-(w, m + 15), c Line (w - M_Largeur, h)-(w, h), 0 Line (w - M_Largeur, h - 15)-(w, h - 15), s Line (w, m)-(w, h + 15), 0 Line (w - 15, m)-(w - 15, h), s DessineTriangle Int(w - (M_Largeur / 2)) - 15, Int(m / 2) + m - 45, 0 Else Line (w - M_Largeur, m)-(w - M_Largeur, h), 0 Line (w - M_Largeur - 15, m)-(w - M_Largeur - 15, h), s Line (w - M_Largeur - 30, m)-(w, m), 0 Line (w - M_Largeur - 30, m + 15)-(w, m + 15), s Line (w - M_Largeur - 15, h)-(w, h), 16777215 Line (w - M_Largeur - 15, h - 15)-(w, h - 15), c Line (w, m)-(w, h + 15), 16777215 Line (w - 15, m)-(w - 15, h), c DessineTriangle Int(w - (M_Largeur / 2)), Int(m / 2) + m - 30, 0 End If Text1 = M_Value End Sub Private Sub DessineTriangle(X, Y, Orientation) 'orientation (1= haut 2 bas) If Orientation = 1 Then PSet (X, Y - 15) PSet (X, Y - 30) PSet (X - 15, Y - 15) PSet (X - 30, Y - 15) PSet (X + 15, Y - 15) PSet (X + 30, Y - 15) PSet (X - 15, Y - 30) PSet (X + 15, Y - 30) PSet (X, Y - 45) Else PSet (X, Y + 15) PSet (X, Y + 30) PSet (X - 15, Y + 15) PSet (X - 30, Y + 15) PSet (X + 15, Y + 15) PSet (X + 30, Y + 15) PSet (X - 15, Y + 30) PSet (X + 15, Y + 30) PSet (X, Y + 45) End If End Sub Private Sub UserControl_WriteProperties(PropBag As PropertyBag) PropBag.WriteProperty "LargeurBoutons", M_Largeur, 250 PropBag.WriteProperty "Value", M_Value, 5 PropBag.WriteProperty "Max", M_Max, 10 PropBag.WriteProperty "Min", M_Min, 0 End Sub Public Property Get LargeurBoutons() As Integer LargeurBoutons = M_Largeur End Property Public Property Let LargeurBoutons(ByVal vNewValue As Integer) M_Largeur = vNewValue PropertyChanged "LargeurBoutons" redraw End Property Public Property Get Min() As Long Min = M_Min End Property Public Property Let Min(ByVal vNewValue As Long) M_Min = vNewValue PropertyChanged "Min" redraw End Property Public Property Get Max() As Long Max = M_Max End Property Public Property Let Max(ByVal vNewValue As Long) M_Max = vNewValue PropertyChanged "Max" redraw End Property Public Property Get Value() As Long Value = M_Value End Property Public Property Let Value(ByVal vNewValue As Long) M_Value = Value PropertyChanged "Value" redraw End Property '///////////////////////////////////// 'Dans une form '///////////////////////////////////// Private Sub UpDown1_Change(NewValue As Variant) me.caption = UpDown1.Value 'ou me.caption = NewValue End Sub
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.