Problème d'instance et propriété avec ocx

Résolu
28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014 - 7 juil. 2012 à 18:19
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 - 8 juil. 2012 à 11:27
Bonjour à tous,

Je suis en train de terminer la fabrication d'un ocx.

J'ai un soucis quand je place deux instances de cet ocx sur une feuille, le premier ocx prend les propriétés du deuxième.

Je n'arrivez pas a séparer les deux propriétés des deux instances.

Je ne comprends pas bien pourquoi.

Avez-vous des idées ???

Par avance merci.

28marc28

13 réponses

28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014
7 juil. 2012 à 20:09
Merci de ton aide c'était parfais, je suis dans la mouise avec un gros souci qui me bloque et je dois finir cet ocx pour enfin pouvoir avancer dans mon programme, car j'ai des délais à tenir, bref c'est mon affaire…

Je n'ai pas vraiment l'habitude de ce forum et encore moins de son éditeur qui me modifie la forme du code, après l'avoir validé, alors que sur VB il est impeccable.

Habituellement je me débrouille tout seul, d'ailleurs cela fait plus de 15 ans que je me débrouille seul.

Encore merci j'ai bien apprécié ton humilité sur "le code mal maitrisé". Personnellement je ne me suis jamais permis un tel jugement sur la façon de programmer de quelqu'un.

En effet, ayant eu à faire à plusieurs écoles de programmation et de programmeurs, j'ai fini par devenir pragmatique dans le domaine.
Et surtout merci pour ta patience. J'ai vraiment adoré, non vraiment c'est sincère !

Espérant que ta pêche sera fructueuse et que tu pécheras du poisson à ton niveau d'excellence.

Précision utile: ma réponse n'appelle pas de réponse de ta part.

Bonne soirée tout de même.

28marc28
3
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
7 juil. 2012 à 18:22
Bonjour,
Comment le savoir sans voir le code des propriétés gérées ?


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014
7 juil. 2012 à 18:30
En fait, et visiblement ça à l'air d'être la totalité des propriétés.

Ce qui est curieux, c'est que j'ai aussi une page perso de propriétés dans le projet ça fait la même chose quand je passe d'un objet à un autre.

En revanche, sur les propriété(obtenu avec F4), ça change bien tout seul ...

Je ne comprends plus rien
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
7 juil. 2012 à 18:34
Et où est donc (bis repetita) le code gérant les propriétés ?
Sans le voir : rien n'est possible !
Quand je parle de code : c'est celui de ton ocx, hein ...


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014
7 juil. 2012 à 18:38
bha moi je veux bien mais il y a du monde ...

le voici:

Dim ColoneTitre As Boolean
Public Event Click()
Public Event DblClick()
Public Event RowColChange()
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event FindCol(ByVal Ligne As Integer)
Public Event FindRec(ByVal Ligne As String)
Public Event ChampRec(ByVal Ligne As String)
Dim FlagAffiche As Boolean
Dim Flag As Boolean

Public Sub AffectFont()
Dim ObjCtl As Object

For Each ObjCtl In Controls
If TypeOf ObjCtl Is SSPanel Then
Set ObjCtl.Font = UserControl.Font
End If
Next
Call RedimenssioneGrille
End Sub

Public Sub AffectFontTitre()
Dim ObjCtl As Object

For Each ObjCtl In Controls
If TypeOf ObjCtl Is MSHFlexGrid Then
Set ObjCtl.FontFixed = UserControl.Font
End If
Next
Call RedimenssioneGrille
End Sub

Private Sub MSHFlexGrid1_Click()
On Error Resume Next

RaiseEvent Click
End Sub

Private Sub MSHFlexGrid1_DblClick()
On Error Resume Next

RaiseEvent DblClick
End Sub

Private Sub MSHFlexGrid1_GotFocus()
On Error Resume Next

SSPanel1.Refresh
MSHFlexGrid1.Refresh
UserControl.Refresh
Call SurligneLigne
End Sub

Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next

RaiseEvent KeyDown(KeyCode, Shift)
'If KeyCode 38 Then MSHFlexGrid1.TopRow MSHFlexGrid1.Row
MSHFlexGrid1.TopRow = MSHFlexGrid1.Row
'If KeyCode 40 Then MSHFlexGrid1.RowIsVisible True

Call SurligneLigne
End Sub

Private Sub MSHFlexGrid1_KeyPress(KeyAscii As Integer)
On Error Resume Next

RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub MSHFlexGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next

RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub MSHFlexGrid1_LostFocus()
On Error Resume Next

MSHFlexGrid1.Col = 0
MSHFlexGrid1.ColSel = MSHFlexGrid1.Cols - 1
SSPanel1.Refresh
MSHFlexGrid1.Refresh
UserControl.Refresh
Call SurligneLigne
End Sub

Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next

RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub MSHFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next

RaiseEvent MouseMove(Button, Shift, X, Y)
If Button 1 Or Button 2 Then
MSHFlexGrid1.Col = 0
MSHFlexGrid1.ColSel = MSHFlexGrid1.Cols - 1
End If
End Sub

Private Sub MSHFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next

RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub MSHFlexGrid1_RowColChange()
On Error Resume Next

Col = MSHFlexGrid1.Col
Row = MSHFlexGrid1.Row
Text = MSHFlexGrid1.Text
RaiseEvent RowColChange
SSPanel1.Refresh
MSHFlexGrid1.Refresh
UserControl.Refresh
Call SelectionneLigne
Call SurligneLigne
End Sub

Private Sub MSHFlexGrid1_SelChange()
On Error Resume Next

MSFlexGrid1.RowSel = MSFlexGrid1.Row
If FlagAffiche = False Then
FlagAffiche = True
Else
FlagAffiche = False
End If
SSPanel1.Refresh
MSHFlexGrid1.Refresh
UserControl.Refresh
End Sub

Private Sub UserControl_EnterFocus()
On Error Resume Next

Call SurligneLigne
End Sub

Private Sub UserControl_Refresh()
On Error Resume Next


MSHFlexGrid1.Refresh
End Sub

Private Sub UserControl_ExitFocus()
On Error Resume Next

Call SurligneLigne
End Sub

Private Sub UserControl_GotFocus()
On Error Resume Next

Call SurligneLigne
End Sub

Private Sub UserControl_Initialize()
On Error Resume Next

Enabled = False
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label5.Caption = ""
Label6.Caption = ""
Label8.Caption = ""
Label9.Caption = ""
Label10.Caption = ""
Label11.Caption = ""
TempLigne = ""
TempChamp = ""
TempChampBis = ""
TempTaille = ""
TempPos = ""
TempChemin = ""
TempCheminBis = ""
TempTable = ""
TempTableBis = ""
TempCol = 1
TempNumIndex = ""
TempRelais = ""
TempNumIndexR = ""
Call RedimenssioneGrille
MSHFlexGrid1.Rows = 0
SSPanel1.Refresh
MSHFlexGrid1.Refresh
UserControl.Refresh
End Sub

Private Sub UserControl_LostFocus()
On Error Resume Next

Call SurligneLigne
End Sub

Private Sub UserControl_Resize()
On Error Resume Next

Call RedimenssioneGrille
End Sub

Private Sub UserControl_InitProperties()
On Error Resume Next

Caption = SSPanel1.Caption
Call RedimenssioneGrille
End Sub

Public Property Get Caption() As String
On Error Resume Next

Caption = SSPanel1.Caption
End Property

Public Property Let Caption(ByVal NewCaption As String)
On Error Resume Next

If NewCaption = "" Then
SSPanel1.Height = 0
SSPanel1.Visible = False
Else
SSPanel1.Visible = True
End If
SSPanel1.Caption = NewCaption
PropertyChanged "Caption"
Call RedimenssioneGrille
End Property

Public Property Get Rows() As Double
On Error Resume Next

Rows = MSHFlexGrid1.Rows
End Property

Public Property Let Rows(ByVal NewCaption As Double)
On Error Resume Next

MSHFlexGrid1.Rows = NewCaption
PropertyChanged "Rows"
End Property

Public Property Get Cols() As Double
On Error Resume Next

Cols = MSHFlexGrid1.Cols
End Property

Public Property Let Cols(ByVal NewCaption As Double)
On Error Resume Next

MSHFlexGrid1.Cols = NewCaption
TempCols = NewCaption
PropertyChanged "Cols"
End Property

Public Property Get ColSel() As Double
On Error Resume Next

ColSel = MSHFlexGrid1.ColSel
End Property

Public Property Let ColSel(ByVal NewCaption As Double)
On Error Resume Next

MSHFlexGrid1.ColSel = NewCaption
PropertyChanged "ColSel"
End Property

Public Property Get Value() As String
On Error Resume Next

'ColSel = MSHFlexGrid1.ColSel
End Property '

Public Property Let Value(ByVal NewCaption As String)
On Error Resume Next

TempValue = NewCaption
Call AfficheContenuGrille
TempValue = ""
NewCaption = ""
End Property


Public Property Get Row() As Double
On Error Resume Next

Row = MSHFlexGrid1.Row
End Property

Public Property Let Row(ByVal NewCaption As Double)
On Error Resume Next

MSHFlexGrid1.Row = NewCaption
PropertyChanged "Row"
End Property

Public Property Get Col() As Double
On Error Resume Next

Col = MSHFlexGrid1.Col
End Property

Public Property Let Col(ByVal NewCaption As Double)
On Error Resume Next

MSHFlexGrid1.Col = NewCaption
PropertyChanged "Col"
End Property

Public Property Get Text() As String
On Error Resume Next

Text = MSHFlexGrid1.Text
End Property

Public Property Let Text(ByVal NewCaption As String)
On Error Resume Next

MSHFlexGrid1.Text = NewCaption
PropertyChanged "Text"
End Property

Public Property Get LigneTitre() As String
On Error Resume Next

LigneTitre = Label1.Caption
TempLigne = LigneTitre
End Property

Public Property Let LigneTitre(ByVal vNewValue As String)
Dim Compteur As Integer

On Error Resume Next

Label1.Caption = vNewValue
TempLigne = vNewValue
PropertyChanged "LigneTitre"
If FlagTempCol = True Then
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = TempCol
MSHFlexGrid1.Text = RechercheLigne(TempCol, Label1.Caption)
FlagTempCol = False
Else
Compteur = 1
While Compteur <> Cols + 1
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = Compteur - 1
MSHFlexGrid1.Text = RechercheLigne(Compteur, Label1.Caption)
Compteur = Compteur + 1
Wend
End If
End Property

Public Property Get LigneTaille() As String
On Error Resume Next

LigneTaille = Label3.Caption
TempTaille = LigneTaille
End Property

Public Property Let LigneTaille(ByVal vNewValue As String)
Dim Compteur As Integer
Dim NBCar As Integer
Dim Car As String
Dim StrTemp As String

On Error Resume Next

Label3.Caption = vNewValue
TempTaille = vNewValue
PropertyChanged "LigneTaille"
If FlagTempCol = True Then
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = TempCol
MSHFlexGrid1.ColWidth(TempCol) = RechercheLigne(TempCol, Label3.Caption)
FlagTempCol = False
Else
Compteur = 1
While Compteur <> Cols + 1
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = Compteur - 1
' Traite la taille de la cellule
MSHFlexGrid1.ColWidth(Compteur - 1) = RechercheLigne(Compteur, TempTaille)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = Compteur - 1
StrTemp = RechercheLigne(Compteur, TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
Compteur = Compteur + 1
Wend
End If
End Property

Public Property Get LignePos() As String
On Error Resume Next

LignePos = Label4.Caption
TempPos = LignePos
End Property

Public Property Let LignePos(ByVal vNewValue As String)
Dim StrTemp As String

On Error Resume Next

Label4.Caption = vNewValue
TempPos = vNewValue
PropertyChanged "LignePos"
If FlagTempCol = True Then
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = TempCol
StrTemp = RechercheLigne(TempCol, Label4.Caption)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
End If
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
End If
If StrTemp = "D" Then
MSHFlexGrid1.CellAlignment = 7
End If
FlagTempCol = False
Else
Compteur = 0
While Compteur <> TempCols
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = Compteur
StrTemp = RechercheLigne(Compteur, Label4.Caption)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
End If
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
End If
If StrTemp = "D" Then
MSHFlexGrid1.CellAlignment = 7
End If
Compteur = Compteur + 1
Wend
End If
End Property

Public Property Get LigneChamp() As String
On Error Resume Next

LigneChamp = Label2.Caption
TempChamp = LigneChamp
End Property

Public Property Let LigneChamp(ByVal vNewValue As String)
On Error Resume Next

Label2.Caption = vNewValue
TempChamp = vNewValue
PropertyChanged "LigneChamp"
End Property

Public Property Get LigneChampBis() As String
On Error Resume Next

LigneChampBis = Label16.Caption
TempChampBis = LigneChampBis
End Property

Public Property Let LigneChampBis(ByVal vNewValue As String)
On Error Resume Next

Label16.Caption = vNewValue
TempChampBis = vNewValue
PropertyChanged "LigneChampBis"
End Property

Public Property Get LigCExt() As String
On Error Resume Next

LigCExt = Label8.Caption
TempCExt = LigCExt
End Property

Public Property Let LigCExt(ByVal vNewValue As String)
On Error Resume Next

Label8.Caption = vNewValue
TempCExt = vNewValue
PropertyChanged "LigCExt"
End Property

Public Property Get LigCExtBis() As String
On Error Resume Next

LigCExtBis = Label17.Caption
TempCExtBis = LigCExtBis
End Property

Public Property Let LigCExtBis(ByVal vNewValue As String)
On Error Resume Next

Label17.Caption = vNewValue
TempCExtBis = vNewValue
PropertyChanged "LigCExtBis"
End Property

Public Property Get FontCaption() As Variant
On Error Resume Next

Set FontCaption = UserControl.Font
End Property

Public Property Set FontCaption(ByVal New_Font As Font)
On Error Resume Next

Set UserControl.Font = New_Font
Call AffectFont
PropertyChanged "FontCaption"
End Property

Public Property Get FontTitre() As Variant
On Error Resume Next

Set FontTitre = UserControl.Font
End Property

Public Property Set FontTitre(ByVal New_Font As Font)
On Error Resume Next

Set UserControl.Font = New_Font
Call AffectFontTitre
PropertyChanged "FontTitre"
End Property

Public Property Get BackColor() As OLE_COLOR
On Error Resume Next

BackColor = MSHFlexGrid1.BackColor
End Property

Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

MSHFlexGrid1.BackColor = vNewValue
PropertyChanged "BackColor"
End Property

Public Property Get BackColorBkg() As OLE_COLOR
On Error Resume Next

BackColorBkg = MSHFlexGrid1.BackColorBkg
End Property

Public Property Let BackColorBkg(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

MSHFlexGrid1.BackColorBkg = vNewValue
PropertyChanged "BackColorBkg"
End Property

Public Property Get BackColorCtrl() As OLE_COLOR
On Error Resume Next

BackColorCtrl = UserControl.BackColor
End Property

Public Property Let BackColorCtrl(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

UserControl.BackColor = vNewValue
PropertyChanged "BackColorCtrl"
End Property

Public Property Get BackColorTitre() As OLE_COLOR
On Error Resume Next

BackColorTitre = SSPanel1.BackColor
End Property

Public Property Let BackColorTitre(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

SSPanel1.BackColor = vNewValue
PropertyChanged "BackColorTitre"
End Property

Public Property Get ForeColor() As OLE_COLOR
On Error Resume Next

ForeColor = MSHFlexGrid1.ForeColor
End Property

Public Property Let ForeColor(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

MSHFlexGrid1.ForeColor = vNewValue
PropertyChanged "ForeColor"
End Property

Public Property Get ForeColorSel() As OLE_COLOR
On Error Resume Next

ForeColorSel = MSHFlexGrid1.ForeColorSel
End Property

Public Property Let ForeColorSel(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

MSHFlexGrid1.ForeColorSel = vNewValue
PropertyChanged "ForeColorSel"
End Property

Public Property Get ForeColorTitre() As OLE_COLOR
On Error Resume Next

ForeColorTitre = SSPanel1.ForeColor
End Property

Public Property Let ForeColorTitre(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

SSPanel1.ForeColor = vNewValue
PropertyChanged "ForeColorTitre"
End Property

Public Property Get BackColorSel() As OLE_COLOR
On Error Resume Next

BackColorSel = MSHFlexGrid1.BackColorSel
End Property

Public Property Let BackColorSel(ByVal vNewValue As OLE_COLOR)
On Error Resume Next

MSHFlexGrid1.BackColorSel = vNewValue
PropertyChanged "BackColorSel"
End Property

Public Property Get Enabled() As Boolean
On Error Resume Next

Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal vNewValue As Boolean)
On Error Resume Next

UserControl.Enabled = vNewValue
PropertyChanged "Enabled"
End Property

Public Property Get TitreColone() As Boolean
On Error Resume Next

TitreColone = ColoneTitre
End Property

Public Property Let TitreColone(ByVal vNewValue As Boolean)
On Error Resume Next

ColoneTitre = vNewValue
PropertyChanged "TitreColone"
If ColoneTitre = True Then
MSHFlexGrid1.Rows = 2
MSHFlexGrid1.FixedRows = 1
Else
MSHFlexGrid1.Rows = 1
MSHFlexGrid1.FixedRows = 0
End If
End Property

Private Sub UserControl_Terminate()
On Error Resume Next

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
On Error Resume Next

PropBag.WriteProperty "Caption", Caption, "SSBouton"
PropBag.WriteProperty "FontCaption", Font
PropBag.WriteProperty "FontTitre", Font
PropBag.WriteProperty "BackColor", BackColor, &HFFFFFF
PropBag.WriteProperty "BackColorBkg", BackColorBkg, &HFFFFFF
PropBag.WriteProperty "BackColorTitre", BackColorTitre, &HFFFFFF
PropBag.WriteProperty "ForeColor", ForeColor, &H80000008
PropBag.WriteProperty "ForeColorSel", ForeColorSel, &H80000008
PropBag.WriteProperty "ForeColorTitre", ForeColorTitre, &H80000008
PropBag.WriteProperty "BackColorSel", BackColorSel, &H80FF&
PropBag.WriteProperty "BackColorCtrl", BackColorCtrl, &H80FF&
PropBag.WriteProperty "Enabled", Enabled, True
PropBag.WriteProperty "TitreColone", TitreColone
PropBag.WriteProperty "LigneTitre", Label1.Caption
PropBag.WriteProperty "LigneTaille", Label3.Caption
PropBag.WriteProperty "LigneChamp", Label2.Caption
PropBag.WriteProperty "LigneChampBis", Label16.Caption
PropBag.WriteProperty "LignePos", Label4.Caption
PropBag.WriteProperty "LigCRec", Label5.Caption
PropBag.WriteProperty "LigCAff", Label6.Caption
PropBag.WriteProperty "LigCExt", Label8.Caption
PropBag.WriteProperty "LigCExtBis", Label17.Caption
PropBag.WriteProperty "Rows", Rows
PropBag.WriteProperty "Cols", Cols
PropBag.WriteProperty "ColSel", ColSel
PropBag.WriteProperty "Row", Row
PropBag.WriteProperty "Col", Col
PropBag.WriteProperty "Text", Text
PropBag.WriteProperty "CheminBase", CheminBase
PropBag.WriteProperty "NomBase", NomBase
PropBag.WriteProperty "NomTable", NomTable
PropBag.WriteProperty "Relais", Relais
PropBag.WriteProperty "TailleRecIdx", TailleRecIdx
PropBag.WriteProperty "TailleRecDat", DatTailleDat
PropBag.WriteProperty "CheminTable", CheminTable
PropBag.WriteProperty "CheminTableBis", CheminTableBis
PropBag.WriteProperty "NomTable", NomTable
PropBag.WriteProperty "NomTableBis", NomTableBis
PropBag.WriteProperty "NumIndex", NumIndex
PropBag.WriteProperty "NumIndexR", NumIndexR
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'On Error Resume Next


Rows = PropBag.ReadProperty("Rows", Rows)
Cols = PropBag.ReadProperty("Cols", Cols)
TempCols = Cols
LignePos = PropBag.ReadProperty("LignePos", "LignePos")
TempPos = LignePos
Label4.Caption = LignePos
Caption = PropBag.ReadProperty("Caption", "SSBouton")
Set FontCaption = PropBag.ReadProperty("FontCaption", UserControl.Font)
Set FontTitre = PropBag.ReadProperty("FontTitre", UserControl.Font)
BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
BackColorBkg = PropBag.ReadProperty("BackColorBkg", &HFFFFFF)
BackColorTitre = PropBag.ReadProperty("BackColorTitre", &HFFFFFF)
ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
ForeColorSel = PropBag.ReadProperty("ForeColorSel", &H80000008)
ForeColorTitre = PropBag.ReadProperty("ForeColorTitre", &H80000008)
BackColorSel = PropBag.ReadProperty("BackColorSel", &H80FF&)
BackColorCtrl = PropBag.ReadProperty("BackColorCtrl", &H80FF&)
Enabled = PropBag.ReadProperty("Enabled", True)
TitreColone = PropBag.ReadProperty("TitreColone", TitreColone)
LigneTitre = PropBag.ReadProperty("LigneTitre", "LigneTitre")
TempLigne = LigneTitre
Label1.Caption = LigneTitre

LigneChamp = PropBag.ReadProperty("LigneChamp", "LigneChamp")
TempChamp = LigneChamp
Label2.Caption = LigneChamp

LigneChampBis = PropBag.ReadProperty("LigneChampBis", "LigneChampBis")
TempChampBis = LigneChampBis
Label16.Caption = LigneChampBis


LigneTaille = PropBag.ReadProperty("LigneTaille", "LigneTaille")
TempTaille = LigneTaille
Label3.Caption = LigneTaille

Relais = PropBag.ReadProperty("Relais", "Relais")
TempRelais = Relais
Label13.Caption = Relais


LigCExt = PropBag.ReadProperty("LigCExt", "LigCExt")
TempCExt = LigCExt
Label8.Caption = LigCExt

LigCExtBis = PropBag.ReadProperty("LigCExtBis", "LigCExtBis")
TempCExtBis = LigCExtBis
Label17.Caption = LigCExtBis

'CheminTable = PropBag.ReadProperty("CheminTable", CheminTable)
CheminTable = PropBag.ReadProperty("CheminTable", "CheminTable")
TempChemin = CheminTable
Label9.Caption = CheminTable

'CheminTableBis = PropBag.ReadProperty("CheminTableBis", CheminTableBis)
CheminTableBis = PropBag.ReadProperty("CheminTableBis", "CheminTableBis")
TempCheminBis = CheminTableBis
Label14.Caption = CheminTableBis


'NomTable = PropBag.ReadProperty("NomTable", NomTable)
NomTable = PropBag.ReadProperty("NomTable", "NomTable")
TempTable = NomTable
Label10.Caption = NomTable

'NomTableBis = PropBag.ReadProperty("NomTableBis", NomTableBis)
NomTableBis = PropBag.ReadProperty("NomTableBis", "NomTableBis")
TempTableBis = NomTableBis
Label15.Caption = NomTableBis

ColSel = PropBag.ReadProperty("ColSel", ColSel)
Row = PropBag.ReadProperty("Row", Row)
Col = PropBag.ReadProperty("Col", Col)
Text = PropBag.ReadProperty("Text", Text)
CheminBase = PropBag.ReadProperty("CheminBase", CheminBase)
NomBase = PropBag.ReadProperty("Nombase", NomBase)
TailleRecIdx = PropBag.ReadProperty("TailleRecIdx", TailleRecIdx)
TailleRecDat = PropBag.ReadProperty("TailleRecDat", TailleRecDat)
NumIndex = PropBag.ReadProperty("NumIndex", NumIndex)
NumIndexR = PropBag.ReadProperty("NumIndexR", NumIndexR)
End Sub

Public Sub SelectionneLigne()
Dim Compteur As Double

On Error Resume Next

ReDim TabMem(MSHFlexGrid1.Cols) As String

Compteur = 0
While Compteur <> UBound(TabMem)
MSHFlexGrid1.Col = Compteur
TabMem(Compteur) = MSHFlexGrid1.Text
Compteur = Compteur + 1
Wend
Flag = True
End Sub

Public Function ReSelectionneLigne() As Double
Dim Compteur As Double
Dim Compteur1 As Double
Dim ValTemp As Double
Dim FlagA As Boolean

On Error Resume Next

MSHFlexGrid1.HighLight = 0
FlagA = False
Compteur1 = 1
While Compteur1 <> MSHFlexGrid1.Rows
MSHFlexGrid1.Row = Compteur1
Compteur = 0
FlagA = False
While Compteur <> UBound(TabMem)
MSHFlexGrid1.Col = Compteur
If TabMem(Compteur) = MSHFlexGrid1.Text Then
Else
FlagA = True
End If
Compteur = Compteur + 1
Wend
If FlagA False Then ValTemp MSHFlexGrid1.Row
Compteur1 = Compteur1 + 1
Wend
MSHFlexGrid1.HighLight = 1
ReSelectionneLigne = ValTemp
Call SurligneLigne
End Function

Public Sub Refresh()
On Error Resume Next

MSHFlexGrid1.Rows = 2
Call RedimenssioneGrille
SSPanel1.Refresh
MSHFlexGrid1.Refresh
Call AfficheContenuGrille
Call SurligneLigne
End Sub

Public Sub RedimenssioneGrille()
On Error Resume Next

SSPanel1.Top = 100
SSPanel1.Width = MSHFlexGrid1.Width
MSHFlexGrid1.Top = SSPanel1.Height + 100
MSHFlexGrid1.Width = UserControl.Width - 200
MSHFlexGrid1.Left = (UserControl.Width - MSHFlexGrid1.Width) / 2
SSPanel1.Left = MSHFlexGrid1.Left
MSHFlexGrid1.Height = UserControl.Height - 450
MSHFlexGrid1.HighLight = 0
SSPanel1.Refresh
MSHFlexGrid1.Refresh
End Sub

Public Sub FindCol(ByVal Ligne As Integer)
On Error Resume Next

Label12.Caption = AStr(Ligne)
End Sub

Public Function FindRec(ByVal Ligne As String) As Integer
Dim Compteur As Double
Dim Ligne1 As Variant
Dim FinCol As Boolean

On Error Resume Next

If Ligne <> "" Then
FinCol = False
MSHFlexGrid1.Col = Val(Label12.Caption) - 1
While Compteur <> MSHFlexGrid1.Rows And FinCol = False
MSHFlexGrid1.Row = Compteur
If InStr(1, MSHFlexGrid1.Text, Ligne) > 0 Then
FinCol = True
MSHFlexGrid1.TopRow = MSHFlexGrid1.Row
End If
Compteur = Compteur + 1
Wend
End If

If FinCol = True Then
FindRec = 0
Else
FindRec = -1
End If
Call SurligneLigne
End Function

Public Sub SurligneLigne()
On Error Resume Next

MSHFlexGrid1.Col = 0
MSHFlexGrid1.ColSel = MSHFlexGrid1.Cols - 1
End Sub

Public Property Get CheminTable() As String
On Error Resume Next

CheminTable = Label9.Caption
TempChemin = CheminTable
End Property

Public Property Let CheminTable(ByVal vNewValue As String)
On Error Resume Next

Label9.Caption = vNewValue
TempChemin = vNewValue
PropertyChanged "CheminTable"
End Property

Public Property Get CheminTableBis() As String
On Error Resume Next

CheminTableBis = Label14.Caption
TempCheminBis = CheminTableBis
End Property

Public Property Let CheminTableBis(ByVal vNewValue As String)
On Error Resume Next

Label14.Caption = vNewValue
TempCheminBis = vNewValue
PropertyChanged "CheminTableBis"
End Property

Public Property Get NomTable() As String
On Error Resume Next

NomTable = Label10.Caption
TempTable = NomTable
End Property

Public Property Let NomTable(ByVal vNewValue As String)
On Error Resume Next

Label10.Caption = vNewValue
TempTable = vNewValue
PropertyChanged "NomTable"
End Property

Public Property Get NomTableBis() As String
On Error Resume Next

NomTableBis = Label15.Caption
TempTableBis = NomTableBis
End Property

Public Property Let NomTableBis(ByVal vNewValue As String)
On Error Resume Next

Label15.Caption = vNewValue
TempTableBis = vNewValue
PropertyChanged "NomTableBis"
End Property


Public Property Get NumIndex() As String
On Error Resume Next

NumIndex = Label11.Caption
TempNumIndex = NumIndex
End Property

Public Property Let NumIndex(ByVal vNewValue As String)
On Error Resume Next

Label11.Caption = vNewValue
TempNumIndex = vNewValue
PropertyChanged "NumIndex"
End Property

Public Property Get Relais() As String
On Error Resume Next

Relais = Label13.Caption
TempRelais = Relais
End Property

Public Property Let Relais(ByVal vNewValue As String)
On Error Resume Next

Label13.Caption = vNewValue
TempRelais = vNewValue
PropertyChanged "Relais"
End Property

Public Property Get NumIndexR() As String
On Error Resume Next

NumIndexR = Label5.Caption
TempNumIndexR = NumIndexR
End Property

Public Property Let NumIndexR(ByVal vNewValue As String)
On Error Resume Next

Label5.Caption = vNewValue
TempNumIndexR = vNewValue
PropertyChanged "NumIndexR"
End Property

Public Sub ChampRec(ByVal Ligne As String)
On Error Resume Next

ChampFindRec = Ligne
Refresh
ChampFindRec = ""
End Sub

Public Sub AfficheContenuGrille()
Dim Ligne As Variant
Dim Ligne1 As Variant
Dim Compteur As Integer
Dim Compteur1 As Integer
Dim Handle As Double
Dim HandleBis As Double
Dim CheminBD As String
Dim Table As String
Dim CheminBDBis As String
Dim TableBis As String
Dim NbRec As Double
Dim NbIndex As Integer
Dim Cle As keydesc
Dim CleBis As keydesc
Dim NIndex As String
Dim CIndex As Integer
Dim Extension As String
Dim NbCarIndex As Double
Dim PosIndex As Double
Dim CompteurLigne As Double
Dim IndexInfo As dictinfo
Dim KeyInfo As keypart
Dim NbCol As Double
Dim GTemp As String


On Error Resume Next

' Mise en forme ASC
'IsstartAsi(ByVal isfd As Long, ekey As keydesc, ByVal length As Integer, ByVal record As String, ByVal Mode As Long, ByVal debutrec As Long, ByVal longeurrec As Long, ByRef X As LectureIsam) As Integer
'length = spécifie la partie de la clé qui doit être considéré comme significatif lorsqu'il s'agit de localiser l'enregistrement de démarrage.
'ISFIRST = trouve le premier enregistrement en positionnant le point de départ juste avant le premier enregistrement.
'ISLAST = trouve le dernier enregistrement en positionnant le point de départ juste avant le dernier enregistremen
'ISEQUAL = trouve l'enregistrement égal à la valeur de recherche.
'ISGREAT = trouve le premier enregistrement supérieure à la valeur de recherche.
'IGTEQ = trouve le premier enregistrement supérieur ou égal à la valeur de recherche.
'ISKEEPLOCK = provoque isstart de garder les verrous posés sur n'importe quel enregistrement dans verrouillage automatique-mode.



If TempValue = "" Then
TempNumIndex = NumIndex

'***********************************************************************
'**** Affiche Titre colone ****
'***********************************************************************
Compteur = 1
NbCol = MSHFlexGrid1.Cols
While Compteur <> NbCol + 1
' Affiche le titre
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = Compteur - 1
MSHFlexGrid1.Text = RechercheLigne(Compteur, Label1.Caption)
' Traite la taille de la cellule
MSHFlexGrid1.ColWidth(Compteur - 1) = RechercheLigne(Compteur, TempTaille)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = Compteur - 1
StrTemp = RechercheLigne(Compteur, TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
Compteur = Compteur + 1
Wend

NbCol = Cols
CompteurLigne = 2

'***********************************************************************
'**** Recherche et affiche Index ****
'***********************************************************************
' Ouverture de la table index
CheminBD = RechercheLigne(TempNumIndex, CheminTable)
CheminBD = Replace(CheminBD, "@", ":")
Table = RechercheLigne(TempNumIndex, NomTable)
ChDrive Left(CheminBD, 1)
ChDir CheminBD
Handle = IsopenAsi(Table, ISINOUT + ISAUTOLOCK, ResIsam)
If Handle < 0 And Table <> "" Then
MsgBox "Erreur d'ouverture de fichier ISAM Index," & Chr$(13) + Chr$(10) & "chemin: " & CheminBD + Chr$(13) + Chr$(10) & "table: " & Table + Chr$(13) + Chr$(10) & "Err N°: " + AStr(ResIsam.IsErrNo)
End If
MSHFlexGrid1.Rows = 2

' Recherche le nombre d'index sur la table
NbIndex = 1
StrTemp = RechercheLigne(Val(TempNumIndex), LigneChamp)
Compteur = 1
CompteurIndex = 0
If StrTemp <> "" Then
While Compteur <> Len(StrTemp)
If Mid(StrTemp, Compteur, 1) = "-" Then
CompteurIndex = CompteurIndex + 1
End If
Compteur = Compteur + 1
Wend
End If

' Affecte les indexs à la cle
CIndex = 0
Compteur = 1
MemPosT = 1
While Compteur <> Len(StrTemp) + 1
If Mid(StrTemp, Compteur, 1) <> "-" And Mid(StrTemp, Compteur, 1) <> "@" Then
GTemp = GTemp + Mid(StrTemp, Compteur, 1)
Else
If Mid(StrTemp, Compteur, 1) = "-" Then
ValTemp = InStr(MemPosT, StrTemp, "-")
PosIndex = GTemp
MemPosT = Compteur + 1
GTemp = ""
End If
If Mid(StrTemp, Compteur, 1) = "@" Then
NbCarIndex = Val(GTemp)
Cle.k_flags = ISNODUPS
Cle.k_nparts = CompteurIndex
Cle.k_part(CIndex).kp_start = PosIndex
Cle.k_part(CIndex).kp_leng = NbCarIndex
Cle.k_part(CIndex).kp_type = CHARTYPE
GTemp = ""
CIndex = CIndex + 1
End If
End If
Compteur = Compteur + 1
Wend
NbCarIndex = Val(GTemp)
GTemp = ""
Cle.k_flags = ISNODUPS
Cle.k_nparts = CompteurIndex
Cle.k_part(CIndex).kp_start = PosIndex
Cle.k_part(CIndex).kp_leng = NbCarIndex
Cle.k_part(CIndex).kp_type = CHARTYPE

' Affiche la colone Index
Compteur1 = 0
Car = 65
StrTemp = ""
Ligne = "A"
Rep = IsstartAsi(Handle, Cle, 0, Ligne, ISGREAT, 0, 0, ResIsam)
'If IsstartAsi(THandle(NIndex), Cle, 0, Ligne, ISGREAT, 0, 0, ResIsam) = 0 Then

If Rep = 0 Then
If IsreadAsi(Handle, ISCURR, ResIsam) = 0 Then
Compteur = 1
StrTemp = RechercheLigne(Val(TempNumIndex), TempCExt)
MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
MSHFlexGrid1.Row = Compteur
' Extracion de la ligne dans le rec
StrTemp = RechercheLigne(Val(TempNumIndex), TempCExt)
ValTemp = InStr(1, StrTemp, "-")
PosCar = Val(Left(StrTemp, ValTemp - 1))
NBCar = Val(Right(StrTemp, Len(StrTemp) - ValTemp))
Ligne = Mid(ResIsam.Ligne, PosCar + 1, NBCar)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = TempNumIndex - 1
StrTemp = RechercheLigne(Val(TempNumIndex), TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
MSHFlexGrid1.Row = Compteur
MSHFlexGrid1.Text = Ligne
Compteur = Compteur + 1
While IsreadAsi(Handle, ISNEXT, ResIsam) = 0
StrTemp = RechercheLigne(Val(TempNumIndex), TempCExt)
MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
MSHFlexGrid1.Row = Compteur
' Extracion de la ligne dans le rec
StrTemp = RechercheLigne(Val(TempNumIndex), TempCExt)
ValTemp = InStr(1, StrTemp, "-")
PosCar = Val(Left(StrTemp, ValTemp - 1))
NBCar = Val(Right(StrTemp, Len(StrTemp) - ValTemp))
Ligne = Mid(ResIsam.Ligne, PosCar + 1, NBCar)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = TempNumIndex - 1
StrTemp = RechercheLigne(Val(TempNumIndex), TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
MSHFlexGrid1.Row = Compteur
MSHFlexGrid1.Text = Ligne
Compteur = Compteur + 1
Wend
End If
Else
Ligne = "0"
If IsstartAsi(Handle, Cle, 0, Ligne, ISGREAT, 0, 0, ResIsam) = 0 Then
If IsreadAsi(Handle, ISCURR, ResIsam) = 0 Then
Compteur = 1
MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
MSHFlexGrid1.Row = Compteur
' Extracion de la ligne dans le rec
StrTemp = RechercheLigne(Val(TempNumIndex), TempCExt)
ValTemp = InStr(1, StrTemp, "-")
PosCar = Val(Left(StrTemp, ValTemp - 1))
NBCar = Val(Right(StrTemp, Len(StrTemp) - ValTemp))
Ligne = Mid(ResIsam.Ligne, PosCar + 1, NBCar)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = TempNumIndex - 1
StrTemp = RechercheLigne(Val(TempNumIndex), TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
MSHFlexGrid1.Text = Ligne
Compteur = Compteur + 1
While IsreadAsi(Handle, ISNEXT, ResIsam) = 0
MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
MSHFlexGrid1.Row = Compteur
' Extracion de la ligne dans le rec
StrTemp = RechercheLigne(Val(TempNumIndex), TempCExt)
ValTemp = InStr(1, StrTemp, "-")
PosCar = Val(Left(StrTemp, ValTemp - 1))
NBCar = Val(Right(StrTemp, Len(StrTemp) - ValTemp))
Ligne = Mid(ResIsam.Ligne, PosCar + 1, NBCar)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = TempNumIndex - 1
StrTemp = RechercheLigne(Val(TempNumIndex), TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
MSHFlexGrid1.Text = Ligne
Compteur = Compteur + 1
Wend
End If
End If
End If
MSHFlexGrid1.Rows = MSHFlexGrid1.Rows - 1
' Fermeture de la table index
Rep = IscloseAsi(Handle, ResIsam)



'***********************************************************************
'**** Affiche le reste des colones sans l'Index ****
'***********************************************************************
' Affichage du reste des colones
Compteur = 1
While Compteur <> NbCol + 1
If TempNumIndex <> Compteur Then
' Ouverture base
CheminBD = RechercheLigne(Compteur, CheminTable)
CheminBD = Replace(CheminBD, "@", ":")
Table = RechercheLigne(Compteur, NomTable)
ChDrive Left(CheminBD, 1)
ChDir CheminBD
Handle = IsopenAsi(Table, ISINOUT + ISAUTOLOCK, ResIsam)
If Handle < 0 And Table <> "" Then
MsgBox "Erreur d'ouverture de fichier ISAM," & Chr$(13) + Chr$(10) & "chemin: " & CheminBD + Chr$(13) + Chr$(10) & "table: " & Table + Chr$(13) + Chr$(10) & "Err N°: " + AStr(ResIsam.IsErrNo)
End If
' Ouverture base Bis Relais
If RechercheLigne(Compteur, TempRelais) = "Vrai" Then
CheminBDBis = RechercheLigne(Compteur, CheminTableBis)
CheminBDBis = Replace(CheminBD, "@", ":")
TableBis = RechercheLigne(Compteur, NomTableBis)
ChDrive Left(CheminBDBis, 1)
ChDir CheminBDBis
HandleBis = IsopenAsi(TableBis, ISINOUT + ISAUTOLOCK, ResIsam)
If HandleBis < 0 And Table <> "" Then
MsgBox "Erreur d'ouverture de fichier ISAM Bis," & Chr$(13) + Chr$(10) & "chemin: " & CheminBD + Chr$(13) + Chr$(10) & "table: " & Table + Chr$(13) + Chr$(10) & "Err N°: " + AStr(ResIsam.IsErrNo)
End If

End If

' Calcul le nombre d'index de la table
NbIndex = 1
StrTemp = RechercheLigne(Compteur, LigneChamp)
C2 = 1
CompteurIndex = 0
If StrTemp <> "" Then
While C2 <> Len(StrTemp)
If Mid(StrTemp, C2, 1) = "-" Then
CompteurIndex = CompteurIndex + 1
End If
C2 = C2 + 1
Wend
End If

CIndex = 0
C2 = 1
MemPosT = 1
GTemp = ""
While C2 <> Len(StrTemp) + 1
If Mid(StrTemp, C2, 1) <> "-" And Mid(StrTemp, C2, 1) <> "@" Then
GTemp = GTemp + Mid(StrTemp, C2, 1)
Else
If Mid(StrTemp, C2, 1) = "-" Then
ValTemp = InStr(MemPosT, StrTemp, "-")
PosIndex = GTemp
MemPosT = C2 + 1
GTemp = ""
End If
If Mid(StrTemp, C2, 1) = "@" Then
NbCarIndex = Val(GTemp)
Cle.k_flags = ISNODUPS
Cle.k_nparts = CompteurIndex
Cle.k_part(CIndex).kp_start = PosIndex
Cle.k_part(CIndex).kp_leng = NbCarIndex
Cle.k_part(CIndex).kp_type = CHARTYPE
hh = hh + NbCarIndex
GTemp = ""
CIndex = CIndex + 1
End If
End If
C2 = C2 + 1
Wend
NbCarIndex = Val(GTemp)
GTemp = ""
Cle.k_flags = ISNODUPS
Cle.k_nparts = CompteurIndex
Cle.k_part(CIndex).kp_start = PosIndex
Cle.k_part(CIndex).kp_leng = NbCarIndex
Cle.k_part(CIndex).kp_type = CHARTYPE
PosIndex = 0
hh = hh + NbCarIndex
NbCarIndex = 0

C1 = 1
While C1 <> MSHFlexGrid1.Rows
MSHFlexGrid1.Row = C1
MSHFlexGrid1.Col = Val(RechercheLigne(Compteur, NumIndexR)) - 1
ChampFind = MSHFlexGrid1.Text
If hh = Len(ChampFind) Then
Rep = IsstartAsi(Handle, Cle, hh, ChampFind, ISEQUAL, 0, 0, ResIsam)
Else
ChampFind = ChampFind + String(hh - Len(ChampFind), " ")
Rep = IsstartAsi(Handle, Cle, hh, ChampFind, ISGREAT, 0, 0, ResIsam)
End If
If Rep = 0 Then
'If IsreadAsi(Handle, ISNEXT, ResIsam) = 0 Then
If IsreadAsi(Handle, ISCURR, ResIsam) = 0 Then
' Extracion de la ligne dans le rec
StrTemp = RechercheLigne(Compteur, TempCExt)
ValTemp = InStr(1, StrTemp, "-")
PosCar = Val(Left(StrTemp, ValTemp - 1))
NBCar = Val(Right(StrTemp, Len(StrTemp) - ValTemp))
Ligne = Mid(ResIsam.Ligne, PosCar + 1, NBCar)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = Compteur - 1
StrTemp = RechercheLigne(Compteur, TempPos)
If StrTemp = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTemp = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTemp "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
' Si relais
If RechercheLigne(Compteur, TempRelais) <> "Vrai" Then
MSHFlexGrid1.Text = Ligne ' Pas relais
Else
' Il y a relais
' Calcul le nombre d'index de la tableBis
NbIndexBis = 1
StrTempBis = RechercheLigne(Compteur, LigneChampBis)
C2Bis = 1
CompteurIndexBis = 0
If StrTempBis <> "" Then
While C2Bis <> Len(StrTempBis)
If Mid(StrTempBis, C2Bis, 1) = "-" Then
CompteurIndexBis = CompteurIndexBis + 1
End If
C2Bis = C2Bis + 1
Wend
End If

CIndexBis = 0
C2Bis = 1
MemPosTBis = 1
GTempBis = ""
While C2Bis <> Len(StrTempBis) + 1
If Mid(StrTempBis, C2Bis, 1) <> "-" And Mid(StrTempBis, C2Bis, 1) <> "@" Then
GTempBis = GTempBis + Mid(StrTempBis, C2Bis, 1)
Else
If Mid(StrTempBis, C2Bis, 1) = "-" Then
ValTempBis = InStr(MemPosTBis, StrTempBis, "-")
PosIndexBis = GTempBis
MemPosTBis = C2Bis + 1
GTempBis = ""
End If
If Mid(StrTempBis, C2Bis, 1) = "@" Then
NbCarIndexBis = Val(GTempBis)
CleBis.k_flags = ISNODUPS
CleBis.k_nparts = CompteurIndexBis
CleBis.k_part(CIndexBis).kp_start = PosIndexBis
CleBis.k_part(CIndexBis).kp_leng = NbCarIndexBis
CleBis.k_part(CIndexBis).kp_type = CHARTYPE
hhBis = hhBis + NbCarIndexBis
GTempBis = ""
CIndexBis = CIndexBis + 1
End If
End If
C2Bis = C2Bis + 1
Wend
NbCarIndexBis = Val(GTempBis)
GTempBis = ""
CleBis.k_flags = ISNODUPS
CleBis.k_nparts = CompteurIndexBis
CleBis.k_part(CIndexBis).kp_start = PosIndexBis
CleBis.k_part(CIndexBis).kp_leng = NbCarIndexBis
CleBis.k_part(CIndexBis).kp_type = CHARTYPE
PosIndexBis = 0
hhBis = hhBis + NbCarIndexBis
NbCarIndexBis = 0
ChampFindBis = Ligne
If hhBis = Len(ChampFindBis) Then
Rep = IsstartAsi(HandleBis, CleBis, hhBis, ChampFindBis, ISEQUAL, 0, 0, ResIsam)
Else
ChampFindBis = ChampFindBis + String(hhBis - Len(ChampFindBis), " ")
Rep = IsstartAsi(HandleBis, CleBis, hhBis, ChampFindBis, ISGREAT, 0, 0, ResIsam)
End If
If Rep = 0 Then
'If IsreadAsi(Handle, ISNEXT, ResIsam) = 0 Then
If IsreadAsi(HandleBis, ISCURR, ResIsam) = 0 Then
' Extracion de la ligne dans le rec
StrTempBis = RechercheLigne(Compteur, TempCExtBis)
ValTempBis = InStr(1, StrTempBis, "-")
PosCarBis = Val(Left(StrTempBis, ValTempBis - 1))
NBCarBis = Val(Right(StrTempBis, Len(StrTempBis) - ValTempBis))
LigneBis = Mid(ResIsam.Ligne, PosCarBis + 1, NBCarBis)
' Positionne le texte dans la grille
MSHFlexGrid1.Col = Compteur - 1
StrTempBis = RechercheLigne(Compteur, TempPos)
If StrTempBis = "G" Then
MSHFlexGrid1.CellAlignment = 1
Else
If StrTempBis = "M" Then
MSHFlexGrid1.CellAlignment = 4
Else
If StrTempBis "D" Then MSHFlexGrid1.CellAlignment 7
End If
End If
MSHFlexGrid1.Text = LigneBis
Else
MSHFlexGrid1.Text = ""
End If
End If
hhBis = 0
End If
End If
Else
GTemp = ResIsam.IsErrNo
GTempBis = ResIsam.IsErrNo
End If
C1 = C1 + 1
Wend
hh = 0
' Fermeture de la table index
Rep = IscloseAsi(Handle, ResIsam)
If RechercheLigne(Compteur, TempRelais) = "Vrai" Then ' Relais
Rep = IscloseAsi(HandleBis, ResIsam)
End If
End If
Compteur = Compteur + 1
Wend
Else
'***************************************************
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
7 juil. 2012 à 19:15
"Il y a du monde", hein ?
Hé bien :
1) ne présente que le monde qui gère ce qui nous intéresse
2) fais-le en parfait respect de ce forum : code indenté et entre balises code.
Il devrait rester "peu de monde" et du "monde présentable"


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014
7 juil. 2012 à 19:18
Code indenté je devine mais pour entre balises code je ne vois pas
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
7 juil. 2012 à 19:19
Et j'ai vu là-dedans "en diagonale" (car un code ainsi présenté me fait fuir) beaucoup de "monde" basé sur un "On Error Resume Next", généralement révélateur de code mal maîtrisé
Reprends-moi donc tout cela et fais-le :
- en ne montrant que le code nous intéressant
- en l'indentant et l'affichant comme il se doit !
Si tu ne le fais pas ===>> tu vas rester bien seul.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014
7 juil. 2012 à 19:25
J'espère qu'en présentation cela sera plus simple: (ayant fait un simple copier coller tout à l'heure)

Une propriété type:

Public Property Get CheminTableBis() As String
CheminTableBis = Label14.Caption
TempCheminBis = CheminTableBis
End Property

Public Property Let CheminTableBis(ByVal vNewValue As String)
Label14.Caption = vNewValue
TempCheminBis = vNewValue
PropertyChanged "CheminTableBis"
End Property
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
7 juil. 2012 à 19:29
Hé bien moi, je vais aller pêcher (les poissons me comprennent mieux et savent de quoi ils "parlent" ).


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
0
28marc28 Messages postés 39 Date d'inscription jeudi 10 avril 2003 Statut Membre Dernière intervention 4 juin 2014
7 juil. 2012 à 19:30
Je suis désolé je n'arrive pas a garder le programme en décalé pour une meilleure lisibilité !!!
0
Utilisateur anonyme
8 juil. 2012 à 02:01
Bonjour quand même,



Merci de ton aide c'était parfais, je suis dans la mouise avec un gros souci qui me bloque et je dois finir cet ocx pour enfin pouvoir avancer dans mon programme, car j'ai des délais à tenir, bref c'est mon affaire…



Tu sembles oublier une chose. Ceux qui répondent ici le font bénévolement, à même leur temps libre. Personne n'est obligé de répondre.



Je n'ai pas vraiment l'habitude de ce forum et encore moins de son éditeur qui me modifie la forme du code, après l'avoir validé, alors que sur VB il est impeccable.



On parle ici d'une page HTML sans validation de code.

Il y a justement une section du forum consacrée à l'amélioration du site.

En échange d'une réponse, le règlement du forum demande quelques efforts.

Pour les balises, si tu avais juste exploré un peu les icônes en haut de la fenêtre d'édition, tu aurais trouvé facilement le moyen d'y parvenir.

Mettre manuellement des espaces au début des seules quelques lignes de code qui permettent de décrire le problème, ce n'est pas la mer à boire.
0
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
8 juil. 2012 à 11:27
Salut

Pour présenter du code, tu colles ton code, puis tu le sélectionnes et tu cliques sur la 3ème icone à droite + VB.
Le code se colorisé et conservera son indentation.

Moi aussi, j'ai parcouru en diagonale les premières lignes :
Oui, commence par supprimer tous les "On Errore Resume Next"
Cette méthode de gestion d'erreur n'est à utiliser que dans certains cas, il ne faut surtout pas généraliser au risque de masquer une erreur de programmation comme celle-ci :
Enabled = False
dans le UserControl_Initialize.
Doit générer une erreur.

Tes variables ne sont pas déclarées (TempLigne, ...).
Utiliser des noms de variables ressemblant aux mots clé ou objets du langage = gros risques (Text, Row, Font ...)
Variant ne doit être utilisé que dans certains cas, pas comme un pis aller parce qu'on ne sait pas quoi mettre.

If NewCaption = "" Then
SSPanel1.Height = 0
SSPanel1.Visible = False
Else
SSPanel1.Visible = True
End If 
Lorsque tu mets à True, le Height est resté à 0.
Normal ?
Ça marche quand même ?

While-Wend : Obsolète
Utiliser Do While-Loop

Get et Let de FontCaption n'utilisent pas le même type de variable. Normalement, le compilateur devrait gueuler.

Redim ... As ...
Syntaxe impropre

Simplifie :
If FlagAffiche = False Then
FlagAffiche = True
Else
FlagAffiche = False
End If
FlagAffiche = Not FlagAffiche


If Extension "Pdf" Or Extension "pdf" Then
If StrComp(Extension, "Pdf", vbTextCompare) = 0 Then

...
Beaucoup de choses à revoir.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0
Rejoignez-nous