28marc28
|
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
'***************************************************
'**** Affiche les colones ****
'***************************************************
MSHFlexGrid1.Rows = 2
NbCol = MSHFlexGrid1.Cols
Compteur = 1
While Compteur <> NbCol + 1
' 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
NbCarIndex = 0
recfind = TempValue
Rep = IsstartAsi(Handle, Cle, 0, "", ISFIRST, 0, 0, ResIsam)
NumRec = 0
While IsreadAsi(Handle, ISNEXT, ResIsam) = 0
If Rep = 0 And InStr(1, ResIsam.Ligne, TempValue) <> 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
If Compteur = 1 Then
MSHFlexGrid1.Row = MSHFlexGrid1.Rows - 1
Else
NumRec = NumRec + 1
MSHFlexGrid1.Row = NumRec
End If
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
If Compteur = 1 Then MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
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
'
' If hhBis = Len(ChampFindBis) Then
' Rep = IsstartAsi(HandleBis, CleBis, hhBis, TempValue, ISEQUAL, 0, 0, ResIsam)
' Else
' ChampFindBis = ChampFindBis + String(hhBis - Len(ChampFindBis), " ")
' Rep = IsstartAsi(HandleBis, CleBis, hhBis, TempValue, 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
Else
GTemp = ResIsam.IsErrNo
GTempBis = ResIsam.IsErrNo
End If
C1 = C1 + 1
Wend
'End If
' Fermeture de la table index
Rep = IscloseAsi(Handle, ResIsam)
If RechercheLigne(Compteur, TempRelais) = "Vrai" Then ' Relais
Rep = IscloseAsi(HandleBis, ResIsam)
End If
Compteur = Compteur + 1
Wend
MSHFlexGrid1.Rows = MSHFlexGrid1.Rows - 1
End If
' Traite la ligne de séléction
MSHFlexGrid1.HighLight = 1
If Flag = True Then
MSHFlexGrid1.Row = ReSelectionneLigne
If MSHFlexGrid1.Row = 0 Then
MSHFlexGrid1.Row = 1
Else
MSHFlexGrid1.TopRow = MSHFlexGrid1.Row
End If
Else
MSHFlexGrid1.Row = MSHFlexGrid1.Rows - 1
MSHFlexGrid1.TopRow = MSHFlexGrid1.Rows - 1
End If
SSPanel1.Refresh
MSHFlexGrid1.Refresh
Call SurligneLigne
' If IsstartAsi(THandle(Compteur), Cle, 0, CIndex, ISEQUAL, 0, 0, ResIsam) = 0 Then
' If IsreadAsi(THandle(Compteur), ISCURR, ResIsam) = 0 Then
' If Rep = 0 Then
' StrTemp = RechercheLigne(Compteur, LigneChamp)
' ValTemp = InStr(1, StrTemp, "-")
' PosCar = Left(StrTemp, ValTemp - 1)
' NBCar = Right(StrTemp, Len(StrTemp) - ValTemp)
' Ligne1 = Mid(ResIsam.Ligne, PosCar, NBCar)
' If InStr(1, Ligne1, ".") > 0 Then
' If Len(NomChamp) > 4 Then
' Extension = Right(NomChamp, 3)
' If Extension = "Pdf" Or Extension = "pdf" Then Set MSHFlexGrid1.CellPicture = Image3.Picture
' If Extension = "Eml" Or Extension = "eml" Then Set MSHFlexGrid1.CellPicture = Image1.Picture
' If Extension = "Xls" Or Extension = "xls" Then Set MSHFlexGrid1.CellPicture = Image5.Picture
' If Extension = "Jpg" Or Extension = "jpg" Then Set MSHFlexGrid1.CellPicture = Image6.Picture
' Else
' 'Set MSHFlexGrid1.CellPicture = Image2.Picture
' End If
End Sub
|