28marc28
Messages postés39Date d'inscriptionjeudi 10 avril 2003StatutMembreDerniè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.
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 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
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 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
Vous n’avez pas trouvé la réponse que vous recherchez ?
28marc28
Messages postés39Date d'inscriptionjeudi 10 avril 2003StatutMembreDerniè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
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
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
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
'***************************************************
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 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
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 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
28marc28
Messages postés39Date d'inscriptionjeudi 10 avril 2003StatutMembreDerniè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
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 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
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.
cs_Jack
Messages postés14006Date d'inscriptionsamedi 29 décembre 2001StatutModérateurDernière intervention28 août 201579 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)