2014年10月05日

[vb.net]地図に円を描くソフトウエアのコード 【その1】

地図に円を描くソフトウエアを公開しましたが、
このソフトウエアは、Visual Studio Express 2013 の VB.netで作成しています。
 
OpenなGISのこと】というブログに、vb.netでOpenLayersを表示できる方法が記載されており、
「こんなことができるんだ」と思ったのがきっかけです。
先人の知恵には本当に感謝します。
 
で、わたしもコードが公開されていたことに大変助けられたので、
地図で円を描く(Map円Edit)」ソフトウエアのコードを書き残しておこうと思います。
まあ、自分用のメモでもあるのですが。
 
「Map円Edit」のメインフォームは以下のようになっています。
Image 2014_10_04_013132.jpg
 
上部に地図の切り替えを行うラジオボタン、地図の中心の緯度経度を表示するテキストボックがあります。
その下には、円を作成するときに設定するテキストボックスと、KMLを作成するためのボタンがあります。
 
そして、WebBrowserコントロールが真ん中にあり、
その下に、ステータスバーを配置して、ラベルでマウスのある緯度経度を表示しています。
画像では見えませんが、円を描画した時の座標を記録しておくリストボックを
非表示で配置してあります。
 
フォームの名称は「F_地図表示」、WebBrowserコントロールの名称は「Web_地図表示」です。
まずは、フォームを表示するときのコードです。フォームのShownイベントに記載します。
フォームを表示したら、Radio_地理院地図のクリックイベントを実行して、
地理院地図を表示します。
  
Private Sub F_地図表示_Shown(sender As Object, e As EventArgs) Handles Me.Shown
        Try
      '地図の右クリックメニューを表示しない
            Me.Web_地図表示.IsWebBrowserContextMenuEnabled = False

            'はじめは地理院地図を表示する
            Radio_地理院地図.Checked = True
            Radio_地理院地図.PerformClick() 'Radio_地理院地図のクリックイベントを実行

        Catch ex As Exception
            '例外処理でメッセージを表示
            MessageBox.Show("エラー発生(F_地図表示_Shown)" & vbCr & ex.Message, "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try End Sub
Radio_地理院地図ボタンのクリックイベントは以下のとおりです。
sub_Opnelayers表示」プロシージャを呼び出して、地図を表示します。
地図を表示する前に、WebBrowserコントロールのbjectForScriptingプロパティに
クラス(Cls_地図表示)のインスタンスを渡します。
これで、WebBrowserをクリックしたり、マウスを移動させた時のイベントをvb側に
渡すことができるようです。
Radio_OSMRadio_GoogleMapボタンのクリックイベントも
Radio_地理院地図と全く同じものを記載します。
 
    Private Sub Radio_地理院地図_Click(sender As Object, e As EventArgs) Handles Radio_地理院地図.Click
        Try
            If Radio_地理院地図.Checked Then
                sub_OpenLayers表示()
            End If
        Catch ex As Exception
            MessageBox.Show("エラー発生(Radio_地理院地図_Click)" & vbCr & ex.Message, "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

    Sub sub_OpenLayers表示()
        'ObjectForScripting WebBrowser 
        'コントロールに表示されるWebページ内のスクリプトコードから
        'アクセスできるオブジェクトを取得または設定します。
        Web_地図表示.ObjectForScripting = New Cls_地図表示 'クラスのインスタンスを渡す

        '電子国土地図表示
        Dim lat As String = txt_緯度.Text
        Dim lng As String = txt_経度.Text

        Web_地図表示.DocumentText = sub_OpenLayers表示(Double.Parse(lat), Double.Parse(lng)) 'OpenLayersの表示
        '円をKMLファイルに保存するボタンを使用不可にしておく
        Butt_円のKML作成.Enabled = False

    End Sub
クラス(Cls_地図表示)の内容は以下のとおり
WebBrowserコントロールから呼び出したいイベントやメソッドを記載しておきます。
ここではCls_地図表示は、F_地図表示とは別のファイルに作成しています。
 
Imports System
Imports System.IO
Imports System.Text
Imports System.Web
Imports System.Xml
Imports System.Security.Permissions

<PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
<System.Runtime.InteropServices.ComVisibleAttribute(True)> _
Public Class Cls_地図表示
    Public Sub MouseClick(ByVal lat As Double, ByVal lng As Double)
    'マウスクリックイベント
    'マーカーをマウスの位置に表示する(STla_緯度、Stla_経度は、ステータスバーに配置した緯度経度のラベルの名称)
        F_地図表示.Web_地図表示.Document.InvokeScript("moveToPoint", _
                             {CDbl(F_地図表示.STLa_緯度.Text), _
                              CDbl(F_地図表示.StLa_経度.Text), _
                              CStr("")})

    '円をマウスの位置に表示する
        F_地図表示.Web_地図表示.Document.InvokeScript("makeCircle", _
                 {CDbl(F_地図表示.STLa_緯度.Text), _
                  CDbl(F_地図表示.StLa_経度.Text), _
              CDbl(F_地図表示.txt_円の半径.Text * 1000)})
    End Sub

    Public Sub MouseMove(ByVal lat As Double, ByVal lng As Double, ByVal myzoom As Integer)
        'マウス移動時のイベント
    'ステータスバーの緯度(STLa_緯度)経度(StLa_経度)にマウスの位置の座標を入力
    'ズームレベルをステータスバーのラベル(Stla_ズーム)に入力(地図を切り替えた時に同じズームレベルで表示するため)
        F_地図表示.STLa_緯度.Text = Format(lat, "###.######").ToString
        F_地図表示.StLa_経度.Text = Format(lng, "###.######").ToString
        F_地図表示.Stla_ズーム.Text = Format(myzoom, "#").ToString

    End Sub

    Public Sub MapDrag(ByVal lat As Double, ByVal lng As Double)
    'マップドラッグ時のイベント
    '地図を切り替えた時に同じ位置を表示するために、地図の中心位置をテキストボックに記録
        F_地図表示.txt_緯度.Text = Format(lat, "###.######").ToString
        F_地図表示.txt_経度.Text = Format(lng, "###.######").ToString
    End Sub

    Public Sub sub_リストクリア()
        'List_円の座標は非表示で配置されている。
    'kmlファイル作成時に使う座標のリストを記録している
    '円を新たに作成するときに値をクリアにするためのメソッド
    F_地図表示.List_円の座標.Items.Clear()
    End Sub
    Public Sub sub_円の座標登録(ByVal lat As Double, ByVal lng As Double)
    'List_円の座標に円の外側の頂点座標を記録するメソッド
        F_地図表示.Butt_円のKML作成.Enabled = True
        F_地図表示.List_円の座標.Items.Add(Format(lng, "###.######").ToString & "," & Format(lat, "###.######").ToString)
    End Sub

End Class
以下は、WebBrowserコントロール(web_地図表示)にOpenLayersを表示して、
各地図を呼び出すプロシージャです。 HTMLを文字列にして記入していきます。
 
Private Function sub_OpenLayers表示(ByRef lat As Double, ByRef lng As Double) As String
        'テキストボックスのバックカラーをhtml16進数に変換。円の色を設定すための準備
        Dim htmlColor As String = String.Format("#{0:X2}{1:X2}{2:X2}", txt_円の色.BackColor.R, txt_円の色.BackColor.G, txt_円の色.BackColor.B)
        
    Dim txtHtml As String = ""
        txtHtml = txtHtml & "‹html›" & vbCrLf
        txtHtml = txtHtml & "‹head›" & vbCrLf

        'チェックで地図を切り替え。地図によって呼び出すスクリプトを変える。
        If Radio_地理院地図.Checked = True Then
            txtHtml = txtHtml & "‹script src=""http://portal.cyberjapan.jp/sys/OpenLayers-current/OpenLayers.js""›‹/script›" & vbCrLf
    
        ElseIf Radio_OSM.Checked = True Then
            txtHtml = txtHtml & "‹script type=""text/javascript"" src=""http://openlayers.org/api/OpenLayers.js""›‹/script›" & vbCrLf
        
    ElseIf Radio_GoogleMap.Checked = True Then
            txtHtml = txtHtml & "‹script src=""http://openlayers.org/api/OpenLayers.js""›‹/script›" & vbCrLf
            txtHtml = txtHtml & "‹script src=""http://maps.google.co.jp/maps/api/js?v=3.5&sensor=false&language=ja""›‹/script›" & vbCrLf
        End If
    '地図表示用のスクリプト
        txtHtml = txtHtml & "‹script type=""text/javascript""›" & vbCrLf
    '共通で使用する変数の宣言
        txtHtml = txtHtml & "var map = null;" & vbCrLf
        txtHtml = txtHtml & "var markers = null;" & vbCrLf
        txtHtml = txtHtml & "var marker;" & vbCrLf
        txtHtml = txtHtml & "var layer_style; //ベクタレイヤのスタイル" & vbCrLf
        txtHtml = txtHtml & "var vectorLayer; //円を描くベクタレイヤ" & vbCrLf
        txtHtml = txtHtml & "var circle; //円のポリゴン" & vbCrLf
        txtHtml = txtHtml & "var polygonFeature = new OpenLayers.Feature.Vector();  //円のフューチャー" & vbCrLf
    '地図の表示位置
        txtHtml = txtHtml & "var initCX = " & lng.ToString.Trim & ";    //初期の経度" & vbCrLf
        txtHtml = txtHtml & "var initCY = " & lat.ToString.Trim & ";    //初期の緯度" & vbCrLf
        txtHtml = txtHtml & "var initZoomLv = " & Stla_ズーム.Text & ";    //初期のズームレベル" & vbCrLf
    '地図画像の座標参照系を指定
        txtHtml = txtHtml & "var projection3857 = new OpenLayers.Projection(""EPSG:3857"");     //真球メルカトル投影(電子国土WebシステムVer.4もこれに準拠)を定義" & vbCrLf
    '表示する座標参照系を指定
        txtHtml = txtHtml & "var projection4326 = new OpenLayers.Projection(""EPSG:4326"");     //等経緯度投影を定義" & vbCrLf
    '地図のプロパティを設定
        txtHtml = txtHtml & "function init(){" & vbCrLf
        txtHtml = txtHtml & "   var maxExtent = new OpenLayers.Bounds(-20037508, -20037508, 20037508, 20037508);    //真球メルカトル投影のときの最大範囲(単位はm)" & vbCrLf
        txtHtml = txtHtml & "   var restrictedExtent = maxExtent.clone();   //真球メルカトル投影のときの最大範囲に範囲を制限" & vbCrLf
        txtHtml = txtHtml & "   var maxResolution = 156543.0339;    //真球メルカトル投影のときの最大解像度" & vbCrLf

        txtHtml = txtHtml & "   //地図表示画面のオプション設定" & vbCrLf
        txtHtml = txtHtml & "   var options = {" & vbCrLf
        txtHtml = txtHtml & "   //「controls」を設定することで、デフォルトのコントロールを破棄してコントロールを再設定" & vbCrLf
        txtHtml = txtHtml & "       controls: [" & vbCrLf
        txtHtml = txtHtml & "           new OpenLayers.Control.Navigation({mouseWheelOptions: {interval: 100}}),    //地図マウスイベントのハンドル設定" & vbCrLf
        txtHtml = txtHtml & "           new OpenLayers.Control.PanZoomBar(),    //左上のパンズームバーを設定" & vbCrLf
        txtHtml = txtHtml & "           new OpenLayers.Control.KeyboardDefaults(),  //キーボードをデフォルトに設定" & vbCrLf
        txtHtml = txtHtml & "           new OpenLayers.Control.Attribution(),   //著作表示" & vbCrLf
        'txtHtml = txtHtml & "           new OpenLayers.Control.OverviewMap(), //縮小地図の表示" & vbCrLf
        txtHtml = txtHtml & "           new OpenLayers.Control.LayerSwitcher()      // ベースレイヤー切り替え" & vbCrLf
        txtHtml = txtHtml & "       ]," & vbCrLf
        txtHtml = txtHtml & "       projection: projection3857,   //背景地図の地理座標系" & vbCrLf
        txtHtml = txtHtml & "       displayProjection: projection4326,  //表示の地理座標系" & vbCrLf
        txtHtml = txtHtml & "       units: ""m"",   //背景地図の単位" & vbCrLf
        txtHtml = txtHtml & "       maxResolution: maxResolution,   //背景地図の最大解像度" & vbCrLf
        txtHtml = txtHtml & "       maxExtent: maxExtent,   //背景地図の最大範囲" & vbCrLf
        txtHtml = txtHtml & "       restrictedExtent: restrictedExtent  //背景地図の表示制限範囲" & vbCrLf
        txtHtml = txtHtml & "   };" & vbCrLf
        txtHtml = txtHtml & "   map = new OpenLayers.Map('map', options);   //OpenLayers APIのMapクラスからインスタンスを作成" & vbCrLf
        txtHtml = txtHtml & "   map.addControl(new OpenLayers.Control.ScaleLine({maxWidth:200,bottomOutUnits: """" , bottomInUnits: """" ,geodesic:true}));     //スケールバーコントロール表示(最大ピクセル150、下段単位無、EPSG:3857)" & vbCrLf
        'チェックで地図を切り替え
        If Radio_地理院地図.Checked = True Then
            '地理院地図の表示
      '参考URL 「地理院地図技術情報」http://portal.cyberjapan.jp/help/development/sample.html#sample-ol2131
            txtHtml = txtHtml & "   map.addLayer(new OpenLayers.Layer.XYZ(""標準地図""," & vbCrLf
            txtHtml = txtHtml & "   ""http://cyberjapandata.gsi.go.jp/xyz/std/${z}/${x}/${y}.png"", {" & vbCrLf
            txtHtml = txtHtml & "   attribution: ""‹a href='http://portal.cyberjapan.jp/help/termsofuse.html' target='_blank'›国土地理院‹/a›""," & vbCrLf
            txtHtml = txtHtml & "   maxZoomLevel: 17"
            txtHtml = txtHtml & "   }));"
            txtHtml = txtHtml & "   //初期の中心座標を指定(経緯度で入力して、内部的に真球メルカトル座標に変換して表示)" & vbCrLf
            txtHtml = txtHtml & "   map.setCenter(new OpenLayers.LonLat(initCX,initCY).transform(projection4326,projection3857), initZoomLv); //地図の座標変換" & vbCrLf
        ElseIf Radio_OSM.Checked = True Then
      'OpenStreetMapの表示
            txtHtml = txtHtml & "   var mapnik = new OpenLayers.Layer.OSM(); //OprnStreetMapを表示する場合" & vbCrLf
            txtHtml = txtHtml & "   map.addLayer(mapnik);" & vbCrLf
            txtHtml = txtHtml & "   //初期の中心座標を指定(経緯度で入力して、内部的に真球メルカトル座標に変換して表示)" & vbCrLf
            txtHtml = txtHtml & "   map.setCenter(new OpenLayers.LonLat(initCX,initCY).transform(projection4326,projection3857), initZoomLv);" & vbCrLf
        ElseIf Radio_GoogleMap.Checked = True Then
            'GoogleMapの表示
      txtHtml = txtHtml & "   var mapCenterLatLng = new OpenLayers.LonLat(initCX, initCY); " & vbCrLf
            txtHtml = txtHtml & "   var gmap_terrain = new OpenLayers.Layer.Google(" & vbCrLf
            txtHtml = txtHtml & "       ""Google TERRAIN""," & vbCrLf
            txtHtml = txtHtml & "       {type: google.maps.MapTypeId.TERRAIN}" & vbCrLf
            txtHtml = txtHtml & "   );" & vbCrLf
            txtHtml = txtHtml & "   var gmap = new OpenLayers.Layer.Google(" & vbCrLf
            txtHtml = txtHtml & "       ""Google ROADMAP"", // the default" & vbCrLf
            txtHtml = txtHtml & "       {numZoomLevels: 20}" & vbCrLf
            txtHtml = txtHtml & "   );" & vbCrLf
            txtHtml = txtHtml & "   var gmap_hybrid = new OpenLayers.Layer.Google(" & vbCrLf
            txtHtml = txtHtml & "       ""Google HYBRID""," & vbCrLf
            txtHtml = txtHtml & "       {type: google.maps.MapTypeId.HYBRID, numZoomLevels: 20}" & vbCrLf
            txtHtml = txtHtml & "   );" & vbCrLf
            txtHtml = txtHtml & "   var gmap_satellite = new OpenLayers.Layer.Google(" & vbCrLf
            txtHtml = txtHtml & "       ""Google SATELLITE""," & vbCrLf
            txtHtml = txtHtml & "       {type: google.maps.MapTypeId.SATELLITE, numZoomLevels: 22}" & vbCrLf
            txtHtml = txtHtml & "   );" & vbCrLf
            txtHtml = txtHtml & "   map.addLayers( [ gmap, gmap_terrain, gmap_hybrid, gmap_satellite] );" & vbCrLf
            txtHtml = txtHtml & "   // Google.v3 uses EPSG:3857 as projection, so we have to" & vbCrLf
            txtHtml = txtHtml & "   // transform our coordinates" & vbCrLf
            txtHtml = txtHtml & "   var projection = new OpenLayers.Projection(""EPSG:4326"");" & vbCrLf
            txtHtml = txtHtml & "   var mapCenterGoogle =  mapCenterLatLng.transform( projection, map.getProjectionObject() );" & vbCrLf
            txtHtml = txtHtml & "   map.setCenter( mapCenterGoogle, initZoomLv );" & vbCrLf
        End If
        '円を格納するレイヤを作成
        txtHtml = txtHtml & "   //円レイヤを生成" & vbCrLf
        txtHtml = txtHtml & "   layer_style = OpenLayers.Util.extend({}, OpenLayers.Feature.Vector.style['default']);" & vbCrLf
        txtHtml = txtHtml & "   vectorLayer = new OpenLayers.Layer.Vector(""円"", {style: layer_style});" & vbCrLf
        txtHtml = txtHtml & "   map.addLayer(vectorLayer);" & vbCrLf

        txtHtml = txtHtml & "   // Styleの設定" & vbCrLf
        txtHtml = txtHtml & "   var styleMap = new OpenLayers.StyleMap(OpenLayers.Util.applyDefaults(" & vbCrLf
        txtHtml = txtHtml & "       {fillColor: ""green"", fillOpacity: 1, strokeColor: ""black""}," & vbCrLf
        txtHtml = txtHtml & "       OpenLayers.Feature.Vector.style[""default""]" & vbCrLf
        txtHtml = txtHtml & "   ));" & vbCrLf
    
    'イベントの登録
        txtHtml = txtHtml & "   // Mapにクリックイベントを登録" & vbCrLf
        txtHtml = txtHtml & "   map.events.register('click', map, onMouseClick);" & vbCrLf
        txtHtml = txtHtml & "   map.events.register('mousemove', map, onMouseMove);" & vbCrLf
        txtHtml = txtHtml & "   markers = new OpenLayers.Layer.Markers( ""Markers"" );" & vbCrLf
        txtHtml = txtHtml & "   map.addLayer(markers);" & vbCrLf
        txtHtml = txtHtml & "}" & vbCrLf

        txtHtml = txtHtml & "// mouseclickイベント" & vbCrLf
        txtHtml = txtHtml & "function onMouseClick(evt) {" & vbCrLf
        txtHtml = txtHtml & "   // クリック地点の座標を取得" & vbCrLf
        txtHtml = txtHtml & "   var lonlat = map.getLonLatFromViewPortPx(evt.xy);" & vbCrLf
        txtHtml = txtHtml & "   // 地図座標に変換" & vbCrLf
        txtHtml = txtHtml & "   lonlat.transform(projection3857, projection4326);" & vbCrLf
        '.NETのSubroutineを呼び出す。
        txtHtml = txtHtml & "   window.external.MouseClick(lonlat.lat, lonlat.lon);" & vbCrLf
        txtHtml = txtHtml & "}" & vbCrLf

        txtHtml = txtHtml & "// mousemoveイベント" & vbCrLf
        txtHtml = txtHtml & "function onMouseMove(evt) {" & vbCrLf
        txtHtml = txtHtml & "   var lonlat = map.getLonLatFromViewPortPx(evt.xy);" & vbCrLf
        txtHtml = txtHtml & "   var zoom = map.getZoom();" & vbCrLf 'ズームレベルを取得
        txtHtml = txtHtml & "   // 地図座標に変換" & vbCrLf
        txtHtml = txtHtml & "   lonlat.transform(projection3857, projection4326);" & vbCrLf
        '.NETのSubroutineを呼び出す。
        txtHtml = txtHtml & "   window.external.MouseMove(lonlat.lat, lonlat.lon, zoom);" & vbCrLf
        '地図のセンターの座標を取得し、テキストボックスに入力する
        txtHtml = txtHtml & "   var slonlat = map.getCenter();" & vbCrLf
        txtHtml = txtHtml & "   slonlat.transform(projection3857, projection4326);" & vbCrLf
        txtHtml = txtHtml & "   window.external.MapDrag(slonlat.lat, slonlat.lon);" & vbCrLf

        txtHtml = txtHtml & "}" & vbCrLf

        'Markerの描画
        txtHtml = txtHtml & "// mousemoveイベント" & vbCrLf
        txtHtml = txtHtml & "function moveToPoint(Lat, Lng, strTitle) {" & vbCrLf
        txtHtml = txtHtml & "   var lonlat = new OpenLayers.LonLat(Lng,Lat).transform(projection4326,projection3857);" & vbCrLf
        txtHtml = txtHtml & "   map.setCenter(lonlat);" & vbCrLf
        txtHtml = txtHtml & "   // markerの描画" & vbCrLf
        txtHtml = txtHtml & "   markers.removeMarker(marker);" & vbCrLf '既にあるマーカーを削除
        txtHtml = txtHtml & "   marker = new OpenLayers.Marker(lonlat);" & vbCrLf
        txtHtml = txtHtml & "   markers.addMarker(marker);" & vbCrLf
        txtHtml = txtHtml & "}" & vbCrLf

        '円のポイントを計算して、ポリゴンで描画
        '参考にしたサイト 「KERNEL BLOG II」 http://mng.seedcollector.net/blog/?p=244
        '              「Debianでka-Mapのメモ」 http://nobmob.blogspot.jp/2009/03/openlayers-17a.html

        txtHtml = txtHtml & "   function makeCircle(Lat, Lng, radius){" & vbCrLf
        txtHtml = txtHtml & "       window.external.sub_リストクリア();   //フォームのリストクリア" & vbCrLf

        txtHtml = txtHtml & "       vectorLayer.removeFeatures(polygonFeature);" & vbCrLf
        txtHtml = txtHtml & "       //円のスタイル設定" & vbCrLf
        txtHtml = txtHtml & "       var style_circle = {" & vbCrLf
        txtHtml = txtHtml & "           strokeColor: """ & htmlColor & """," & vbCrLf
        txtHtml = txtHtml & "           fillColor: """ & htmlColor & """," & vbCrLf
        txtHtml = txtHtml & "           fillOpacity: " & txt_透明度.Text / 100 & ",    // 内側の透明度" & vbCrLf
        txtHtml = txtHtml & "           strokeWidth: 2 // 外周の太さ" & vbCrLf
        txtHtml = txtHtml & "       };" & vbCrLf
        txtHtml = txtHtml & "       var apex = 360;  //多角形の頂点の数" & vbCrLf
        txtHtml = txtHtml & "       var lonlat = new OpenLayers.LonLat(Lng,Lat);    //中心の座標(緯度経度)" & vbCrLf
        txtHtml = txtHtml & "       var angle;  //中心点から頂点への角度" & vbCrLf
        txtHtml = txtHtml & "       var new_lonlat; //頂点の座標(緯度経度)" & vbCrLf
        txtHtml = txtHtml & "       var pointList = []; //ポリゴン用のポイントのリスト" & vbCrLf
        txtHtml = txtHtml & "       for (var i = 0; i ‹ apex+1; i++) {  //頂点の数分繰り返す(最後ははじめの点に戻る)" & vbCrLf
        txtHtml = txtHtml & "           angle = (i * 360 / apex) + 0;   //角度の計算" & vbCrLf
        txtHtml = txtHtml & "           new_lonlat = OpenLayers.Util.destinationVincenty(lonlat, angle, radius);    //頂点の座標を計算(緯度経度)" & vbCrLf
        txtHtml = txtHtml & "           window.external.sub_円の座標登録(new_lonlat.lat, new_lonlat.lon); //フォームのListBoxに座標を登録" & vbCrLf

        txtHtml = txtHtml & "           var newPoint = new OpenLayers.Geometry.Point(new_lonlat.lon, new_lonlat.lat);   //頂点をポイントとして登録" & vbCrLf
        txtHtml = txtHtml & "           pointList.push(newPoint);   //ポイントリストにポイントを入れる" & vbCrLf
        txtHtml = txtHtml & "       };" & vbCrLf
        txtHtml = txtHtml & "       var linearRing = new OpenLayers.Geometry.LinearRing(pointList); //ポイントリストからポリゴンを作成" & vbCrLf
        txtHtml = txtHtml & "       linearRing.transform(projection4326, projection3857); //地図の座標系に変換" & vbCrLf
        txtHtml = txtHtml & "       polygonFeature = new OpenLayers.Feature.Vector(" & vbCrLf
        txtHtml = txtHtml & "           new OpenLayers.Geometry.Polygon([linearRing]), null, style_circle); //円のポリゴンを作成" & vbCrLf
        txtHtml = txtHtml & "       vectorLayer.addFeatures([polygonFeature]);  //レイヤに追加" & vbCrLf
        txtHtml = txtHtml & "   }" & vbCrLf

        txtHtml = txtHtml & "‹/script›" & vbCrLf
        txtHtml = txtHtml & "‹/head›" & vbCrLf

        txtHtml = txtHtml & "‹body onload=""init();""›" & vbCrLf
    
    '地図の表示範囲を設定
        txtHtml = txtHtml & "‹div id=""map"" name=""map"" style=""width:100%; height:98%;""›‹/div›" & vbCrLf
        txtHtml = txtHtml & "‹/body›" & vbCrLf
        txtHtml = txtHtml & "‹/html›" & vbCrLf

        sub_OpenLayers表示 = txtHtml

    End Function
イベント部分に記載していある「window.external」で、
WebBrowserコントロールの「.ObjectForScripting」プロパティに設定した
クラス(Cls_地図表示)内のイベントやメソッドを呼び出して実行することができます。
 
次回は、円をkmlファイルに保存する部分を書きたいと思います。
つづく→【その2】
posted by kouichi at 01:04| Comment(0) | vb.net | このブログの読者になる | 更新情報をチェックする

2014年10月04日

地図に円を描くソフトウエアを作成しました

地図を表示して、そこに任意の大きさの円を描画し、
その円をKMLとして保存するソフトウエアを作成しました。


Image 2014_10_04_013132.jpg

保存した円のKMLファイルをGoogleEarthなどで表示できます。

Image 2014_10_04_015053.jpg
(Googleの地図にはモザイクを掛けて自主規制www)

円の大きさ、色、透過率の設定も行うことができます。

動作させるには、Microsoft .net Framework 3.5以降が必要です。
なのでWindowsでしか動作しません。
(Framework3.5は、Windows7に標準搭載しています)
多分Windows8でも動くと思いますが、試していないのでわかりません。

なぜこんなソフトを作成したかというと、
再生骨材などを工事で使う場合、現場から40km圏内のプラントから
運んでこないといけないという決まりがあるためです。
(他の都府県では違うかもしれませんが)

設計を行うのに、全道の近隣プラントの有無を確認しなければならず、
紙ベースだとものすごい手間だからです。

GISでも同じことができますが、森林土木担当者はほとんどGISを使用していません。
この作業のためだけに、GISを説明するのは非常に大変で、
大変な労力がかかるため、簡単に使えるこのソフトウエアを作成しました。

GoogleEarthを使って、工場の位置を記録するのはだれでもできるので、
工場の位置データはみんなで作って、このソフトウエアを活用できれば
と思ったわけです。

ソフトウエアを作るにあたって、
いろいろなWebサイト、ブログなどを参考にさせていただき、
また、OsGeoのメーリングリストでも助けていただき、
3日ほどかかって作成することが出来ました。
助けていただいた方々には、非常に感謝しています。ありがとうございました。

OpenLayersについて、少し勉強になりました。

このソフトウエアは基本的に自由に使用して頂いて構いません。
ただし、このブログ以外のWebサイトへの転載はご遠慮ください。

不具合や要望、提案などありましたらメールまたはコメント欄に記載してください。
よろしくお願いします。


posted by kouichi at 01:59| Comment(0) | GISその他 | このブログの読者になる | 更新情報をチェックする