Attribute VB_Name = "GBL"
Option Explicit

Public Const CLE = 1817

Public iForme               'Forme courante
Public iCouleur             'Couleur courante
Public cCourActif As Control 'Forme en cours
Public NomFic As String     'Nom fichier à la création

'---- Saisie d'un nom de fichier
Public Function DemandeNom(Nom As String)
'Boîte de dialogue commune pour la fermeture d'un fichier
    With frmTop.commdlg
    .CancelError = True
    .DefaultExt = "DES"
    .Filter = "Dessin (*.des)|*.DES|Tout fichier (*.*)|*.*"
    .FilterIndex = 1
    .filename = Nom
    .Flags = cdlOFNPathMustExist Or cdlOFNHideReadOnly Or cdlOFNOverwritePrompt

'Appelle la boîte
    On Error Resume Next
    .ShowSave
    On Error GoTo 0
    If Err = 0 Then
        Nom = .filename
        DemandeNom = True
    Else
        DemandeNom = False
    End If
    End With
End Function

'---- Enregistrement d'un fichier
Public Sub Enregistre(f As Form, Nom As String)
Dim i, X As Integer
Dim xx As Long
Dim c As Control
Dim nom1 As String

    On Error Resume Next
    Open Nom For Binary Access Write As 1
    If Err <> 0 Then
        MsgBox "Ne peut créer le fichier " + Nom, vbOK Or vbExclamation
        On Error GoTo 0
        Exit Sub
    End If

    On Error GoTo pbput
    X = CLE
    Put #1, , X                 'Clé
    X = f.Controls.Count - 1
    Put #1, , X                 'Nombre d'éléments
    If f.Controls.Count > 1 Then
        For i = 0 To f.Controls.Count - 1
            Set c = f.Controls(i)
            With c
            If .Visible Then
                X = .Shape
                Put #1, , X     'Shape
                xx = .FillColor
                Put #1, , xx    'FillColor
                X = .Left
                Put #1, , X     'Left
                X = .Top
                Put #1, , X     'Top
                X = .Width
                Put #1, , X     'Width
                X = .Height
                Put #1, , X     'Height
            End If
            End With
        Next
    End If
    Close #1
    nom1 = f.Tag
    Mid$(nom1, 1, 1) = "0"    'Pas modif
    On Error GoTo 0
    Exit Sub

pbput:
    MsgBox "Ne peut écrire le fichier " + Nom, vbOK Or vbExclamation
    On Error GoTo 0

End Sub

'---- Place le focus sur un contrôle
Public Sub MetFocus(c As Control)
    If Not (c Is Nothing) Then
        frmTop.SetStatus "(" & c.Left & "," & c.Top & ") - (" & c.Left + c.Width & "," & c.Top + c.Height & ")"
        c.BorderWidth = 3
        Set cCourActif = c
    End If
End Sub

'---- Retire le focus d'un contrôle
Public Sub OteFocus(c As Control)
    frmTop.SetStatus ""
    If Not (c Is Nothing) Then
        c.BorderWidth = 1
        Set cCourActif = Nothing
    End If
End Sub

