0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

運転のログデータが活用できるようにしたい その3

Posted at

これまでの話

前回の記事はこちらです。

要点のみを記します。

  • 自作アプリの作るのに仕様検討する
    ・開発環境はVB.NET
    ・データの入出力はテキストのコピペやDataGridViewのコピペなど簡易な方法のみ
    ・データの保存はSQLServerとし、テーブルにMF-JSONのテキストで保存
    ・データの検索は位置的検索はSQLServerのgeography型でクエリを実行
    ・地図の表示、編集はOpenLayersで行う

  • VB.NETでOpenLayersが動く準備としてWebView2をテストし、成功

活用の準備(つづき)

VB.NETによる地図情報の表示、編集について(つづき)

次にOpenLayersを使って地図を表示するようにします。

1. 簡易Webサーバの構築

プロジェクトにクラスを追加して次のコードを貼り付ける。

SimpleWebSv.vb

Imports System.Net
Imports System.Net.Sockets

Public Class SimpleWebSv

    '' Webサーバで表示するファイルを登録する
    Private Class ClsFileItem
        Public FileBody As Byte()
        Public ContentType As String
        Public ContentEncoding As String
    End Class

    Private SrcFile As New SortedList(Of String, ClsFileItem)
    Private StartPath As String

    Public Shared Function GetRandomUnusedPort() As Integer
        Dim listener As New TcpListener(IPAddress.Loopback, 0)
        listener.Start()
        Dim port As Integer = CType(listener.LocalEndpoint, IPEndPoint).Port
        listener.Stop()
        Return port
    End Function

    Private Function ToPath(path As String) As String
        Return "/"c & path.TrimStart("/"c)
    End Function

    Private Sub CreateNewFile(adpath As String, body As Byte())
        Dim contenttype As String
        Select Case LCase(adpath.Split("."c).Last)
            Case "html", "htm", "shtml"
                contenttype = "text/html"
            Case "css"
                contenttype = "text/css"
            Case "xml"
                contenttype = "text/xml"
            Case "gif"
                contenttype = "image/ gif"
            Case "jpeg", "jpg"
                contenttype = "image/jpeg"
            Case "js"
                contenttype = "text/javascript"
            Case "atom"
                contenttype = "application/atom+xml"
            Case "rss"
                contenttype = "application/rss+xml"
            Case "mml"
                contenttype = "text/mathml"
            Case "txt"
                contenttype = "text/plain"
            Case "jad"
                contenttype = "text/vnd.sun.j2me.app-descriptor"
            Case "wml"
                contenttype = "text/vnd.wap.wml"
            Case "htc"
                contenttype = "text/x-component"
            Case "png"
                contenttype = "image/png"
            Case "svg", "svgz"
                contenttype = "image/svg+xml"
            Case "tif", "tiff"
                contenttype = "image/tiff"
            Case "wbmp"
                contenttype = "image/vnd.wap.wbmp"
            Case "webp"
                contenttype = "image/webp"
            Case "ico"
                contenttype = "image/x-icon"
            Case "jng"
                contenttype = "image/x-jng"
            Case "bmp"
                contenttype = "image/x-ms-bmp"
            Case "woff"
                contenttype = "font/woff"
            Case "woff2"
                contenttype = "font/woff2"
            Case "jar", "war", "ear"
                contenttype = "application/java-archive"
            Case "json"
                contenttype = "application/json"
            Case "hqx"
                contenttype = "application/mac-binhex40"
            Case "doc"
                contenttype = "application/msword"
            Case "pdf"
                contenttype = "application/pdf"
            Case "ps", "eps", "ai"
                contenttype = "application/postscript"
            Case "rtf"
                contenttype = "application/rtf"
            Case "m3u8"
                contenttype = "application/vnd.apple.mpegurl"
            Case "kml"
                contenttype = "application/vnd.google-earth.kml+xml"
            Case "kmz"
                contenttype = "application/vnd.google-earth.kmz"
            Case "xls"
                contenttype = "application/vnd.ms-excel"
            Case "eot"
                contenttype = "application/vnd.ms-fontobject"
            Case "ppt"
                contenttype = "application/vnd.ms-powerpoint"
            Case "odg"
                contenttype = "application/vnd.oasis.opendocument.graphics"
            Case "odp"
                contenttype = "application/vnd.oasis.opendocument.presentation"
            Case Else
                contenttype = "application/octet-stream"
        End Select

        Dim value = New ClsFileItem With {
            .FileBody = body,
            .ContentType = contenttype
        }
        If value.ContentType.StartsWith("text/") Then
            value.ContentEncoding = "utf-8"
        End If
        SrcFile.Add(adpath, value)
    End Sub

    Public Property SourceFile(path As String) As Byte()
        Get
            If Not SrcFile.ContainsKey(ToPath(path)) Then
                Return {}
            End If
            Return SrcFile.Item(ToPath(path)).FileBody
        End Get
        Set(value As Byte())
            If SrcFile.ContainsKey(ToPath(path)) Then
                SrcFile.Item(ToPath(path)).FileBody = value
            Else
                CreateNewFile(ToPath(path), value)
            End If
        End Set
    End Property

    Public Property ContentType(path As String) As String
        Get
            If Not SrcFile.ContainsKey(ToPath(path)) Then
                Return String.Empty
            End If
            Return SrcFile.Item(ToPath(path)).ContentType
        End Get
        Set(value As String)
            If SrcFile.ContainsKey(ToPath(path)) Then
                SrcFile.Item(ToPath(path)).ContentType = value
            Else
                Throw New Exception("Pathが見つかりません")
            End If
        End Set
    End Property

    Public Property ContentEncoding(path As String) As String
        Get
            If Not SrcFile.ContainsKey(ToPath(path)) Then
                Return String.Empty
            End If
            Return SrcFile.Item(ToPath(path)).ContentEncoding
        End Get
        Set(value As String)
            If SrcFile.ContainsKey(ToPath(path)) Then
                SrcFile.Item(ToPath(path)).ContentEncoding = value
            Else
                Throw New Exception("Pathが見つかりません")
            End If
        End Set
    End Property

    Public Sub SetStartPath(path As String)
        If SrcFile.ContainsKey(ToPath(path)) Then
            StartPath = ToPath(path)
        Else
            Throw New Exception("未登録のパスを指定しました")
        End If
    End Sub

    Public ReadOnly Property WebStartURL As String
        Get
            Return PortPrefix.TrimEnd("/"c) & StartPath
        End Get
    End Property

    Private ServerStarted As Boolean = False
    Private PortListener As HttpListener
    Private disposedValue As Boolean
    Private ServerTask As Task
    Private Const PortPrefixTemplate As String = "http://127.0.0.1:{0}/"
    Private PortPrefix As String = String.Format(PortPrefixTemplate, 8080)

    Public Function ServerStart() As Boolean
        If ServerStarted Then
            Return False
        End If

        Dim TempPort As Integer = GetRandomUnusedPort()
        PortPrefix = String.Format(PortPrefixTemplate, TempPort)

        If ListenerStart(PortPrefix) = False Then
            Return False
        End If

        ServerWorkerRunningFlag = True
        ServerTask = Task.Run(AddressOf ServerWorker)
        Return True
    End Function

    Public Function ServerStop() As Boolean
        If Not ServerStarted Then
            Return False
        End If

        If ServerWorkerRunningFlag = True Then
            ServerWorkerRunningFlag = False
            ServerTask.Wait()
        End If

        If ListenerStop() = False Then
            Return False
        End If

        Return True
    End Function

    Private Function ListenerStart(prefix As String) As Boolean
        If Not HttpListener.IsSupported Then
            Throw New Exception("HttpListenerがサポートされていません")
        End If
        If prefix.Length = 0 Then
            Return False
        End If

        If PortListener IsNot Nothing Then
            Return False
        End If

        PortListener = New HttpListener
        PortListener.Prefixes.Add(prefix)

        PortListener.Start()

        Return True
    End Function

    Private Function ListenerStop() As Boolean
        Try
            PortListener.Stop()
        Catch e As Exception
            PortListener.Abort()
        End Try
        Return True
    End Function

    Private ServerWorkerRunningFlag As Boolean = False

    Private Sub ServerWorker()
        While ServerWorkerRunningFlag = True
            Dim context As HttpListenerContext = PortListener.GetContext
            Dim req As HttpListenerRequest = context.Request
            Dim res As HttpListenerResponse = context.Response

            Dim path As String = req.RawUrl
            If SrcFile.ContainsKey(ToPath(path)) Then
                With SrcFile.Item(ToPath(path))
                    Call SetResponseHeader(res)
                    res.ContentType = .ContentType
                    If .ContentEncoding <> "" Then
                        res.Headers.Add("Content-Encoding", .ContentEncoding)
                        'res.ContentEncoding = System.Text.Encoding.GetEncoding(.ContentEncoding)
                    End If
                    Dim buf As Byte() = .FileBody
                    res.ContentLength64 = buf.Length
                    res.OutputStream.Write(buf, 0, buf.Length)
                End With
            End If
            res.Close()
        End While
    End Sub

    Private Sub SetResponseHeader(res As HttpListenerResponse)
        With res.Headers
            .Add("Access-Control-Allow-Origin", "")
            .Add("Access-Control-Expose-Headers", "")
            .Add("Cross-Origin-Resource-Policy", "cross-origin")
        End With
    End Sub

End Class

2. WebBrowserClassの内容を差し替え

前の内容から次の内容に差し替える

WebBrowserClass.vb

Imports Microsoft.Web.WebView2

Public Class WebBrowserClass
    Private WithEvents ObjBrowser As WinForms.WebView2
    Private Structure StcModuleVar
        Public IsInitializationCompleted As Boolean
        Public IsNavigationCompleted As Boolean
        Public IsNavigating As Boolean
    End Structure
    Private mdl As StcModuleVar

    Public Sub New(obj As WinForms.WebView2)
        ObjBrowser = obj

        mdl.IsInitializationCompleted = False
        mdl.IsNavigationCompleted = False
        mdl.IsNavigating = False

        Call InitializeWebViewAsync()
    End Sub

    Public ReadOnly Property IsInitializationCompleted As Boolean
        Get
            Return mdl.IsInitializationCompleted
        End Get
    End Property

    Public ReadOnly Property IsNavigationCompleted As Boolean
        Get
            Return mdl.IsNavigationCompleted
        End Get
    End Property

    Public ReadOnly Property IsNavigating As Boolean
        Get
            Return mdl.IsNavigating
        End Get
    End Property

    ''' <summary>
    ''' ブラウザのサイト移動を行う
    ''' </summary>
    ''' <param name="url">移動先のURL</param>
    Public Sub Navigate(url As String)
        If mdl.IsInitializationCompleted = False Then
            Throw New Exception("初期化が完了していません")
        End If

        mdl.IsInitializationCompleted = False
        mdl.IsNavigating = True

        ObjBrowser.CoreWebView2.Navigate(url)
    End Sub

    ''' <summary>
    ''' ブラウザ上で指定した文字列のjavascriptを実行する
    ''' </summary>
    ''' <param name="command">javascript文字列</param>
    ''' <returns></returns>
    Public Async Function ExecuteCommandAsync(command As String) As Task(Of String)
        Dim ans As String = Await ObjBrowser.ExecuteScriptAsync(command)
        Return ans
    End Function

#Region "ナビゲーション処理"

    Public Event NavigationStarting(e As NavigationStartingEventArgs)
    Public Event NavigationCompleted(e As NavigationCompletedEventArgs)

    Public Class NavigationCompletedEventArgs
        Inherits EventArgs

        Public ReadOnly Property IsSuccess As Boolean
        Public ReadOnly Property HttpStatusCode As Integer

        Public Sub New(IsSuccess As Boolean, HttpStatusCode As Integer)
            Me.IsSuccess = IsSuccess
            Me.HttpStatusCode = HttpStatusCode
        End Sub

    End Class

    Public Class NavigationStartingEventArgs
        Inherits EventArgs

        Public ReadOnly Property URI As String

        Public Property Cancel As Boolean = False

        Public Sub New(URI As String)
            Me.URI = URI
        End Sub

    End Class

    Protected Friend Sub OnNavigationCompleted(e As NavigationCompletedEventArgs)
        RaiseEvent NavigationCompleted(e)
    End Sub

    Protected Friend Sub OnNavigationStarting(e As NavigationStartingEventArgs)
        RaiseEvent NavigationStarting(e)
    End Sub

    Private Sub ObjBrowser_NavigationCompleted(sender As Object, e As Core.CoreWebView2NavigationCompletedEventArgs) Handles ObjBrowser.NavigationCompleted
        mdl.IsNavigating = False
        mdl.IsNavigationCompleted = True
        Call OnNavigationCompleted(New NavigationCompletedEventArgs(IsSuccess:=e.IsSuccess, HttpStatusCode:=e.HttpStatusCode))
    End Sub

    Private Sub ObjBrowser_NavigationStarting(sender As Object, e As Core.CoreWebView2NavigationStartingEventArgs) Handles ObjBrowser.NavigationStarting
        mdl.IsNavigationCompleted = False
        mdl.IsNavigating = True
        Dim arge As New NavigationStartingEventArgs(URI:=e.Uri)
        Call OnNavigationStarting(arge)
        e.Cancel = arge.Cancel
    End Sub
#End Region

#Region "ブラウザオブジェクトの初期化処理"
    ''' <summary>
    ''' ブラウザオブジェクトの初期化開始
    ''' </summary>
    Private Async Sub InitializeWebViewAsync()
        Dim tempDir As String = IO.Path.Combine(IO.Path.GetTempPath(), My.Application.Info.AssemblyName)
        Dim env As Core.CoreWebView2Environment = Core.CoreWebView2Environment.CreateAsync(
            browserExecutableFolder:=Nothing,
            userDataFolder:=tempDir,
            options:=Nothing
        ).Result
        Await ObjBrowser.EnsureCoreWebView2Async(env)
    End Sub

    ''イベント定義
    Public Event InitializationCompleted(e As InitializationCompletedEventArgs)

    ''イベント引数の定義
    Public Class InitializationCompletedEventArgs
        Inherits EventArgs

        Public ReadOnly InitializationSuccess As Boolean

        Public Sub New(isSuccess As Boolean)
            InitializationSuccess = isSuccess
        End Sub
    End Class

    Protected Friend Sub OnInitializeCompleted(isSuccess As Boolean)
        RaiseEvent InitializationCompleted(New InitializationCompletedEventArgs(isSuccess:=isSuccess))
    End Sub

    Private Sub ObjBrowser_CoreWebView2InitializationCompleted(sender As Object, e As Core.CoreWebView2InitializationCompletedEventArgs) Handles ObjBrowser.CoreWebView2InitializationCompleted
        mdl.IsInitializationCompleted = e.IsSuccess
        Call OnInitializeCompleted(e.IsSuccess)
    End Sub
#End Region

#Region "ブラウザからの受信メッセージ処理"
    ''イベント定義
    Public Event BrowserMessageReceived(e As BrowserMessageReceivedEventArgs)

    ''イベント引数の定義
    Public Class BrowserMessageReceivedEventArgs
        Inherits EventArgs

        Public ReadOnly Message As String

        Public Sub New(msg As String)
            Message = msg
        End Sub

    End Class

    ''ブラウザメッセージ受信処理
    Protected Friend Sub OnBrowserMessageReceived(message As String)
        RaiseEvent BrowserMessageReceived(New BrowserMessageReceivedEventArgs(message))
    End Sub


    Private Sub ObjBrowser_WebMessageReceived(sender As Object, e As Core.CoreWebView2WebMessageReceivedEventArgs) Handles ObjBrowser.WebMessageReceived
        Dim text As String = e.TryGetWebMessageAsString()
        Call OnBrowserMessageReceived(text)
    End Sub
#End Region

End Class

3. プロジェクトにAssetsフォルダを作成し、その中に次のファイルを保存

index_html.html

<!DOCTYPE html>
<html lang='ja'>
<head>
    <meta charset='UTF-8' />
    <title>地図表示</title>
    <meta name="description" content="地図表示のサンプル" />
    <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/ol@v7.1.0/ol.css" type="text/css" />
    <script src="https://cdn.jsdelivr.net/npm/ol@v7.1.0/dist/ol.js"></script>
    <link rel="stylesheet" href="style_css.css" type="text/css" />
</head>
<body>
    <div id='map'></div>
    <script src="createmap_js.js"></script>
    <script src="drawitems_js.js"></script>
    <script src="detectclick_js.js"></script>
    <script>
        loadMap();
        setMarkerIconStyle();
        setLayer();
        setInteraction();
        entryMapEvent();
    </script>
</body>
</html>

style_css.css

body {
    margin: 0;
    padding: 0;
}

#map {
    position: absolute;
    top: 0;
    bottom: 0;
    width: 100%;
}

createmap_js.js
var __map = null;

function loadMap() {
    // 国土地理院
    var _stdLayer = new ol.layer.Tile({
        source: new ol.source.XYZ({
            url: 'https://cyberjapandata.gsi.go.jp/xyz/std/{z}/{x}/{y}.png',
            projection: "EPSG:3857"
        })
    });
    __map = new ol.Map({
        target: 'map',
        renderer: [
            'canvas',
            'dom'
        ],
        layers: [
            _stdLayer
        ],
        view: new ol.View({
            projection: "EPSG:3857",
            center: ol.proj.transform([139.745433, 35.658581], "EPSG:4326", "EPSG:3857"),
            maxZoom: 18,
            zoom: 15
        })
    });
};

drawitems_js.js

// マップ上に点を追加

var __featureIconStyle = null;
var __featureLayer = null;
var __dragInteraction = null;

function setMarkerIconStyle() {
    if (__featureIconStyle === null) {
        __featureIconStyle = {};
        __featureIconStyle.defaultMarker = new ol.style.Style({
            image: new ol.style.Icon({
                anchor: [0.5, 46],
                anchorXUnits: 'fraction',
                anchorYUnits: 'pixels',
                src: 'https://openlayers.org/en/latest/examples/data/icon.png'
            })
        });
    };
};

function setLayer() {
    if (__featureLayer === null) {
        //ベクタレイヤの追加
        __featureLayer = new ol.layer.Vector({
            source: new ol.source.Vector()
        });
        __map.addLayer(__featureLayer);
    };
};

function setInteraction() {
    if (__dragInteraction === null) {
        __dragInteraction = new ol.interaction.Translate();
        __map.addInteraction(__dragInteraction);
    };
};

function insertMarkerOnMap(uid, lon, lat) {
    var f = new ol.Feature(new ol.geom.Point(ol.proj.transform([lon, lat], 'EPSG:4326', 'EPSG:3857')));
    f.setStyle(__featureIconStyle.defaultMarker);
    f.setId(uid);
    __featureLayer.getSource().addFeature(f);
};

function removeMarkerOnMap(uid) {
    var f = __featureLayer.getSource().getFeatureById(uid);
    if (f) {
        __featureLayer.getSource().removeFeature(f);
    };
};

detectclick_js.js

function entryMapEvent() {
    __map.on('click', function (e) {
        var message = null;
        var feature = __map.forEachFeatureAtPixel(e.pixel,
            function (feature) {
                return feature;
            });
        if (feature) {
            var lonlat = feature.getGeometry().getCoordinates();
            var uid = feature.getId();
            message = {
                "Type": "EventMessage",
                "Command": "FeatureClicked",
                "Parameters": [
                    {
                        "Name": "Uid",
                        "Value": uid
                    },
                    {
                        "Name": "Longitude",
                        "Value": String(lonlat[0])
                    },
                    {
                        "Name": "Latitude",
                        "Value": String(lonlat[1])
                    }
                ]
            };

        } else {
            const lonlat = ol.proj.transform(e.coordinate, 'EPSG:3857', 'EPSG:4326');
            message = {
                "Type": "EventMessage",
                "Command": "MapClicked",
                "Parameters": [
                    {
                        "Name": "Longitude",
                        "Value": String(lonlat[0])
                    },
                    {
                        "Name": "Latitude",
                        "Value": String(lonlat[1])
                    }
                ]
            };
        };

        window.chrome.webview.postMessage(JSON.stringify([message]));
    });
    
    __dragInteraction.on('translateend', function (e) {
        var features = [];
        e.features.forEach(function (b) {
            var coord = b.getGeometry().getCoordinates();
            features.push(
                {
                    "uid": b.getId(),
                    "coordinates": ol.proj.transform(coord, 'EPSG:3857', 'EPSG:4326')
                }
            );
        });
        if (features.length>0) {
            var messages = [];
            for (var i = 0; i < features.length; i++) {
                messages.push(
                    {
                        "Type": "EventMessage",
                        "Command": "FeatureDragged",
                        "Parameters": [
                            {
                                "Name": "Uid",
                                "Value": features[i].uid
                            },
                            {
                                "Name": "Longitude",
                                "Value": String(features[i].coordinates[0])
                            },
                            {
                                "Name": "Latitude",
                                "Value": String(features[i].coordinates[1])
                            }
                        ]
                    }
                );
            };
            window.chrome.webview.postMessage(JSON.stringify(messages));
        };
    });
};

4. Assetsフォルダに保存した次のファイルはプロジェクトのリソースに貼り付ける。

種類 ファイル名 リソース名
ウェブページ本体 index_html.html index_html
スタイル設定 style_css.css style_css
地図作成スクリプト createmap_js.js createmap_js
マーカー描画スクリプト drawitems_js.js drawitems_js
クリック検出スクリプト detectclick_js.js detectclick_js

5. プロジェクトにDataSetを追加し、DataTableを作成

DataSetを開いて、右クリックしDataTableを追加する。
名前はT_Featureとする。

列は次の内容となるよう追加、変更する。

列名 データタイプ
No System.Int32
UID System.GUID
Latitude System.Decimal
Longitude System.Decimal

6. フォームにWebView2コントロールとDataGridViewコントロールを貼り付け

DataGridViewコントロールはプロパティでDataSourceをDataSet1、DataMemberをT_Featureに設定する

7. フォームに次のコードを貼り付け

FrmMain.vb

Public Class FrmMain
    Private Sv As SimpleWebSv
    Private WithEvents Br As WebBrowserClass

    Private Sub FrmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
        Sv = New SimpleWebSv()
        Br = New WebBrowserClass(Me.WebView21)

        Sv.SourceFile("index_html.html") = ConvBytes(My.Resources.index_html)
        Sv.SourceFile("style_css.css") = ConvBytes(My.Resources.style_css)
        Sv.SourceFile("createmap_js.js") = ConvBytes(My.Resources.createmap_js)
        Sv.SourceFile("drawitems_js.js") = ConvBytes(My.Resources.drawitems_js)
        Sv.SourceFile("detectclick_js.js") = ConvBytes(My.Resources.detectclick_js)
        Sv.SetStartPath("index_html.html")
        Sv.ServerStart()
    End Sub

    Private Sub FrmMain_Closed(sender As Object, e As EventArgs) Handles Me.Closed
        Sv.ServerStop()
    End Sub

    Private Sub Br_InitializationCompleted(e As WebBrowserClass.InitializationCompletedEventArgs) Handles Br.InitializationCompleted
        Br.Navigate(Sv.WebStartURL)
    End Sub

    Public Class ArgJS
        Public Class ParameterItem
            Public Name As String
            Public Value As String
        End Class

        Public [Type] As String
        Public Command As String
        Public Parameters As List(Of ParameterItem)
    End Class

    Private Sub Br_BrowserMessageReceived(e As WebBrowserClass.BrowserMessageReceivedEventArgs) Handles Br.BrowserMessageReceived
        Try
            Dim jsonObj As List(Of ArgJS) = Newtonsoft.Json.JsonConvert.DeserializeObject(Of List(Of ArgJS))(e.Message)
            If jsonObj IsNot Nothing Then
                For Each jsonEach As ArgJS In jsonObj
                    If jsonEach.Type = "EventMessage" Then
                        Call ProcessMessage(jsonEach)
                    End If
                Next
            End If
        Catch
        End Try
    End Sub

    Private Sub ProcessMessage(arg As ArgJS)
        Select Case arg.Command
            Case "MapClicked"
                Dim Lat As Decimal
                Dim Lon As Decimal
                For Each item As ArgJS.ParameterItem In arg.Parameters
                    Select Case LCase(item.Name)
                        Case "longitude", "lon"
                            Lon = Decimal.Parse(item.Value)
                        Case "latitude", "lat"
                            Lat = Decimal.Parse(item.Value)
                    End Select
                Next
                Dim uid As Guid = Guid.NewGuid
                Call AddRowOnTable(Uid:=uid, Longitude:=Lon, Latitude:=Lat)
                Call PlotMarker(Uid:=uid, Longitude:=Lon, Latitude:=Lat)

            Case "FeatureClicked"
                Dim Uid As Guid
                Dim Lat As Decimal
                Dim Lon As Decimal
                For Each item As ArgJS.ParameterItem In arg.Parameters
                    Select Case LCase(item.Name)
                        Case "uid"
                            Uid = New Guid(item.Value)
                        Case "longitude", "lon"
                            Lon = Decimal.Parse(item.Value)
                        Case "latitude", "lat"
                            Lat = Decimal.Parse(item.Value)
                    End Select
                Next
                Call SelectRowOnTable(Uid:=Uid)

            Case "FeatureDragged"
                Dim Uid As Guid
                Dim Lat As Decimal
                Dim Lon As Decimal
                For Each item As ArgJS.ParameterItem In arg.Parameters
                    Select Case LCase(item.Name)
                        Case "uid"
                            Uid = New Guid(item.Value)
                        Case "longitude", "lon"
                            Lon = Decimal.Parse(item.Value)
                        Case "latitude", "lat"
                            Lat = Decimal.Parse(item.Value)
                    End Select
                Next
                Call UpdateRowOnTable(Uid:=Uid, Longitude:=Lon, Latitude:=Lat)

        End Select
    End Sub

    Private Shared featureNo As Integer = 0

    Private Sub AddRowOnTable(Uid As Guid, Longitude As Decimal, Latitude As Decimal)
        For Each r As DataGridViewRow In Me.DataGridView1.Rows
            r.Selected = False
        Next

        Dim row As DataSet1.T_FeatureRow = Me.DataSet1.T_Feature.NewT_FeatureRow
        featureNo += 1
        row.No = featureNo
        row.UID = Uid
        row.Longitude = Longitude
        row.Latitude = Latitude
        Me.DataSet1.T_Feature.AddT_FeatureRow(row)

        Me.DataGridView1.Refresh()

    End Sub

    Private Sub UpdateRowOnTable(Uid As Guid, Longitude As Decimal, Latitude As Decimal)
        Dim row() As DataRow = Me.DataSet1.T_Feature.Select("Uid = '" & Uid.ToString() & "'")
        If row.Length = 1 Then
            With CType(row(0), DataSet1.T_FeatureRow)
                .Longitude = Longitude
                .Latitude = Latitude
            End With
            Me.DataGridView1.Refresh()
        End If
    End Sub

    Private Sub SelectRowOnTable(Uid As Guid)
        Dim uidIndex As Integer = Me.UIDDataGridViewTextBoxColumn.Index
        For Each row As DataGridViewRow In Me.DataGridView1.Rows
            If Uid.Equals(row.Cells(uidIndex).Value) Then
                row.Selected = True
            Else
                row.Selected = False
            End If
        Next
    End Sub

    Private Async Sub PlotMarker(Uid As Guid, Longitude As Decimal, Latitude As Decimal)
        Dim command As String = "insertMarkerOnMap('" & Uid.ToString() & "'," & Longitude.ToString() & "," & Latitude.ToString() & ")"
        Await Br.ExecuteCommandAsync(command)
    End Sub

    Private Async Sub RemoveMarker(Uid As Guid)
        Dim command As String = "removeMarkerOnMap('" & Uid.ToString() & "')"
        Await Br.ExecuteCommandAsync(command)
    End Sub

    Private Function ConvBytes(ByVal s As String) As Byte()
        Return System.Text.Encoding.UTF8.GetBytes(s)
    End Function

    Private Sub DataGridView1_UserDeletingRow(sender As Object, e As DataGridViewRowCancelEventArgs) Handles DataGridView1.UserDeletingRow
        Dim uidIndex As Integer = Me.UIDDataGridViewTextBoxColumn.Index
        Dim uid As Guid = CType(e.Row.Cells(uidIndex).Value, Guid)
        Call RemoveMarker(Uid:=uid)
    End Sub
End Class

8. 実行してみる
うまく動作したらDataGridViewと地図が表示されます。
その他の機能として、地図をクリックすると緑のマーカーがクリックした位置に追加され、DataGridViewに行が追加されます。
またマーカーをドラッグするとマーカーが移動し、DataGridViewの該当行の座標が更新されますし、DataGridViewの該当行を削除するとマーカーが削除されます。

これで、図形を地図に表示できるし、地図上の図形を削除できるし、地図上の図形をドラッグさせて移動できることが確認できました。
OpenLayersの使い方の練習はできたと判断します。

今回の記事でここまでで、続きは別の記事にしたいと思います。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?