2014年10月05日

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

【その1】はこちら  ソフトウエア「Map円Edit」はこちら
 
今回は、円の図形と中心のマーカーをkmlファイルに出力する方法の説明です。
kmlファイルは、xmlファイルの一種です。
vb.netでは、xmlファイルを簡単に作ることができます。
今回の方法は、xmlWriterを使って、1行づつ書き込んでいく方法です。 
 
vb.netでのxmlファイルの作成方法は、この記事が参考になると思います。
 
まずは、Kmlに変換するボタンのクリックイベントを説明します。
ボタンの名称は「Butt_円のKML作成」です。
保存するファイル名を指定するため、SaveFileDialogコントロールもフォームに配置しています。
SaveFileDialogコントロールの名称は「SaveFileDialog_KML」としています。
 
    Private Sub Butt_円のKML作成_Click(sender As Object, e As EventArgs) Handles Butt_円のKML作成.Click
        Try
            'ファイル保存ダイアログを開いて、保存するファイル名を指定します。
            SaveFileDialog_KML.Filter = "KMLファイル(*.KML)|*.kml|すべてのファイル(*.*)|*.*"
            SaveFileDialog_KML.FilterIndex = 1
            SaveFileDialog_KML.Title = "KMLファイルの保存先"

            If SaveFileDialog_KML.ShowDialog() = Windows.Forms.DialogResult.Cancel Then
                'キャンセルボタンを押された時の処理
                MessageBox.Show("キャンセルされました。", "キャンセル", MessageBoxButtons.OK, MessageBoxIcon.Stop)
                Exit Sub
            End If
            
            'クラス「XML_Edit」の「sub_kml円作成」メソッドを呼び出します。
            '引数は、KMLファイルのフルパスを渡しています。
            XML_Edit.sub_kml円作成(SaveFileDialog_KML.FileName)

            'ファイルが作成されたら、メッセージを表示して、kmlファイルに関連付けられたソフトでファイルを開きます。
            MessageBox.Show("KMLが保存されました。", "KML保存完了", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Dim p As System.Diagnostics.Process = System.Diagnostics.Process.Start(SaveFileDialog_KML.FileName)

        Catch ex As Exception
            '例外処理
            MessageBox.Show("エラー発生(Butt_円のKML作成_Click)" & vbCr & ex.Message, "エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub
次に上のプロシージャで呼び出しているクラス「XML_Edit」の内容です。
xmlの編集を行うために、「System.xml」をインポートしておきます。
 
Imports System.Xml

Public Class XML_Edit
    Public Shared Sub sub_kml円作成(D_Path As String)
        'D_Pathはフルパスを指定

        Dim writer As XmlWriter = Nothing     'xmlwriterクラス
        Dim settings As XmlWriterSettings = New XmlWriterSettings()

        'テキストボックスのバックカラーをhtml16進数に変換 KMLの場合、赤と青が逆なので注意
        Dim htmlColor As String = String.Format("{0:X2}{1:X2}{2:X2}", F_地図表示.txt_円の色.BackColor.B, F_地図表示.txt_円の色.BackColor.G, F_地図表示.txt_円の色.BackColor.R)
        '透過率をhtml16進数に変換
        Dim html透過 As String = CStr(Hex(F_地図表示.txt_透明度.Text * 2.55)) '100%が255になるので、2.55倍する

        'ファイル名から、KMLドキュメントの名前を設定
        Dim myName As String = System.IO.Path.GetFileNameWithoutExtension(D_Path)

        '文字コードを指定
        settings.Encoding = System.Text.Encoding.UTF8    'kmlはUTF-8で記述する
        'settings.Encoding = System.Text.Encoding.GetEncoding("Shift_JIS")
        'インデントを設定すると、改行されて出力される
        settings.Indent = True
        settings.IndentChars = vbTab

        '書き込み先のテキストファイル 

        writer = XmlWriter.Create(D_Path, settings)    'この時点で空のxmlファイルが作成される

        'XML作成開始
        writer.WriteStartDocument()

        'ルート要素<kml>の宣言
        writer.WriteStartElement("kml")
        'ここはエラーになるので記述しない。記述がなくてもGoogleEarthでは読み込める。
        'writer.WriteAttributeString("xmlns", "", "http://www.opengis.net/kml/2.2")
        'writer.WriteAttributeString("xmlns:gx", "", "http://www.google.com/kml/ext/2.2")
        'writer.WriteAttributeString("xmlns:kml", "", "http://www.opengis.net/kml/2.2")
        'writer.WriteAttributeString("xmlns:atom", "", "http://www.w3.org/2005/Atom")

        writer.WriteStartElement("Document")
        writer.WriteElementString("name", myName)

        'ポイントやポリゴンのスタイルの記述
        writer.WriteStartElement("Style")
        writer.WriteAttributeString("id", "", "PolyStyle")    'スタイルを使うときはidで呼び出す
        writer.WriteStartElement("IconStyle")
        writer.WriteElementString("scale", "1.0")    'アイコンの大きさ
        writer.WriteStartElement("Icon")
        writer.WriteElementString("href", "http://maps.google.com/mapfiles/kml/paddle/pink-circle.png")    'アイコンの画像
        writer.WriteEndElement() 'Iconタグ終わり
        writer.WriteStartElement("hotSpot")    'アイコンの位置などの設定
        writer.WriteAttributeString("x", "", "32")
        writer.WriteAttributeString("y", "", "1")
        writer.WriteAttributeString("xunits", "", "pixels")
        writer.WriteAttributeString("yunits", "", "pixels")
        writer.WriteEndElement() 'hotSpotタグ終わり
        writer.WriteEndElement() 'IconStyleタグ終わり
        writer.WriteStartElement("LineStyle")    '線のスタイル
        '色は透過率2桁(16進数)+色コード(BGRの16進数)
        writer.WriteElementString("color", "ff" & htmlColor) '透過100%
        writer.WriteElementString("width", "3") '線の太さ
        writer.WriteEndElement() 'LineStyleタグ終わり
        writer.WriteStartElement("PolyStyle")    '塗りつぶしのスタイル
        writer.WriteElementString("color", html透過 & htmlColor)    '塗りつぶしの色
        writer.WriteEndElement() 'PolyStyleタグ終わり
        writer.WriteEndElement() 'Styleタグ終わり

        'スタイルマップのタグの記述
        writer.WriteStartElement("StyleMap")
        writer.WriteAttributeString("id", "", "circleStyle")    '地物はこのidでスタイルを設定する
        writer.WriteStartElement("Pair")
        writer.WriteElementString("key", "normal")
        writer.WriteElementString("styleUrl", "#PolyStyle")    '上で記述したスタイルのタグを呼び出し
        writer.WriteEndElement() 'Pairタグ終わり
        writer.WriteStartElement("Pair")
        writer.WriteElementString("key", "highlight")
        writer.WriteElementString("styleUrl", "#PolyStyle")
        writer.WriteEndElement() 'Pairタグ終わり
        writer.WriteEndElement() 'StyleMapタグ終わり

        'フォルダの作成
        writer.WriteStartElement("Folder")
        writer.WriteElementString("name", myName)    'ファイル名をフォルダ名に使用
        '円のポリゴン
        writer.WriteStartElement("Placemark")
        writer.WriteElementString("name", F_地図表示.txt_円の半径.Text & "kmの円")
        writer.WriteElementString("styleUrl", "#circleStyle")    'スタイルを呼び出し
        writer.WriteStartElement("Polygon")
        writer.WriteElementString("tessellate", "3")
        writer.WriteStartElement("outerBoundaryIs")
        writer.WriteStartElement("LinearRing")

        Dim my座標 As String = ""
        'リストボックスから、座標のテキストを作成
        For i = 0 To F_地図表示.List_円の座標.Items.Count - 1
            my座標 = my座標 & F_地図表示.List_円の座標.Items(i) & ",0 "

        Next
        writer.WriteElementString("coordinates", my座標)    '円ポリゴンを作成

        writer.WriteEndElement() 'LinearRingタグ終わり
        writer.WriteEndElement() 'outerBoundaryIsタグ終わり
        writer.WriteEndElement() 'Polygonタグ終わり
        writer.WriteEndElement() 'Placemarkタグ終わり
        '中心点のアイコン
        writer.WriteStartElement("Placemark")
        writer.WriteElementString("name", "中心点")
        writer.WriteElementString("styleUrl", "#circleStyle")
        writer.WriteStartElement("Point")
        writer.WriteElementString("coordinates", F_地図表示.txt_マーカー経度.Text & "," & F_地図表示.txt_マーカー緯度.Text & ",0") '3つめの値は高さ

        writer.WriteEndElement() 'Pointタグ終わり
        writer.WriteEndElement() 'Placemarkタグ終わり
        writer.WriteEndElement() 'Folderタグ終わり

        writer.WriteEndElement() 'Documentタグ終わり
        writer.WriteEndElement() 'kmlタグ終わり

        'XMLドキュメントの終了
        writer.WriteEndDocument()    'xmlファイルの記述終了

        'Write the XML to file and close the writer.
        writer.Flush()    'xmlwriterの終了
        writer.Close()    'xmlwriterを閉じる→ファイルが作成される
    End Sub

End Class
上のコードはxmlを1行づつ作成していく方法です。
vb.netで使えるxmlwriterクラスを使用します。
WriteStartDocument」でxmlの記述を初めて、
WriteStartElement("****")」でタグを開始します。
「WriteEndElement()」でタグを閉じます。
1行でタグを記載する場合には、「WriteElementString("タグ名", "内容")」と記載します。
タグのはじめにidなどの要素を記述する場合には、
WriteAttributeString("要素名", "", "内容")」と記載しします。
WriteStartElement("****")」と「WriteEndElement()」の数が合わないと、
エラーになるので注意してください。
 
以上で、円のkmlファイルを作成することができます。
kmlのタグの意味などは、Webサイトに沢山情報がありますので、
そちらで確認して下さい。
コードに間違いや不具合があった場合には、コメント欄で教えていただければと思います。
なお、今回のコードのライセンスについては、「CC-BY」としますので、
自由に使用して頂いて構いません。
by.png
posted by kouichi at 23:41| Comment(0) | vb.net | このブログの読者になる | 更新情報をチェックする

[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 | このブログの読者になる | 更新情報をチェックする