question user control

Question

bjr
je voudrais me servir d'un user control (.ctl) sur plusieurs form d'un programme.
ce usercontrol est en fait un panneau de commandes ( boutons: premier,precedent,suivant,dernier, ajouter,modifier etc....)
 pour naviguer et manipuler des enregistrements d'une BD access avec plusieurs tables. 
une fois créé et placé sur la premiere form , je lui détermine la connectionstring et le recordset 
dans ses propriétes, tout roule ca marche en mode debug je peux naviguer , créer ....
lorsque je veux le mettre sur une deuxieme form pour aussi m'en servir,
ca me met une erreur '398' site client non disponible.....
pour les boutons je me sers d'un ocx "rey_xpbasics.ocx" pour leurs donner une allure "XP".
Donc ma question:
peut-on se servir d'un user controle sur différente form (je suppose que oui sinon je ne vois pas l'interet), et donc comment dois-je coder pour qu'il se libére a chaque appel de feuille.
j'ai essayé dans le form_load de lui indiquer : "ucontrol.connectionstring= provider etc...."
et donc laisser ses propriétes vides mais il me signale qu'il n'y a pas de connection lorsque je lance le test.
merci pour votre aide
patrik

Renfield · Answer

Tout dépend du code de ton UserControl...

le message "site client non disponible" indique que tu as essayé d'appeler par exemple :

Ambiant.UserMode alors que ta feuille n'était pas chargée...
évite de placer du code dans UserControl_Initialize, par exemple.

attend le ReadProperties

Renfield
Admin CodeS-SourceS- MVP Visual Basic

ecranbleu27 · Answer

bjr et merci......
voici le code du user control, je n'ai pas vu d'appel Ambiant.usermode ou autre.....
voir dans le code la ligne en rose qui poserait un pb de site client non disponible dans l'appel sur une deuxieme form.
en fait j'ai remplacé les cmdbutton qui était fait avec rey_xpbasic.ocx par des boutons classiques, à la premiere form tout se passe bien ,lorsque j'appelle la deuxieme form c'est là qu'il me dit site client non disponible (et bloque sur ligne rose)fenetre visual basic6 et en meme temps meme message mais fenetre rey_xpbasics. est-ce a en déduire que cet ocx n'est pas compatible avec ce genre d'user control ????

evidement le code n'est pas de moi.........

Option Explicit
'-- Default Property Values
Const m_def_connectionString = ""
Const m_def_recordSource = ""






'-- Property Variables. These will be read from the property bag

Dim m_ConnectionString As String
Dim m_recordSource As String
Dim m_form As Object        '-the form that hosts our control
Dim lTotalRecords As Long   '-holds the current number of records








'-- Keep our control a constant size --
Private Const m_def_Height = 95
Private Const m_def_Width = 518










'-Values for our navigation and editing buttons

Public Enum cmdButtons
  cmdMoveFirst = 0
  cmdMovePrevious = 1
  cmdMoveNext = 2
  cmdMoveLast = 3
  cmdaddnew = 4
  cmdEdit = 5
  cmdSave = 6
  cmdDelete = 7
  cmdUndo = 8
  cmdquitter = 9
End Enum








'-Values for our current edit status
Private Enum editMode
  nowStatic = 0
  nowEditing = 1
  nowadding = 2
End Enum







Dim editStatus As editMode










'Declare our object variables for the ADO connection
'and the recordset used in the control

Private adoConnection As ADODB.Connection
Private adoRecordset As ADODB.Recordset
Public Event validateRecord(ByVal operation As String, ByRef Cancel As Boolean)
Public Event quitrecord(ByVal operation As String, ByRef Cancel As Boolean)







Const m_def_Tag = "no tag"
Private m_Tag As String









Private Sub cmdButton_Click(Index As Integer)
Static vMyBookmark As Variant
Dim bCancel As Boolean







'-- sanity check here --
If adoRecordset Is Nothing Then Exit Sub
lbltot = adoRecordset.RecordCount
Select Case Index
 Case cmdMoveFirst      '--- move first ---
    adoRecordset.MoveFirst
    editStatus = nowStatic
    Call updateButtons
    lblControl = "Enregistrement " & adoRecordset.AbsolutePosition & _
    " sur " & lTotalRecords
 Case cmdMovePrevious  '--- move previous ---
    adoRecordset.MovePrevious
    editStatus = nowStatic
    Call updateButtons
    lblControl = "Enregistrement " & adoRecordset.AbsolutePosition & _
    " sur " & lTotalRecords







 Case cmdMoveNext      '--- move next ---
    adoRecordset.MoveNext
    editStatus = nowStatic
    Call updateButtons
    lblControl = "Enregistrement " & adoRecordset.AbsolutePosition & _
    " sur " & lTotalRecords







 Case cmdMoveLast      '-- move last ---
    adoRecordset.MoveLast
    editStatus = nowStatic
    Call updateButtons
    lblControl = "Enregistrement " & adoRecordset.AbsolutePosition & _
    " sur " & lTotalRecords







 '-- Now we are modifying the database --
 Case cmdaddnew       '-- add a new record
    RaiseEvent validateRecord("Add", bCancel)
    If (bCancel = True) Then Exit Sub







    editStatus = nowadding
    With adoRecordset
      If (.RecordCount > 0) Then        If (.BOF False) And (.EOF False) Then
          vMyBookmark = .Bookmark
        Else
          vMyBookmark = ""
         End If
      Else
          vMyBookmark = ""
      End If
      .AddNew
      lblControl = "Ajoute un nouvel Enregistrement"
      Call updateButtons
    End With







 Case cmdEdit '-- edit the current record
    RaiseEvent validateRecord("Edit", bCancel)
    If (bCancel = True) Then Exit Sub
     editStatus = nowEditing
     With adoRecordset
        vMyBookmark = adoRecordset.Bookmark
       'We just change the value with ado
        lblControl = "Modifie l'Enregistrement"
        Call updateButtons
    End With







 Case cmdSave '-- save the current record
     Dim bMoveLast As Boolean
     RaiseEvent validateRecord("Save", bCancel)
     If (bCancel = True) Then Exit Sub
     
     With adoRecordset
         If .editMode = adEditAdd Then            If (.BOF False) And (.EOF False) Then
                bMoveLast = True
                End If
         Else
             bMoveLast = False
         End If
         '.Move 0
         .UpdateBatch adAffectAll
         editStatus = nowStatic
         If (bMoveLast = True) Then
            .MoveLast
         Else
            .Move 0
         End If
         editStatus = nowStatic
         lTotalRecords = adoRecordset.RecordCount
         updateButtons True
         lbltot = lTotalRecords
         lblControl = "L'enregistrement a bien été sauvegardé."
     End With '







 Case cmdDelete  '-- delete the current record
    Dim iResponse As Integer
    Dim sAskUser As String
    
    RaiseEvent validateRecord("Delete", bCancel)
    If (bCancel = True) Then Exit Sub
    
    sAskUser = "Are you sure you want to delete this record?"
    iResponse = MsgBox(sAskUser, vbQuestion + vbYesNo _
       + vbDefaultButton2, Ambient.DisplayName)
    If (iResponse = vbYes) Then
      With adoRecordset
          .Delete
          If (adoRecordset.RecordCount > 0) Then
            If .BOF Then
              .MoveFirst
           Else
             .MovePrevious
          End If
          lTotalRecords = adoRecordset.RecordCount
          lblControl = "L'enregistrement a bien été effacé."
        End If
      End With
   End If
   editStatus = nowStatic
   Call updateButtons '
   
 Case cmdUndo '-- undo changes to the current record
    RaiseEvent validateRecord("Undo", bCancel)
    If (bCancel = True) Then Exit Sub
    
    With adoRecordset
        
       If editStatus = nowEditing Then
           .Move 0
           .Bookmark = vMyBookmark
        End If
        .CancelUpdate
        If editStatus = nowEditing Then
           .Move 0
        Else
          If Len(vMyBookmark) Then
            .Bookmark = vMyBookmark
          Else
            If .RecordCount > 0 Then
              .MoveFirst
            End If
          End If
        End If
        lblControl = "annulé!!"
     End With
     editStatus = nowStatic
     updateButtons True







Case cmdquitter
     RaiseEvent validateRecord("quitter", bCancel)
    If (bCancel = True) Then Exit Sub
   UserControl_Terminate
 
End Select







End Sub










 







Private Sub UserControl_GetDataMember(DataMember As String, Data As Object)
Dim iReturn As Integer







On Error GoTo ohno








'-Reasonability test --

If (adoRecordset Is Nothing) Or (adoConnection Is Nothing) Then
  If Trim$(m_ConnectionString) = "" Then
    iReturn = MsgBox("There is no connection string!", _
    vbCritical, Ambient.DisplayName)
    Exit Sub
  End If







  If Trim$(m_recordSource) = "" Then
    iReturn = MsgBox("There is no recordsource!", vbCritical, _
                                  Ambient.DisplayName)
    Exit Sub
  End If
  
Set adoConnection = New ADODB.Connection
adoConnection.Open m_ConnectionString
  
Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorLocation = adUseClient
adoRecordset.CursorType = adOpenDynamic
adoRecordset.LockType = adLockBatchOptimistic







adoRecordset.Open m_recordSource, adoConnection, , , adCmdTable
  
lTotalRecords = adoRecordset.RecordCount
 If lTotalRecords = 0 Then Call cmdButton_Click(cmdaddnew)
 End If
 
 If lTotalRecords > 0 Then
    adoRecordset.MoveFirst
    Call cmdButton_Click(cmdMoveFirst)
    lbltot = adoRecordset.RecordCount
 End If
 
Set Data = adoRecordset
Exit Sub







ohno:
MsgBox Err.Description
Exit Sub
  







End Sub







Private Sub updateButtons(Optional bLockem As Variant)







'-------------------------------------
'Position   Button
'   0       move first
'   1       move previous
'   2       move next
'   3       move last
'   4       add a new record
'   5       edit the current record
'   6       save the current record
'   7       delete the current record
'   8       undo any current changes
'--------------------------------------
'








'Either we are Editing / Adding or we are notIf (editStatus nowEditing) Or (editStatus nowadding) Then
   Call lockTheControls(False)
   navigateButtons ("000000101")
Else
   If (adoRecordset.RecordCount >= 2) Then
      If (adoRecordset.BOF) Or _
         (adoRecordset.AbsolutePosition = 1) Then
           navigateButtons ("001111010")
       ElseIf (adoRecordset.EOF) Or _
          (adoRecordset.AbsolutePosition = lTotalRecords) Then
             navigateButtons ("110011010")
       Else
             navigateButtons ("111111010")
       End If
   ElseIf (adoRecordset.RecordCount = 1) Then
       navigateButtons ("000011010")
   Else
       navigateButtons ("000010000")
   End If
     
   If (Not IsMissing(bLockem)) Then
      lockTheControls (bLockem)
   End If
        
End If







End Sub







Private Sub navigateButtons(buttonString As String)







''--------------------------------------------------
''-- This routine handles setting the enabled --
''-- to true / false on the buttons.                --
''-------------------------------------------------
''-- A string of 0101 passed. If 0, disabled   --
''-------------------------------------------------







Dim indx As Integer







buttonString = Trim$(buttonString)







For indx = 1 To Len(buttonString)
  If (Mid$(buttonString, indx, 1) = "1") Then
    cmdButton(indx - 1).Enabled = True
  Else
    cmdButton(indx - 1).Enabled = False
  End If
Next







DoEvents







End Sub







Private Sub lockTheControls(bLocked As Boolean)







On Error Resume Next







Dim iindx As Integer







With m_form







For iindx = 0 To .Controls.Count - 1
'If (.Controls(iindx).DataSource = Ambient.DisplayName) Then
'If (.Controls(iindx).Tag = Me.Tag) Then
If (TypeOf .Controls(iindx) Is TextBox) Then
If (bLocked) Then
.Controls(iindx).Locked = True
.Controls(iindx).BackColor = vbWhite
Else
.Controls(iindx).Locked = False
.Controls(iindx).BackColor = vbYellow
End If
End If
'End If
Next
End With










 





End Sub









Private Sub UserControl_Initialize()
   editStatus = nowStatic
End Sub







Private Sub UserControl_InitProperties()
   m_recordSource = m_def_recordSource
   m_ConnectionString = m_def_connectionString







End Sub







Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_recordSource = PropBag.ReadProperty("RecordSource", _
m_def_recordSource)
m_ConnectionString = PropBag.ReadProperty _
("ConnectionString", m_def_connectionString)
m_Tag = PropBag.ReadProperty("Tag", m_def_Tag)







End Sub







Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("RecordSource", _
m_recordSource, m_def_recordSource)
Call PropBag.WriteProperty("ConnectionString", _
m_ConnectionString, m_def_connectionString)
Call PropBag.WriteProperty("Tag", m_Tag, m_def_Tag)







End Sub









Private Sub UserControl_Resize()
   Width = UserControl.ScaleX(m_def_Width, vbPixels, vbTwips)
   Height = UserControl.ScaleX(m_def_Height, vbPixels, vbTwips)
   Set m_form = UserControl.Parent  ----->VISIBLEMENT C'EST A CAUSE DE CETTE LIGNE QU'IL ME DIT CLIENT INDISPONIBLE.....







End Sub







Private Sub UserControl_Terminate()
On Error Resume Next
If Not adoRecordset Is Nothing Then
  Set adoRecordset = Nothing
End If







If Not adoConnection Is Nothing Then
  Set adoConnection = Nothing
End If
Set m_form = UserControl.Parent
Err.Clear







End Sub










 





Public Property Get RecordSource() As String
   RecordSource = m_recordSource
End Property







Public Property Let RecordSource(ByVal New_RecordSource As String)
    m_recordSource = New_RecordSource
    PropertyChanged "RecordSource"
End Property







Public Property Get ConnectionString() As String
   ConnectionString = m_ConnectionString
End Property







Public Property Let ConnectionString(ByVal New_ConnectionString As String)
   m_ConnectionString = New_ConnectionString
   PropertyChanged "ConnectionString"
End Property









Public Property Get Tag() As String
Tag = m_Tag
End Property







Public Property Let Tag(ByVal vNewValue As String)
m_Tag = vNewValue
PropertyChanged "Tag"
End Property

ecranbleu27 · Answer

rectif: 
la fenetre erreur site client non disponible de visual basic s'ouvre dés la premiere form....

ecranbleu27 · Answer

bon j'ai déplacé : Set m_form = UserControl.Parent 
dePrivate Sub UserControl_Resize() 
à   Private Sub UserControl_GetDataMember
et à priori la fenetre VB6 me precisant que le site client était non disponible ne s'ouvre plus,
mais j'ai tjrs celle de rey_xpbasics qui s'ouvre a l'appel d'une deuxiéme form.
autre question, un recordset est ouvert grace a mon user control, comment puis-je m'en servir dans mes FORM ;;....
merci
patrik

ecranbleu27 · Answer

bjr
j'ai finalement réussi à "résoudre" mon pb de site client non disponible,
j'ai gardé mes boutons style XP , 
et je me suis servi de MDI FORM,
j'ai l'impression que l'ocx "rey_xpbasics.ocx" n'a rien vu et n' a pas perturbé l'usercontrol, vu que tout se passe à l'intérieur des forms parent/enfant
mais je laisse l'analyse à des gens beaucoup plus calé que moi...........et ca m'interrésse...
pour me servir de l'ado ouvert dans l'usercontrol sur mes forms, je pense aussi avoir trouvé......

Question user control

5 réponses

Votre réponse

Discussions similaires