Vb10 - créer vos propres calques sur une image

Duke49 Messages postés 552 Date d'inscription jeudi 12 octobre 2006 Statut Non membre Dernière intervention 24 janvier 2023 - 6 juin 2015 à 10:18
Bravo Duke et Whismeril et Merci. - 18 juin 2015 à 11:19

Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/54067-vb10-creer-vos-propres-calques-sur-une-image

Bravo Duke et Whismeril et Merci.
18 juin 2015 à 11:19

 Class SexaCoordonnee
        Friend Axe As Sexagesime = Sexagesime.Nord
        Friend Value As Decimal = 0
        Friend Property Text As String
            Get
                Dim Coordonnee() As Byte = Sexagesimal
                Return Axe.ToString & ":" & Coordonnee(0) & "-" & Coordonnee(1) & "-" & Coordonnee(2)
            End Get
            Set(ByVal StV As String)
                Dim S() As String = StV.Split(":")

                Select Case S(0) '("qu'on le dise une fois pour toutes")
                    Case "Nord" : Axe = Sexagesime.Nord
                    Case "Sud" : Axe = Sexagesime.Sud
                    Case "Ouest" : Axe = Sexagesime.Ouest
                    Case "Est" : Axe = Sexagesime.Est
                End Select 'La prochaine fois qu'on le redit, on ajoute haut et bas.
                'Case Haut Axe = Haut et Case Bas, Axe = Bas. 
               Dim St() As String = S(1).Split("-")
                Value = (3600 * St(0) + 60 * St(1) + St(2))
            End Set
        End Property
        Friend Property Sexagesimal As Byte()
            Get
                Dim R() As Byte = {89, 59, 59}
                Dim temp() As Decimal = {0, 0, 0}
                temp(0) = Int(Value / 3600)
                temp(2) = Value Mod 3600
                temp(1) = Int(temp(2) / 60)
                temp(2) = temp(2) Mod 60
                R(0) = temp(0) : R(1) = temp(1) : R(2) = temp(2)
                Return R
            End Get
            Set(ByVal Coordonnee As Byte())
                Value = Coordonnee(0) * 3600 + Coordonnee(1) * 60 + Coordonnee(2)
            End Set
        End Property
    End Class

La géodésie fonctionne bien. Avec un zoom sur une selection qui n'affecte pas les couleurs, on peut peaufiner les détails sans re-inventer le programme.
Les formules sont vérifiées, mais la structure et les labels seraient avantageugement améliorés que ça mangerait pas de pain.

Je recommence tout dans un module "Evolution" qui devrait idéaliser l'approche de l'analyse graphique (vectorialiser les pixels de la courbe) et introduire la reconaissance de forme.
L'objectif est de re-générer la courbe avec un algorythme de Fornar, sorte d'anachronisme qui suppose qu'une application qui colle au passé devrait donner une idée de l'avenir.
On pourrait décomposer en série de Fourrier si le digital ne convenait pas mieux a l'algorithmie qu'au calcul.

Certains savent quel objets de la librairie produisent des adaptations vérifiées, mais ils visitent d'autres sujets. Je recommencerais donc.

Public Class Evolution

    Function Bisextile(ByVal An As Integer) As Boolean
        REM RICHIE_KIRNINGHAM (Le Langage C) Une année est bisextile si elle est divisible par 4 et pas par cent a l'exception des années divisibles par 400 qui sont bisextiles.
        Dim BISEX As Boolean = An Mod 4 = 0
        BISEX = BISEX And Not An Mod 100 = 0
        If An Mod 400 = 0 Then BISEX = True
        Return BISEX
    End Function
    Function IndexDuJour(ByVal DTDate As DateTime) As UInt16
        Dim Calend() As UInt16 = {31.28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
	...

Au revoir, et merci Whismeril pour tes encouragements, A bientôt pour un autre sujet.
Bravo Duke et Whismeril et Merci.

Zoom PictureBox
15 juin 2015 à 04:38

J'ai pas fini de fignoler, et pour amélorer le module sexalogique, je développe des environements de tests.

Public Class Form1
    'Zoom dans la picturebox.
    Dim WithEvents Photo As New PictureBox With { _
        .Dock = DockStyle.Fill} ', .SizeMode = PictureBoxSizeMode.StretchImage}
    Dim OK As Boolean = True
    Sub New()
        InitializeComponent()
        Controls.Add(Photo)
        Dim OpenFileDialog As FileDialog
        Try
            OpenFileDialog = New OpenFileDialog
            OpenFileDialog.Filter = "Tous | *.*|Fichier Bitmap (*.bmp) | *.bmp "
            If OpenFileDialog.ShowDialog = Windows.Forms.DialogResult.OK Then
                'Ouverture de l'image
                Photo.Image = Image.FromFile(OpenFileDialog.FileName)
            End If
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical + MsgBoxStyle.OkOnly)
            OK = False
            Exit Sub
        End Try
    End Sub
    Sub QuandClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Photo.MouseClick
        If OK Then
            Dim X As Integer = e.X
            Dim W As Integer = Int(Photo.Width / 2)
              Dim Y As Integer = e.Y
            Dim H As Integer = Int(Photo.Height / 2)
            Dim Origin As Bitmap = Photo.Image.Clone
            Dim Temp As Bitmap = Photo.Image.Clone
            Dim Pixel As Color
            For i = 0 To W - 2
                For j = 0 To H - 2
                    Pixel = Origin.GetPixel(i + X / 2, j + Y / 2)
                    Temp.SetPixel(2 * i, 2 * j, Pixel)
                    Temp.SetPixel(2 * i + 1, 2 * j, Pixel)
                    Temp.SetPixel(2 * i, 2 * j + 1, Pixel)
                    Temp.SetPixel(2 * i + 1, 2 * j + 1, Pixel)
                Next
            Next
            Photo.Image = Temp
        End If
    End Sub

    
End Class

Attendez la version finale. C'est comme le scroll, il faut mettre l'objet visual dans le repère, pas greffer des repéres dans l'Óbject.

Whismeril Messages postés 19025 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 19 avril 2024 656
11 juin 2015 à 19:02

Bonsoir, n'étant plus dans ce domaine, je n'ai pas de quoi valider vos calculs. Je vous fait confiance.

Merci Whismeril, a bientôt.
11 juin 2015 à 12:59

Public Class Form1

    'Je tire une grande form1 dans le concepteur et je copy/colle ce code.
    'Auquel j'ajoute sexalogic(ajouter New module et copier\coller)
    Dim essai As New MiniGeoBox
    Sub New()
        InitializeComponent()
        essai.MiniBox.Dock = DockStyle.Bottom
        'sinon ca s'installe en haut ou je voudrais mettre la pictureBox avec le zoom dans un onglet pour rèver de tout ce que je pourrais rajouter.
        Controls.Add(essai.MiniBox)
    End Sub
    'Je run le debug de mon basic express,
    'Je click droit dans le jaune pour choisir une photo,
    '(tous les fichiers)
    'Je règle les paramètres géodésiques de l'onglet "Limites"
    'Et je me repose un peu avant de continuer.
    'Et j'ai pas besoin de sauvegarder parce que c'est édité
    'chez CodesSauce on dérouille. Merci. ING c'est trop formel.

End Class

Module Sexalogic

    Enum Sexagesimal
        Nord
        Sud
        Ouest
        Est
    End Enum

    Class SexaCoordonnee
        Friend Axe As Sexagesimal = "Nord"
        Friend Value As Decimal = 0
        Friend Property Text As String
            Get
                Dim Coordonnee() As Byte = Sexagesimal
                Return Axe.ToString & ":" & Coordonnee(0) & "-" & Coordonnee(1) & "-" & Coordonnee(2)
            End Get
            Set(ByVal StV As String)
                Dim S() As String = StV.Split(":")
                Axe = S(0)
                Dim St() As String = S(1).Split("-")
                Value = (3600 * St(0) + 60 * St(1) + St(2))
            End Set
        End Property
        Friend Property Sexagesimal As Byte()
            Get
                Dim R() As Byte = {179, 59, 59}
                Dim temp() As Decimal = {0, 0, 0}
                temp(0) = Int(Value / 3600)
                temp(2) = Value Mod 3600
                temp(1) = Int(temp(2) / 60)
                temp(2) = temp(2) Mod 60
                R(0) = temp(0) : R(1) = temp(1) : R(2) = temp(2)
                Return R
            End Get
            Set(ByVal Coordonnee As Byte())
                Value = Coordonnee(0) * 3600 + Coordonnee(1) * 60 + Coordonnee(2)
            End Set
        End Property
    End Class

    Class SexaBox
#Region "DECLARE CONCEPT"
        Friend Tableau As New Panel With {.Name = "Panneau", _
                .Anchor = 4, .Location = New Point(0, 0), .Size = New Point(300, 22)}
        Dim AxeLabel As New Label With {.Name = "AxeLabel", _
                .Anchor = 4, .Location = New Point(0, 2), .Size = New Point(58, 18)}
        Dim AxeBox As New ComboBox With {.Name = "AxeBox", _
                .Anchor = 4, .Location = New Point(58, 0), .Size = New Point(50, 18)}
        Dim Valeur As New NumericUpDown With {.Name = "Valeur", _
                                             .Minimum = 0, .Maximum = 179, _
                .Anchor = 4, .Location = New Point(114, 0), .Size = New Point(40, 18)}
        Dim Minute As New NumericUpDown With {.Name = "Minute", _
                                                .Minimum = 0, .Maximum = 59, _
             .Anchor = 4, .Location = New Point(160, 0), .Size = New Point(35, 18)}
        Dim Seconde As New NumericUpDown With {.Name = "Seconde", _
                                               .Minimum = 0, .Maximum = 59, _
              .Anchor = 4, .Location = New Point(200, 0), .Size = New Point(35, 18)}
        Sub initializeConcept()
            Tableau.Controls.Add(AxeLabel)
            Tableau.Controls.Add(AxeBox)
            Tableau.Controls.Add(Valeur)
            Tableau.Controls.Add(Minute)
            Tableau.Controls.Add(Seconde)
        End Sub
#End Region
        Property Coordonnee As SexaCoordonnee
            Get
                Dim Temp As New SexaCoordonnee
                Temp.Sexagesimal = {Valeur.Value, Minute.Value, Seconde.Value}
                Temp.Axe = AxeBox.Text
                Return Temp
            End Get
            Set(ByVal value As SexaCoordonnee)
                Dim Temp() As Byte = value.Sexagesimal
                AxeBox.Text = value.Axe
                Valeur.Value = Temp(0) : Minute.Value = Temp(1) : Seconde.Value = Temp(2)
            End Set
        End Property
        Sub New(Optional ByVal text As String = "Haut\Nord\89:59:59")
            initializeConcept()
            Dim S0() As String = text.Split("\")
            AxeLabel.Text = S0(0) : AxeBox.Text = S0(1)
            Dim S() As String = S0(2).Split(":")
            Valeur.Value = S(0) : Minute.Value = S(1) : Seconde.Value = S(2)
            If AxeBox.Text = "Nord" Or AxeBox.Text = "Sud" Then
                AxeBox.Items.Add("Nord") : AxeBox.Items.Add("Sud") : End If
            If AxeBox.Text = "Ouest" Or AxeBox.Text = "Est" Then
                AxeBox.Items.Add("Ouest") : AxeBox.Items.Add("Est") : End If
        End Sub
    End Class

    Class SexaPoint
        Dim Nom As String = ""
        Friend Longitude As New SexaCoordonnee
        Friend Latitude As New SexaCoordonnee
        Friend Property Text As String
            Get
                Dim S As String
                S = Latitude.Text & "\" & Longitude.Text
                Return S
            End Get
            Set(ByVal StrPos As String)
                Dim S() As String = StrPos.Split("\")
                For i As Integer = 0 To 1                   
                    If (S(i).Split(":")(0) < "ouest") Then
                        Latitude.Text = S(i)
                    Else
                        Longitude.Text = S(i)
                    End If
                Next
            End Set
        End Property
    End Class

    Class SexaCube
        Friend Bord() As SexaCoordonnee
        Function Height() As Decimal
            Return Bord(Sexagesimal.Nord).Value + Bord(Sexagesimal.Sud).Value
        End Function
        Function Width() As Decimal
            Return Bord(Sexagesimal.Ouest).Value + Bord(Sexagesimal.Est).Value
        End Function
        Function Point(ByVal Longitude As Sexagesimal, ByVal Latitude As Sexagesimal) As SexaPoint
            Dim Temp As New SexaPoint
            Temp.Longitude = Bord(Longitude)
            Temp.Latitude = Bord(Latitude)
            Return Temp
        End Function
#Region "DECLARE CONCEPT"
        Friend MiniTaSexaBox As New TabPage With {.Text = "Limites", .Location = New Point(0, 0)} 
        Sub initializeConcept()
            Dim CadreNord = New SexaBox("Haut\Nord\89:59:59") '.Tableau
            CadreNord.Tableau.Location = New Point(CadreNord.Tableau.Location.X, 11)
            MiniTaSexaBox.Controls.Add(CadreNord.Tableau)
            Dim CadreSud = New SexaBox("Bas\Sud\89:59:59")
            CadreSud.Tableau.Location = New Point(CadreSud.Tableau.Location.X, 32)
            MiniTaSexaBox.Controls.Add(CadreSud.Tableau)
            Dim CadreOuest = New SexaBox("Gauche\Ouest\23:59:59")
            CadreOuest.Tableau.Location = New Point(CadreOuest.Tableau.Location.X, 53)
            MiniTaSexaBox.Controls.Add(CadreOuest.Tableau)
            Dim CadreEst = New SexaBox("Droite\Est\23:59:59")
            CadreEst.Tableau.Location = New Point(CadreEst.Tableau.Location.X, 74)
            MiniTaSexaBox.Controls.Add(CadreEst.Tableau)
        End Sub
#End Region
        Sub New()
            initializeConcept()
        End Sub
    End Class

    Class SexaRepere
        Dim Mesures As Size
        Dim Echelle As Point
        Friend Matrice As New SexaCube
        Property Taille As Size
            Get
                Dim Tab As New Size
                Tab.Height = Echelle.Y * Mesures.Height
                Tab.Width = Echelle.X * Mesures.Width
                Return Tab
            End Get
            Set(ByVal value As Size)
                Mesures.Height = value.Height / Echelle.Y
                Mesures.Width = value.Width / Echelle.X
            End Set
        End Property
        Function Plot(ByVal Gite As SexaPoint) As Point
            Dim Position As New Point
            Position.Y = (Gite.Latitude.Value * Taille.Height + Matrice.Bord(Sexagesimal.Sud).Value) / Matrice.Height
            Position.X = (Gite.Longitude.Value * Taille.Width + Matrice.Bord(Sexagesimal.Est).Value) / Matrice.Width
            Return Position
        End Function
        Function Plot(ByVal Position As Point) As SexaPoint
            Dim Gite As New SexaPoint
            Gite.Longitude.Value = (Position.X * Matrice.Width - Matrice.Bord(Sexagesimal.Est).Value) / Taille.Width
            Gite.Latitude.Value = (Position.Y * Matrice.Height - Matrice.Bord(Sexagesimal.Sud).Value) / Taille.Height
            Return Gite
        End Function
    End Class

    Class Photofile
        Friend Photo As PictureBox
#Region "Menu"
        Sub NewMenu()
            Item_Ajouter.DropDownItems.Add(Item_Ajout_Photo)
        End Sub
        Dim WithEvents Item_Ajouter As New ToolStripMenuItem With {.Name = "ItemAjout", _
                                                                      .Text = "Ajouter"}
        Dim WithEvents Item_Ajout_Photo As New ToolStripMenuItem With {.Name = "ItemAjoutPhoto", _
            .Text = "Photo", .ToolTipText = "Charge une photo peripherique"}
        Sub AjoutePhoto() Handles Item_Ajout_Photo.Click
            Dim OpenFileDialog As FileDialog
            Try
                OpenFileDialog = New OpenFileDialog
                OpenFileDialog.Filter = "Fichier Bitmap (*.bmp) | *.bmp |Tous | *.*"
                If OpenFileDialog.ShowDialog = Windows.Forms.DialogResult.OK Then
                    'Ouverture de l'image
                    Photo.Image = Image.FromFile(OpenFileDialog.FileName)
                End If
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.Critical + MsgBoxStyle.OkOnly)
                Exit Sub
            End Try
        End Sub
#End Region

        Sub New(ByVal Box As PictureBox, Optional ByVal StartLoad As Boolean = False)
            NewMenu()
            Photo = Box
            Photo.ContextMenuStrip = New ContextMenuStrip
            Photo.ContextMenuStrip.Items.Add(Item_Ajouter)
            If StartLoad Then AjoutePhoto()
        End Sub
    End Class

    Class MiniGeoBox
        Dim Detail As New PictureBox
        Friend Repere As New SexaRepere
#Region "DECLARE CONCEPT"
        Friend MiniBox As New Panel With _
             {.Location = New Point(10, 10), .Size = New Point(460, 105), _
              .BackColor = Color.AliceBlue, .Anchor = 15}
        Dim WithEvents MiniPlan As New PictureBox With {.Location = New Point(260, 0), .Size = New Point(200, 105), _
                      .BackColor = Color.Beige, .SizeMode = PictureBoxSizeMode.StretchImage, _
                     .Anchor = 15}
        Dim Carton As New Photofile(MiniPlan)
        Dim Choix As New TabControl _
              With {.Location = New Point(0, 0), .Size = New Point(250, 105)}
        Dim PremierChoix As New TabPage With {.Text = "Selection"}  
        Sub initializeConcept()
            MiniBox.Controls.Add(MiniPlan)
            MiniBox.Controls.Add(Choix)
            Choix.Controls.Add(PremierChoix)
            Dim T As New TabPage
            T = Repere.Matrice.MiniTaSexaBox
            Choix.Controls.Add(T)
        End Sub
#End Region
        Sub New()
            initializeConcept()
        End Sub
    End Class

End Module

C'est pas grand chose mais ca fonctionne.

Merci Whismeril, a bientôt.
11 juin 2015 à 08:06

Merci Whismeril,
J'ai trouvé une solution qui marche au petit poil, mais trop brouillon pour développer. Heureusement, je découvre "ENUM" qui change tout.
Jái pas débuggé mais tant pi car
JE MIS, J'ÔTE.
Je sais pas si ca va marcher mais ce qui suit me botte.

Module Sexalogic

    Enum Sexagesimal
        Nord
        Sud
        Ouest
        Est
    End Enum

    Class SexaCoordonnee
        Friend Axe As Sexagesimal = "Nord"
        Friend Value As Decimal = 0
        Friend Property Text As String
            Get
                Dim Coordonnee() As Byte = Sexagesimal
                Return Axe.ToString & ":" & Coordonnee(0) & "-" & Coordonnee(1) & "-" & Coordonnee(2)
            End Get
            Set(ByVal StV As String)
                Dim S() As String = StV.Split(":")
                Axe = S(0)
                Dim St() As String = S(1).Split("-")
                Value = (3600 * St(0) + 60 * St(1) + St(2))
            End Set
        End Property
        Friend Property Sexagesimal As Byte()
            Get
                Dim R() As Byte = {179, 59, 59}
                Dim temp() As Decimal = {0, 0, 0}
                temp(0) = Int(Value / 3600)
                temp(2) = Value Mod 3600
                temp(1) = Int(temp(2) / 60)
                temp(2) = temp(2) Mod 60
                R(0) = temp(0) : R(1) = temp(1) : R(2) = temp(2)
                Return R
            End Get
            Set(ByVal Coordonnee As Byte())
                Value = Coordonnee(0) * 3600 + Coordonnee(1) * 60 + Coordonnee(2)
            End Set
        End Property
    End Class

    Class SexaBox
#Region "DECLARE CONCEPT"
        Friend Tableau As New Panel With {.Name = "Panneau", _
                .Anchor = 4, .Location = New Point(0, 0), .Size = New Point(300, 22)}
        Dim AxeLabel As New Label With {.Name = "AxeLabel", _
                .Anchor = 4, .Location = New Point(0, 2), .Size = New Point(58, 18)}
        Dim AxeBox As New ComboBox With {.Name = "AxeBox", _
                .Anchor = 4, .Location = New Point(58, 0), .Size = New Point(50, 18)}
        Dim Valeur As New NumericUpDown With {.Name = "Valeur", _
                                             .Minimum = 0, .Maximum = 179, _
                .Anchor = 4, .Location = New Point(114, 0), .Size = New Point(40, 18)}
        Dim Minute As New NumericUpDown With {.Name = "Minute", _
                                                .Minimum = 0, .Maximum = 59, _
             .Anchor = 4, .Location = New Point(160, 0), .Size = New Point(35, 18)}
        Dim Seconde As New NumericUpDown With {.Name = "Seconde", _
                                               .Minimum = 0, .Maximum = 59, _
              .Anchor = 4, .Location = New Point(200, 0), .Size = New Point(35, 18)}
        Sub initializeConcept()
            Tableau.Controls.Add(AxeLabel)
            Tableau.Controls.Add(AxeBox)
            Tableau.Controls.Add(Valeur)
            Tableau.Controls.Add(Minute)
            Tableau.Controls.Add(Seconde)
        End Sub
#End Region
        Property Coordonnee As SexaCoordonnee
            Get
                Dim Temp As New SexaCoordonnee
                Temp.Sexagesimal = {Valeur.Value, Minute.Value, Seconde.Value}
                Temp.Axe = AxeBox.Text
                Return Temp
            End Get
            Set(ByVal value As SexaCoordonnee)
                Dim Temp() As Byte = value.Sexagesimal
                AxeBox.Text = value.Axe
                Valeur.Value = Temp(0) : Minute.Value = Temp(1) : Seconde.Value = Temp(2)
            End Set
        End Property
        Sub New()
            initializeConcept()
        End Sub
    End Class

    Class SexaPoint
        Dim Nom As String = ""
        Friend Longitude As New SexaCoordonnee
        Friend Latitude As New SexaCoordonnee
        Friend Property Text As String
            Get
                Dim S As String
                S = Latitude.Text & "\" & Longitude.Text
                Return S
            End Get
            Set(ByVal StrPos As String)
                Dim S() As String = StrPos.Split("\")
                For i As Integer = 0 To 1                   
                    If (S(i).Split(":")(0) < "ouest") Then
                        Latitude.Text = S(i)
                    Else
                        Longitude.Text = S(i)
                    End If
                Next
            End Set
        End Property
    End Class

    Class SexaCube
        Friend Bord() As SexaCoordonnee
        Function Height() As Decimal
            Return Bord(Sexagesimal.Nord).Value + Bord(Sexagesimal.Sud).Value
        End Function
        Function Width() As Decimal
            Return Bord(Sexagesimal.Ouest).Value + Bord(Sexagesimal.Est).Value
        End Function
        Function Point(ByVal Longitude As Sexagesimal, ByVal Latitude As Sexagesimal) As SexaPoint
            Dim Temp As New SexaPoint
            Temp.Longitude = Bord(Longitude)
            Temp.Latitude = Bord(Latitude)
            Return Temp
        End Function
#Region "DECLARE CONCEPT"
        Dim User As New Panel With {.Name = "Panneau", _
             .Anchor = 13, .Location = New Point(0, 0), .Size = New Point(300, 300)}
        Dim Cadre() As SexaBox
        Sub initializeConcept()
            For i As Sexagesimal = "North" To "East"
                Cadre(i) = New SexaBox
                Cadre(i).Tableau.Location = New Point(Cadre(i).Tableau.Location.X, i * 20)
                User.Controls.Add(Cadre(i).Tableau)
            Next
        End Sub
#End Region
        Sub New()
            initializeConcept()
        End Sub
    End Class

    Class SexaRepere
        Dim Mesures As Size
        Dim Echelle As Point
        Dim Repere As SexaCube
        Property Taille As Size
            Get
                Dim Tab As New Size
                Tab.Height = Echelle.Y * Mesures.Height
                Tab.Width = Echelle.X * Mesures.Width
                Return Tab
            End Get
            Set(ByVal value As Size)
                Mesures.Height = value.Height / Echelle.Y
                Mesures.Width = value.Width / Echelle.X
            End Set
        End Property
        Function Plot(ByVal Gite As SexaPoint) As Point
            Dim Position As New Point
            Position.Y = (Gite.Latitude.Value * Taille.Height + Repere.Bord(Sexagesimal.Sud).Value) / Repere.Height
            Position.X = (Gite.Longitude.Value * Taille.Width + Repere.Bord(Sexagesimal.Est).Value) / Repere.Width
            Return Position
        End Function
        Function Plot(ByVal Position As Point) As SexaPoint
            Dim Gite As New SexaPoint
            Gite.Longitude.Value = (Position.X * Repere.Width - Repere.Bord(Sexagesimal.Est).Value) / Taille.Width
            Gite.Latitude.Value = (Position.Y * Repere.Height - Repere.Bord(Sexagesimal.Sud).Value) / Taille.Height
            Return Gite
        End Function
    End Class

End Module

Faut-il continuer ?
Je vais commencer par encapsuler tout ca dans des Tabcontroles pur laisser de la place au développements,

Whismeril Messages postés 19025 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 19 avril 2024 656
Modifié par Whismeril le 6/06/2015 à 11:43

Bonjour, j'ai rendu les liens wikipédia cliquables, et ai supprimé la référence à la source puisqu'il s'agit des commentaires de la dite source.

Concernant la géodésie, domaine que j'ai pratiqué pendant plus de 10 ans, pour conserver une précision inférieure au mètre dans les changements de repère, il ne faut pas utiliser les transformation linéaire

L'histoire d'une part : la réalisation de la NTF a débuté vers 1870-1880, avec les moyens de l'époque aussi bien en terme de mesures, que de calculs (inverser des matrices 1000*1000 à la main....). Il en résulte des biais aléatoirement répartit sur le territoire pouvant atteindre plusieurs mètres (ce qui n'est pas si mal, sans les mesures spatiales, on ne s'en serait jamais rendu compte!). D'autre part, les mesures terrestres ne peuvent pas relever la hauteur sur ellipsoïde, c'est une altitude qui est donc associée à ce type de coordonnées. Il faut donc passer par des modèles pour ce type de transformations.
La dérive des continents d'autre part, entre le WGS84 et le RGF93, pourtant basés sur le même ellipsoïde GRS80, les continents s'étant déplacés, les deux réalisations ne sont pas directement compatibles

Je t'invite à consulter le site de l'IGN, référence dans le domaine.

Merci Duke
Modifié par Whismeril le 6/06/2015 à 11:26

Bien didactique, ce petit programme est une oeuvre.
C'aurait pu être un Snippet comme je préfère.
C'est domage qu'il utilise une carte de France en ressources,
car copier c'est moins fatigant que télécharger la solution.
De toutes façon, et, compte tenu que le concepteur Microsoft s'est toujours pas amélioré,
le simple fait d'hériter un outil visuel brouille.
Donc on peut faire ni mieux, ni plus simple qu'en solution.

Le code est bien commenté; vous devriez avoir un tas d'idée a partir de mon code

La première idée qui me vient, c'est d'afficher les coordonneées GEODESIQUES on click.
J'ai donc commencer par m'informer sur le sujet, et j'ai stupidement suivi les instructions suivantes:

http://fr.wikipedia.org/wiki/Syst%C3%A8me_sexag%C3%A9simal
http://fr.wikipedia.org/wiki/Coordonn%c3%a9es_g%c3%a9ographiques
http://fr.wikipedia.org/wiki/Syst%C3%A8me_de_coordonn%C3%A9es_(cartographie)

Que je suis arrivé à

  Structure Horaire
        Dim Orientation As Boolean 'Est, Ouest
        Dim Heure As Byte
        Dim Minute As Byte
        Dim Seconde As Byte
    End Structure

    Structure Quadrant
        Dim Axe As Boolean 'Nord, Sud
        Dim Degre As Byte
        Dim Minute As Byte
        Dim Seconde As Byte
    End Structure

    Structure Geodesique
        Dim Nom As String
        Dim H As Horaire
        Dim Q As Quadrant
    End Structure

    Class Coordonnee
        Dim Nom As String = ""
        Dim H As Horaire
        Dim Q As Quadrant
        Property Geodesique As Geodesique
            Get
                Dim G As Geodesique
                With G : .Nom = Nom : .H = H : .Q = Q : End With
                Return G
            End Get
            Set(ByVal value As Geodesique)
                With value : Nom = .Nom : H = .H : Q = .Q : End With
            End Set
        End Property
        Property Latitude As Integer
            Get
                Dim Sens As Integer = -1
                If Q.Axe Then Sens = 1
                Return Sens * (Q.Degre + (Q.Minute / 60) + (Q.Seconde / 3600))
            End Get
            Set(ByVal value As Integer)
                With Q
                    If value < 0 Then .Axe = False Else .Axe = True
                    value = Math.Abs(value)
                    .Degre = Int(value)
                    .Seconde = (value - .Degre) * 60
                    .Minute = Int(.Seconde)
                    .Seconde = Int((.Seconde - .Minute) * 60)
                End With
            End Set
        End Property
        Property Longitude As Integer
            Get
                Dim Sens As Integer = -1
                If H.Orientation Then Sens = 1
                Return Sens * (H.Heure + (H.Minute / 60) + (H.Seconde / 3600))
            End Get
            Set(ByVal value As Integer)
                With H
                    If value < 0 Then .Orientation = False Else .Orientation = True
                    value = Math.Abs(value)
                    .Heure = Int(value)
                    .Seconde = (value - .Heure) * 60
                    .Minute = Int(.Seconde)
                    .Seconde = Int((.Seconde - .Minute) * 60)
                End With
            End Set
        End Property
        Property Text As String
            Get
                Dim S As String = Nom & ":"
                If H.Orientation Then S = S & "E:" Else S = S & "W:"
                S = S & H.Heure & "-" & H.Minute & "-" & H.Seconde & ":"
                If Q.Axe Then S = S & "N:" Else S = S & "S:"
                S = S & Q.Degre & "-" & Q.Minute & "-" & Q.Seconde
                Return S
            End Get
            Set(ByVal value As String)
                Dim S() As String = value.Split(":")
                Nom = S(0) : H.Orientation = S(1)
                Dim i As Byte = 0
                Dim Heure() As String = S(2).Split("-")
                If i < Heure.Length Then H.Heure = Heure(i) : i = i + 1
                If i < Heure.Length Then H.Minute = Heure(i) : i = i + 1
                If i < Heure.Length Then H.Seconde = Heure(i)
                i = 0 : Q.Axe = S(3)
                Dim Quart() As String = S(4).Split("-")
                If i < Quart.Length Then H.Heure = Heure(i) : i = i + 1
                If i < Quart.Length Then H.Minute = Heure(i) : i = i + 1
                If i < Quart.Length Then H.Seconde = Heure(i)
            End Set
        End Property
        Sub New(Optional ByVal Blase As String = "")
            Nom = Blase
        End Sub

    End Class

    Class LimitesDeLaCarte
        Dim NO As Coordonnee = Nothing
        Dim SE As Coordonnee = Nothing
        Function Proportions(ByVal Size As Point) As Point
            Dim P As New Point
            P.X = NO.Longitude - SE.Longitude
            P.Y = NO.Latitude - SE.Latitude
        End Function
         Sub New()
            Dim GNO As New Geodesique
            With GNO
                .Nom = "Nord Ouest"
                .H.Orientation = True
                .H.Heure = 12
                .H.Minute = 0
                .H.Seconde = 0
                .Q.Axe = False
                .Q.Degre = 90
                .Q.Minute = 0
                .Q.Seconde = 0
            End With
            NO.Geodesique = GNO
            Dim GSE As New Geodesique
            With GSE
                .Nom = "Sud Est"
                .H.Orientation = False
                .H.Heure = 12
                .H.Minute = 0
                .H.Seconde = 0
                .Q.Axe = True
                .Q.Degre = 90
                .Q.Minute = 0
                .Q.Seconde = 0
            End With
            SE.Geodesique = GSE
        End Sub
    End Class

J'ai débuggé jusqu'qu'à m'appercevoir que si ça fonctionne parfaitement,
les nombreux changements répètés de repères et les formules bien que linéaires,
ainsi que la précision des calculs, enregistraient avec une précision de quelques degrés avec une régularitè digne d'un générateur alléatoire.
On peut en faire un début d'introduction de didactique pré trigo sphèrique.

J'ai donc tout effacé pour changer d'arithmètique.
Et j'ai perdu un programme qui fonctionnait bien, mais qu'il reste une vieille sauvegarde ci-dessus qui idonne une idée de ce qu'il faut pas faire.

Je TRAVAILLE sur une nouvelle structure

Module Geodésie
    'http://codes-sources.commentcamarche.net/source/54067-vb10-creer-vos-propres-calques-sur-une-image
    'http://fr.wikipedia.org/wiki/Syst%C3%A8me_sexag%C3%A9simal
    'http://fr.wikipedia.org/wiki/Coordonn%c3%a9es_g%c3%a9ographiques
    'http://fr.wikipedia.org/wiki/Syst%C3%A8me_de_coordonn%C3%A9es_(cartographie)

    Class Coordonnee
        Friend Axe As Byte = 0
        Friend Value As Decimal
        Friend Property Text As String
            Get
                Dim Coordonnee() As Byte = Sexagesimal
                Dim EONS As String() = {"Nord", "Sud", "Est", "Ouest"}
               Return EONS(Axe) & ":" & Coordonnee(0) & "-" & Coordonnee(1) & "-" & Coordonnee(2)
            End Get
            Set(ByVal StV As String)
                Dim S() As String = StV.Split(":")
                Select Case S(0)
                    Case "Nord" : Axe = 0
                    Case "Sud" : Axe = 1
                    Case "Est" : Axe = 2
                    Case "Ouest" : Axe = 3
                End Select
                Dim St() As String = S(1).Split("-")
                Value = (3600 * St(0) + 60 * St(1) + St(2))
            End Set
        End Property
        Private Property Sexagesimal As Byte()
            Get
                Dim R() As Byte = {179, 59, 59}
                Dim temp() As Decimal = {0, 0, 0}
                temp(0) = Value / 3600
                temp(2) = Value Mod 3600
                temp(1) = R(2) / 60
                temp(2) = R(2) Mod 60
                R(0) = temp(0) : R(1) = temp(1) : R(2) = temp(2)
                Return R
            End Get
            Set(ByVal Coordonnee As Byte())
                Value = Coordonnee(0) * 3600 + Coordonnee(1) * 60 + Coordonnee(2)
            End Set
        End Property
    End Class

    Class Position
        Dim Nom As String = ""
        Friend Longitude As New Coordonnee
        Friend Latitude As New Coordonnee
        Function Plot(ByVal Ref As Referentiel, ByVal Repere As Size) As Point
            Dim R As Point
            R.X = (Longitude.Value + Ref.Est) * Repere.Width / Ref.Width
            R.Y = (Latitude.Value + Ref.Sud) * Repere.Height / Ref.Hight
            Return R
        End Function
        Friend Property Text As String
            Get
                Dim S As String
                S = Latitude.Text & "\" & Longitude.Text
                Return S
            End Get
            Set(ByVal StrPos As String)
                Dim S() As String = StrPos.Split("\")
                'verifie l'ordre Latitude longitude
                Dim T0() As String = {"nord", "sud", "north", "n"}
                Dim T1() As String = {"est", "ouest"}
                For i As Integer = 0 To 1
                    Dim S0 As String = S(i).Split(":")(0).Trim(" ").ToLower
                    If T0.Contains(S0) Then
                        Latitude.Text = S(i)
                    End If
                    If T1.Contains(S0) Then
                        Longitude.Text = S(i)
                    End If
                Next
            End Set
        End Property
    End Class

    Class Referentiel
        Dim OCoin As New Position
        Dim CoinZ As New Position
        Friend Nord As Integer
        Friend Sud As Integer
        Friend Est As Integer
        Friend Ouest As Integer
        Friend Hight As Integer
        Friend Width As Integer
        Private Sub Run()
            Nord = OCoin.Latitude.Value
            Sud = CoinZ.Latitude.Value
            Est = OCoin.Longitude.Value
            Ouest = CoinZ.Longitude.Value
            Hight = Nord + Sud
            Width = Est + Ouest
        End Sub
        Friend Sub init(ByVal A As Position, ByVal Z As Position)
            OCoin = A : CoinZ = Z
            Run()
        End Sub
        Sub New()
            OCoin.Text = "Nord:90-00-00\Ouest:180-00-00"
            CoinZ.Text = "Sud:90-00-00\Est:180-00-00"
            Run()
        End Sub
    End Class


End Module

Que je sauvegarde chez Codes_Sources en passant
Et que je sais pas combien de temps je vais continuer a fignoler
Car je change encore de pays ce Lundi.
J'en profite aussi pour faire un point des autre modules,
sachant que je place une carte du monde avec des méridiens et des parallèles bien parallèles en ressource.

Module Carte

    Class Plan_Geodesique
        Inherits PictureBox
        Friend Aire As New List(Of Position)
        Dim Ref As New Referentiel
        Sub TireLigne()
            If Aire.Count > 1 Then
                Dim P() As Integer = DernierTrait()
                Dim gr As Graphics = CreateGraphics()
                gr.DrawLine(Pens.Red, P(0), P(1), P(2), P(3))
            End If
        End Sub
        Friend Function DernierTrait() As Integer()
            Dim R(3) As Integer
            Dim O As Position = Aire.Item(Aire.Count - 2)
            Dim t As Position = Aire.Item(Aire.Count - 1)
            Dim Po As New Point : Po = O.Plot(Ref, Size)
            Dim Pt As New Point : Pt = t.Plot(Ref, Size)
            R(0) = Po.X
            R(1) = Po.Y
            R(2) = Pt.X
            R(3) = Pt.Y
            Return R
        End Function
        Sub SetPoint(ByVal e As MouseEventArgs)
            Dim C As New Position
            Dim P As New Point(e.X, e.Y)
            Dim Lo As Decimal = P.X * Ref.Width / Size.Width - Ref.Est
            Dim La As Decimal = P.Y * Ref.Hight / Size.Height - Ref.Sud
            If Lo < 0 Then C.Longitude.Axe = 3 Else C.Longitude.Axe = 2
            C.Longitude.Value = Math.Abs(Lo)
            If La < 0 Then C.Latitude.Axe = 0 Else C.Latitude.Axe = 1
            C.Latitude.Value = Math.Abs(La)
            Aire.Add(C)
        End Sub
        Function PrintLastPoint() As String
            If Aire.Count > 0 Then
                Dim C As New Position
                C = Aire.Item(Aire.Count - 1)
                Return C.Text
            Else : Return ""
            End If
        End Function
    End Class

    Class Planche_Geodesique
        Inherits SplitContainer
        Friend WithEvents Dessin As New Plan_Geodesique With {.Name = "Dessin", _
        .SizeMode = PictureBoxSizeMode.StretchImage, _
        .Image = Form1.Cadre.Image.Clone, _
        .Dock = DockStyle.Fill}
        Dim Info As New Label With {.Size = New Point(15, 17), _
        .Anchor = 13, _
        .Location = New System.Drawing.Point(5, 1)}
#Region "Events"
        Sub Plot(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Dessin.MouseClick
            Dessin.SetPoint(e)
            Info.Text = Dessin.PrintLastPoint
            Dessin.TireLigne()
        End Sub
#End Region
        Sub New()
            Name = "Panel"
            Dock = DockStyle.Fill
            ' Size = New Point(130, 110)
            SplitterDistance = 100
            Panel1.Controls.Add(Dessin)
            Panel2.Controls.Add(Info)
        End Sub
    End Class

    Class Duke
        Inherits Planche_Geodesique
#Region "DECLARE: Region"
        Private my_NewPoints As Integer = 0
        Private my_RegionId As Integer = 0
        Dim MesRegions() As MaRegion = Nothing
        Structure MaRegion
            Dim mr_Nom As String
            Dim mr_Path As System.Drawing.Drawing2D.GraphicsPath
        End Structure
        Private my_Points() As Point = Nothing
#End Region
#Region "Outils"
        Dim FlagTexttGP As New System.Windows.Forms.Label With {.Name = "FlagTextGP", _
        .AutoSize = True, _
        .Location = New System.Drawing.Point(5, 15), _
        .Size = New System.Drawing.Size(15, 17), _
        .TabIndex = 3, _
        .Text = "Aucun"}

        Dim txtNomGP As New System.Windows.Forms.TextBox With {.Name = "txtNomGP", _
               .Location = New System.Drawing.Point(5, 26), _
               .Size = New System.Drawing.Size(15, 22), _
               .Anchor = 15, _
               .TabIndex = 4}

        Dim ButtonAjouter As New System.Windows.Forms.Button With {.Name = "ButtonAjouter", _
           .Location = New System.Drawing.Point(5, 43), _
           .Size = New System.Drawing.Size(15, 20), _
           .TabIndex = 1, _
           .Text = "Ajouter", _
           .Anchor = 13, _
           .UseVisualStyleBackColor = True}

        Dim ButtonInit As New System.Windows.Forms.Button With {.Name = "ButtonInit", _
           .Location = New System.Drawing.Point(5, 60), _
           .Size = New System.Drawing.Size(15, 22), _
           .TabIndex = 1, _
           .Text = "Tout réinitialiser", _
           .Anchor = 13, _
          .UseVisualStyleBackColor = True}

        Dim ButtonClear As New System.Windows.Forms.Button With {.Name = "ButtonClear", _
          .Location = New System.Drawing.Point(5, 80), _
          .Size = New System.Drawing.Size(15, 20), _
          .TabIndex = 1, _
          .Text = "Nettoyer", _
          .Anchor = 13, _
          .UseVisualStyleBackColor = True}

        Dim RegionsListBox As New System.Windows.Forms.ListBox With {.Name = "RegionsListBox", _
                 .FormattingEnabled = True, _
                 .ItemHeight = 16, _
                 .Location = New System.Drawing.Point(5, 100), _
                 .Size = New System.Drawing.Size(15, 1), _
                 .Anchor = 15, _
                 .TabIndex = 3}

        Dim labTag As New System.Windows.Forms.Label With {.Name = "labTag", _
              .BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D, _
              .Font = New System.Drawing.Font("Microsoft Sans Serif", 12.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte)), _
              .ForeColor = System.Drawing.SystemColors.HotTrack, _
              .Location = New System.Drawing.Point(12, 601), _
               .Dock = DockStyle.Bottom, _
              .Size = New System.Drawing.Size(623, 30), _
              .TabIndex = 6, _
              .TextAlign = System.Drawing.ContentAlignment.MiddleCenter}

        Dim picTampon As New System.Windows.Forms.PictureBox With {.Name = "picTampon", _
            .Location = New System.Drawing.Point(12, 31), _
            .Size = New System.Drawing.Size(612, 567), _
            .TabIndex = 5, _
            .TabStop = False, _
            .Visible = False}
#End Region
        Private Sub DessinDetectable(ByVal pCoord As Point)
            If FlagTexttGP.Text <> "Aucun" Or
                MesRegions Is Nothing _
                Then Exit Sub

            Dim id As Integer
            For id = 0 To MesRegions.Length - 1
                If MesRegions(id).mr_Path.IsVisible(pCoord) = True Then
                    Me.labTag.Text = MesRegions(id).mr_Nom
                    Dessin.Cursor = Cursors.Hand
                    Exit For
                Else
                    Me.labTag.Text = ""
                    Dessin.Cursor = Cursors.Default
                End If
            Next
        End Sub
        Sub New()
            Panel2.Controls.Add(ButtonAjouter)
            Panel2.Controls.Add(ButtonInit)
            Panel2.Controls.Add(ButtonClear)
            Panel2.Controls.Add(txtNomGP)
            Panel2.Controls.Add(RegionsListBox)
            Panel2.Controls.Add(FlagTexttGP)
            Panel1.Controls.Add(labTag)
            picTampon.Image = DirectCast(Dessin.Image.Clone, Bitmap)

        End Sub
    End Class

End Module

Public Class Form1

    Dim MouseclickedDown As Boolean = False
    Dim Ouest As Byte = 170
    Dim Est As Byte = 190
    Dim Nord As Byte = 85
    Dim Sud As Byte = 70

    Private Sub Cadre_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Cadre.MouseDown
        Dim A As Integer = Ouest : A = (A + Est)
        Dim w As Integer = A * e.X / Cadre.Size.Width
        Label2.Text = w
        A = Nord : A = (A + Sud)
        Dim h As Integer = A * e.Y / Cadre.Size.Height
        Label1.Text = h
        MouseclickedDown = True
    End Sub

    Private Sub Cadre_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Cadre.MouseMove

    End Sub

    Private Sub Cadre_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Cadre.MouseUp
        MouseclickedDown = False
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim F As New Form
        Dim P As New Duke
        F.Size = New Point(500, 300)
        F.Controls.Add(P)
        F.StartPosition = FormStartPosition.CenterScreen
        F.Show()
    End Sub

End Class

Je sais pas quand je pourrais finir.
En tous cas, Merci Duke.

Discussions similaires

vectoriser un logo sous photoshop

création d'une Application Android

[Photoshop] : Image noir et blanc en image blanc et noir ?

initialisation du BITMAPINFO pour avoir une palette 256 couleurs!

générer une grille de mots mêlés

Votre réponse

Discussions similaires