Chkdataconnector
Description
Voila le ChKDataConnector aprés Retouche + Projet de Test
Merci de bien testé et utilisé se composant;
et bonne programmation;
le composant fonction bien mais pas encore finis...
Merci de bien testé et utilisé se composant;
et bonne programmation;
Source / Exemple :
Dim v As Integer, vbln As Boolean
Public vRecordSet As Recordset
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call InvColor(v, &HC0C0C0, &H80000008)
End Sub
Private Sub Lbl_Click(Index As Integer)
Call RsFunc(Index)
End Sub
Private Sub Lbl_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call InvColor(v, &HC0C0C0, &H80000008)
Call InvColor(Index, &HFF8080, &HFFFFFF)
End Sub
Public Function InvColor(vIndex, vBackColor, vForeColor)
Lbl(vIndex).BackColor = vBackColor
Lbl(vIndex).ForeColor = vForeColor
v = vIndex
End Function
Private Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call InvColor(v, &HC0C0C0, &H80000008)
End Sub
Private Sub Frame3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call InvColor(v, &HC0C0C0, &H80000008)
End Sub
Public Function RsFunc(vBtn)
On Error GoTo err_:
If Not vbln Then GoTo Return_v:
Select Case vBtn
Case Is = 0
vRecordSet.MoveFirst
Case Is = 1
If vRecordSet.AbsolutePosition > 1 Then
vRecordSet.MovePrevious
End If
Case Is = 2
If vRecordSet.AbsolutePosition < vRecordSet.RecordCount Then
vRecordSet.MoveNext
End If
Case Is = 3
vRecordSet.MoveLast
End Select
Return_v:
Select Case vBtn
Case Is = 4
If Lbl(4).Caption = "Nouveau" Then
vRecordSet.AddNew
Lbl(4).Caption = "Annuler"
Fnc_Acv (True)
ElseIf Lbl(4).Caption = "Annuler" Then
vRecordSet.CancelUpdate
Lbl(4).Caption = "Nouveau"
Fnc_Acv (False)
End If
Case Is = 5
vRecordSet.Update
Lbl(4).Caption = "Nouveau"
Fnc_Acv (False)
Case Is = 6
If vRecordSet.AbsolutePosition = 1 Then
vRecordSet.Delete
vRecordSet.MoveNext
ElseIf vRecordSet.AbsolutePosition <= vRecordSet.RecordCount Then
vRecordSet.Delete
vRecordSet.MoveFirst
End If
End Select
err_:
'Err.Clear
'vbln = False
End Function
Private Sub UserControl_Initialize()
vbln = True
UserControl.Height = 1485
UserControl.Width = 4740
End Sub
Private Function Fnc_Acv(vbln)
If vbln Then
Lbl(0).BackColor = &H808080
Lbl(0).ForeColor = &H808080
Lbl(1).BackColor = &H808080
Lbl(1).ForeColor = &H808080
Lbl(2).BackColor = &H808080
Lbl(2).ForeColor = &H808080
Lbl(3).BackColor = &H808080
Lbl(3).ForeColor = &H808080
Lbl(6).BackColor = &H808080
Lbl(6).ForeColor = &H808080
Lbl(0).Enabled = False
Lbl(1).Enabled = False
Lbl(2).Enabled = False
Lbl(3).Enabled = False
Lbl(6).Enabled = False
vbln = False
Exit Function
End If
vbln = True
Lbl(0).BackColor = &HC0C0C0
Lbl(0).ForeColor = &H80000008
Lbl(1).BackColor = &HC0C0C0
Lbl(1).ForeColor = &H80000008
Lbl(2).BackColor = &HC0C0C0
Lbl(2).ForeColor = &H80000008
Lbl(3).BackColor = &HC0C0C0
Lbl(3).ForeColor = &H80000008
Lbl(6).BackColor = &HC0C0C0
Lbl(6).ForeColor = &H80000008
Lbl(0).Enabled = True
Lbl(1).Enabled = True
Lbl(2).Enabled = True
Lbl(3).Enabled = True
Lbl(6).Enabled = True
End Function
Conclusion :
le composant fonction bien mais pas encore finis...
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.