友人の「ウォーキング」や「サイクリング」「ハイキング」の際に、スマホのGPSで取得した移動記録のGPSログを自分のパソコン内で表示して楽しむアプリを作成したので、ご紹介します。
一般的にGPSログをHTML内で表示する場合、ブラウザはネット上にある「****.gpx」と通信してデータを受け取り、HTMLで表示します。しかし「****.gpx」がローカルにある場合は、セキュリティ上の理由からこれができない仕組みになっているようです。
自分のホームページを持っている人ならサーバーを契約しているので、ネットに上げて表示することはできますが、いちいちネットに上げるのも面倒です。またホームページを持っていない人は、そもそもネットに上げることができません。（自分のパソコン内に「Xampp」などで仮想のサーバーを立ち上げて、その中で表示することは可能ですが、一般的ではありません。）
そこで、GPSデータ（****.gpx）を、表示するHTMLファイルにテキストとして読み込んで、それを表示する方法で作りました。
このページのTopに表示している地図とグラフがそれです。
何日分もGPSデータを読み込んで行くことによって、下図のようにデータの一覧表が出来上がっていきますから、過去のデータも表示して見ることが可能です。
一覧表Toolの画面はこんな風です。起動すると「Tool画面1」が開きます。「新しく作成」または「前回の続き」を選択すると「Tool画面2」が開き、「前回の続き」を選択した場合は、前回までのデータを読み込んだ状態で開きます。
tool画面1
tool画面2
フォルダ構成
フォルダ構成は左図の通りです。上の「20240907」から「20241021-2」までの7個のフォルダはこのMapToolが作成した日付フォルダです。
「common」フォルダには「css」「images」「js」「leaflet」「lightbox」「tablesorter」があります。
「css」には「style.css」のみ。
「images」には地図内でぐるぐる動き回る赤い cicon.png 
や、地図内の撮影ポイントを示す青い picon.png 
があります。
「js」にはネットからダウンロードしたグラフを描くhighcharts.jsの他、カレンダーを描く calen.js と、地図とグラフを描く leaflet_map_240804.js とがあります。これは後でご紹介します。カレンダーについては過去にご紹介してあります。
「leaflet」は leaflet地図を表示するJavaScriptライブラリの一式で、ネットからダウンロードします。
「lightbox」は画像を拡大してモーダルダイアログにポップアップ表示させることができるJavaScriptライブラリで、これもネットからダウンロードしました。
「tablesorter」はGPX一覧表示の index.html で昇順・降順に並べ替えるものです。これもネットからダウンロードしました。
「test」は作業用フォルダで、toolが自動作成します。
「tool」はこのMapToolが入っているフォルダで、他に「photoshifter」と「template」フォルダが入っています。
「photoshifter」はネットからダウンロードしたもので、コマンドラインから起動できる画像縮小ツールです。
「template」には、作成する「map.html」と一覧表の「index.html」のひな形が入っています。このページに表示しているものは、私の作成したファイルですが、この形に拘らず自由な形で作成すればいいと思います。
ネットを参考に自作した、地図を表示させるための leaflet_map_240804.js は下記のようなものです。（数字は自分の覚えのための作成年月日です）
var mk_points = [];
function init() {
var map = L.map('map_canvas');
//地理院地図の標準地図タイル
var gsi_std = new L.tileLayer('https://cyberjapandata.gsi.go.jp/xyz/std/{z}/{x}/{y}.png', {
minZoom: 5,
maxZoom: 18,
attribution: "地理院タイル"
});
//地理院地図の淡色地図タイル
var gsi_pale = new L.tileLayer('https://cyberjapandata.gsi.go.jp/xyz/pale/{z}/{x}/{y}.png', {
minZoom: 5,
maxZoom: 18,
attribution: "国土地理院"
});
//地理院地図の航空地図タイル
var gsi_ort = new L.tileLayer('https://cyberjapandata.gsi.go.jp/xyz/seamlessphoto/{z}/{x}/{y}.jpg', {
minZoom: 5,
maxZoom: 18,
attribution: "国土地理院"
});
//オープンストリートマップ標準のタイル
var osm_std = new L.tileLayer('https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png', {
minZoom: 2,
maxZoom: 18,
attribution: "© OpenStreetMap contributors"
});
//オープンストリートマップ日本のタイル
var osm_jpn = new L.tileLayer('http://tile.openstreetmap.jp/{z}/{x}/{y}.png', {
minZoom: 2,
maxZoom: 18,
attribution: "OpenStreetMap contributors"
});
var googl = new L.tileLayer('https://mt1.google.com/vt/lyrs=r&x={x}&y={y}&z={z}', {
minZoom: 2,
maxZoom: 18,
attribution: "Google Map"
});
var shade = L.tileLayer('https://cyberjapandata.gsi.go.jp/xyz/hillshademap/{z}/{x}/{y}.png', {
opacity: 0.3,
minZoom: 5,
maxZoom: 16,
attribution: '地理院タイル'
});
//baseMapsオブジェクトのプロパティに5つのタイルを設定
var baseMaps = {
"地理院地図 標準" : gsi_std,
"地理院地図 淡色" : gsi_pale,
"地理院地図 写真" : gsi_ort,
"OpenStreetMap 標準" : osm_std,
"OpenStreetMap 日本" : osm_jpn,
"Google Map" : googl,
};
var overlay = {
"国土地理院 陰影起伏図": shade,
};
//layersコントロールにbaseMapsオブジェクトを設定して地図に追加
//コントロール内にプロパティ名が表示される
L.control.layers(baseMaps, overlay, null, {
collapsed: true,
}).addTo(map);
gsi_std.addTo(map);
// 1---------------------------------------------------------------------------------------
var cicon = L.icon({
iconUrl: '../common/images/cicon.png',
iconSize: [20, 20],
iconAnchor: [10, 10],
});
var picon = L.icon({
iconUrl: '../common/images/picon.png',
iconSize: [14, 14], // iconのサイズ
iconAnchor: [7, 7], // iconの表示位置の基点
popupAnchor: [0, -7] // popup表示の基点
});
var sicon = L.icon({
iconUrl: '../common/images/start.png',
iconSize: [16, 16], // iconのサイズ
iconAnchor: [8, 8], // iconの表示位置の基点
popupAnchor: [0, -8] // popup表示の基点
});
var gicon = L.icon({
iconUrl: '../common/images/goal.png',
iconSize: [16, 16], // iconのサイズ
iconAnchor: [8, 8], // iconの表示位置の基点
popupAnchor: [0, -8] // popup表示の基点
});
// 2---------------------------------------------------------------------------------------
// points[i][0]=lat, [1]=lon, [2]=jpeg, [3]=time, [4]=ele, [5]=title, [6]=coment
// .marker1=マーカー画像あり, .marker2=マーカー時間・高度, .marker3=マーカー画像なし, .marker4=マーカーのコメント
var i, html;
for (i = 0; i < markers.length; i++) {
var result1 = /\.mp4/g.test(markers[i][2]);
var result2 = /\.jpg|\.png/g.test(markers[i][2]);
if (result1 == true){
html = '<div class="marker1">' + markers[i][5] + '<br><video controls playsinline height="147px"><source src="images/' + markers[i][2] + '"></video><br><span class="marker2">撮影時間＝' + markers[i][3] + '</span><span class="marker22">GPS高度＝' + markers[i][4] + 'm</span></div>';
} else if (result2 == true) {
html = '<div class="marker1">' + markers[i][5] + '<br><a href="img/' + markers[i][2] + '" data-lightbox="g1" data-title="' + markers[i][5] + '<br>' + markers[i][6] + '"><img src="img/' + markers[i][2] + '" width="300"></a></span><br><span class="marker2">撮影時間＝' + markers[i][3] + '</span><span class="marker22">高度＝' + markers[i][4] + 'm</span></div>';
} else {
html = '<div class="marker3">' + markers[i][5] + '<br><span class="marker2">時刻＝' + markers[i][3] + '<br>GPS高度＝' + markers[i][4] + 'm</span></div>';
}
if (i == 0){
mk_points[i] = L.marker([markers[i][0], markers[i][1]], {icon: sicon}).addTo(map).bindPopup(html);
} else if (i == markers.length-1){
mk_points[i] = L.marker([markers[i][0], markers[i][1]], {icon: gicon}).addTo(map).bindPopup(html);
} else {
mk_points[i] = L.marker([markers[i][0], markers[i][1]], {icon: picon}).addTo(map).bindPopup(html);
}
}
// 3---------------------------------------------------------------------------------------
var data = [];
var chartEle = [];
var routeLatLng = [];
var dist = 0;
var distkm;
for (var i=0; i<(points.length); i++) {
var lat = points[i][0];
var lon = points[i][1];
var ele = Math.round([points[i][2]]);
// var time = new Date(points[i][3]).getTime() + 60*60*9*1000;
var time = new Date(points[i][3]).getTime();
var timeStr = new Date(time).toLocaleTimeString();
if (i == 0) { var stTime = (new Date(points[i][3])).getTime() }
if (i == points.length-1) { var edTime = (new Date(points[i][3])).getTime() }
if (i > 0) {
var bf_lat = points[i-1][0];
var bf_lon = points[i-1][1];
dist += hubeny(bf_lat, bf_lon, lat, lon );
distkm = Math.round(dist/1000 * 1000) / 1000;
}
routeLatLng[i] = [lat, lon];
chartEle.push({x:distkm, y:ele, lat:lat, lon:lon, timeStr:timeStr},);
}
var diffTime = time2str(edTime - stTime);
var subtitle = '移動距離:' + distkm + 'km' + ' 所要時間:' + diffTime;
L.polyline(routeLatLng, {
color: '#ff0066',
weight: 4,
opacity: 0.7,
lineCap: 'round'
}).addTo(map);
Bounds = L.polyline(routeLatLng).getBounds();
map.fitBounds(Bounds);
cmarker = new L.marker( [points[0][0], points[0][1]], {icon: cicon}).addTo(map);
// Now create the chart
Highcharts.chart('chart', {
chart: {
type: 'area'
},
xAxis: {
title: {
text: '距離 (km)'
},
minPadding: 0
},
yAxis: {
startOnTick: true,
endOnTick: false,
minPadding: 0,
title: {
text: '',
},
labels: {
formatter: function() {
return this.value +' m';
},
}
},
title: {
text: '標高 グラフ'
},
subtitle: {
text: subtitle,
},
tooltip: {
headerFormat: '',
pointFormat: '{point.timeStr}<br/>{point.x} km / {point.y} m',
enabled: true
},
legend: {
enabled: false
},
plotOptions: {
series: {
point: {
events: {
mouseOver: function () {
if(this.lat && this.lon){
if(cmarker){
map.removeLayer( cmarker );
}
cmarker = new L.Marker( [this.lat, this.lon], {icon: cicon}).addTo(map);
}
}
}
},
events: {
mouseOut: function () {
map.removeLayer( cmarker );
cmarker = null;
}
}
}
},
series: [{
data: chartEle,
name: '',
marker: {
enabled: false,
states: {
hover: {
enabled: true,
radius: 5
}
}
},
fillColor: {
linearGradient: { x1: 0, y1: 0, x2: 0, y2: 1 },
stops: [
[0, 'rgba(65, 116, 158, 0.7)'],
[1, 'rgba(102, 255, 153, 0)']
]
},
lineWidth: 1,
threshold: null,
turboThreshold: 0
}]
});
}
// 4---------------------------------------------------------------------------------------
cicon = L.icon({
iconUrl: './cicon.png',
iconSize: [18, 18],
popupAnchor: [9, 9],
});
function popupOn(id){ //ポップアップを開く
mk_points[id].openPopup();
}
function time2str(time) {
var timeHour = time / (1000 * 60 * 60);
var timeMinute = (timeHour - Math.floor(timeHour)) * 60;
var timeSecond = (timeMinute - Math.floor(timeMinute)) * 60;
return Math.floor(timeHour) + ':' + ('00' + Math.floor(timeMinute)).slice(-2) + ':' + ('00' + Math.round(timeSecond)).slice(-2);
}
// 5---------------------------------------------------------------------------------------
function hubeny(lat1, lng1, lat2, lng2) {
function rad(deg) {
return deg * Math.PI / 180; //degreeをラジアンに変換
}
lat1 = rad(lat1);
lng1 = rad(lng1);
lat2 = rad(lat2);
lng2 = rad(lng2);
var latDiff = lat1 - lat2; // 緯度差
var lngDiff = lng1 - lng2; // 経度差
var latAvg = (lat1 + lat2) / 2.0; // 緯度の平均
var a = 6378137.0; // 赤道半径（WGS84系）
var b = 6356752.314245; // 極半径（WGS84系）
var e2 = 0.00669437999019758; // 第一離心率^2 e^2 = (a^2 - b^2) / a^2
var a1e2 = 6335439.32729246; // 赤道上の子午線曲率半径 a(1 - e^2)
var sinLat = Math.sin(latAvg);
var W2 = 1.0 - e2 * (sinLat * sinLat);
var M = a1e2 / (Math.sqrt(W2) * W2); // 子午線曲率半径M
var N = a / Math.sqrt(W2); // 卯酉線（ぼうゆうせん）曲率半径N
t1 = M * latDiff;
t2 = N * Math.cos(latAvg) * lngDiff;
d1 = Math.sqrt((t1 * t1) + (t2 * t2));
return d1;
}
最初から1番の区切り線まではマップタイルの種類です。
次の2番の区切り線までは、アイコンを登録している部分で基本的には cicon.png と picon.png の2種類あればOKです。
次の3番の区切り線までは picon.png が張り付けられた撮影ポイントの画像をポップアップ表示させる部分です。
次の4番の区切り線までは highcharts.js を使ってグラフを描くん部分で、ネットの記事や highcharts のリファレンスを参考に作成しました。相当高度なこともできるようですが、頭がついて行かないので基本的な部分のみになっています。
5番目の区切り選までは、アイコンのアンカーを指定したりポップアップさせたり、時間を文字列に直したりの細かい部分です。
最後の部分はヒューベニの公式でGPXポイント間の距離を計算している部分です。ネットから拝借しました。
MapTool本体は、下記のコードですが、既にサポートが終了しているVBScriptで書いています。
なんせ大学生の孫が産まれた時には既に定年退職していた化石のような人間ですからご容赦ください。（VBScriptは今でもWindowsに搭載されています）
ファイルはHTMLではなくHTAで書いています。これはHTMLだとオフラインで起動すると正常セキュリティの問題があるので、それを避けるためです。
また、コード内の半角の"＜"は、半角の"＆lt;"に書き換えてあります。
HTAのトップから<head>の部分とデータ入力フォームまでは以下の通りです。
<!DOCTYPE html>
<html>
<head>
<meta charset="UTF-8" />
<meta http-equiv="Content-Style-Type" content="text/css" />
<script type="text/javascript" src="../common/js/jquery.min.js"></script>
<title>GPSマップ作成支援ツール Ver24.09.10</title>
<HTA:APPLICATION BORDER="dialog">
<script language="VBS">
'ここからVBScript
'変数宣言
Dim fomData() 'fomデータ
Dim jpgData(20,4), mkData(22,9), mkLen 'GPSデータ,画像データ,マーカー画像を読み込む配列
Dim gpsPoints()
Dim rootPath, toolPath, gpxPath, gpxPoint, markers, markerPoint, wayPoint
Dim myDateStr1, dateFolder, NewDateFol
Dim cam1_Offset, offsetT1, resizeFlag
Dim myTitle, wDist, wTime
Dim categoNo, category, mainTitle, subTitle, mtAlt, NewDateStr, numGPS
Dim pageTitle, Copyright, walkTime, walkDist, walkData, mkMax
Dim categoArr : categoArr = Array("", "ハイキング", "サイクリング", "ウォーキング", "キャンプ", "その他")
'配列のメモ
'jpgData(i,j) j: 0=jpgFullPath 1=ファイル名 2=title 3=coment 4=noResize
'mkData(i,x) x: 0=lat 1=lon 2=画像File名 3=撮影Time(utc) 4=高度 5=title 6=coment 7=移動距離(km) 8=撮影Time(m秒) 9=DiffTime(仮の撮影Time)
'Dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject") '準備 ファイルシステムオブジェクトのセット
Set objFile = objFso.GetFile("240910.hta") 'C:\Users\Owner\Documents\Map\tool\240910.hta
toolFolder = objFile.ParentFolder 'C:\Users\go\Desktop\Map\tool
rootPath = objFso.getParentFolderName(toolFolder) 'C:\Users\go\Desktop\Map
Set objFolder = objFso.GetFolder(rootPath) 'C:\Users\go\Desktop\Map
Set colFolders = objFolder.SubFolders '[Map]フォルダ内フォルダコレクション
Set colFiles = objFolder.Files '[Map]フォルダ内ファイルコレクション
toolPath = rootPath & "\tool" 'C:\Users\go\Desktop\Map\tool
tmplPath = toolPath & "\template" 'C:\Users\go\Desktop\Map\tool\template
testPath = rootPath & "\test" 'C:\Users\go\Desktop\Map\tool\test
Sub Window_OnLoad
Call Window.ResizeTo(1200,800)
End Sub
'日付入力フォーム
fm0 = "<div id=""innerhtml_99"">" & _
"<table width=""100%"" border=""0"">" & _
"<tbody>" & _
"<tr>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2""><span class=""large"">■日付</span></td>" & _
"<td colspan=""3""><input name=""year1"" id=""year1"" size=""1"">年 <input name=""month1"" id=""month1"" size=""1"">月 <input name=""day1"" id=""day1"" size=""1"">日</td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2"" height=""120""></td>" & _
"<td colspan=""6"" align=""center""><input type=""button"" value=""［次へ］"" onclick=""fmChange(10)"" class=""largest""></td>" & _
"<td colspan=""2""></td>" & _
"</tr>" & _
"</tbody>" & _
"</table>"
'データ入力フォーム
fm1 = "<div id=""innerhtml_99"">" & _
"<table width=""100%"" border=""1"">" & _
"<tbody>" & _
"<tr>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"<td></td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2""><span class=""large"">■日付</span></td>" & _
"<td colspan=""3""><input name=""year1"" id=""year1"" size=""1"" disabled>年 <input name=""month1"" id=""month1"" size=""1"" disabled>月 <input name=""day1"" id=""day1"" size=""1"" disabled>日</td>" & _
"<td colspan=""7""><input name=""datefol"" id=""datefol"" size=""7"" disabled><span class=""small""> 日付フォルダ名です。（変更はできません）</span></td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2""><span class=""large"">■タイトル</span></td>" & _
"<td colspan=""2"">カテゴリ<select name=""category""><option value=""0"">選択する</option><option value=""1"">ハイキング</option><option value=""2"">サイクリング</option><option value=""3"">ウォーキング</option><option value=""4"">キャンプ</option><option value=""5"">その他</option></select></td>" & _
"<td colspan=""4"">タイトル<input id=""mTitle"" size=""24"" type=""text""></td>" & _
"<td colspan=""4"">サブタイトル<input id=""sTitle"" size=""24"" type=""text"">（かな）</td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2""><span class=""large"">■GPXファイル</span></td>" & _
"<td colspan=""6""><input id=""gpxf"" name=""gpxf"" type=""text""value="""" size=""48""><input type=""file"" onchange=""fnamecopy(108)"" size=""1"" name=""imp_file""></td>" & _
"<td colspan=""4""><span class=""small"">GPX形式（***.gpx）のファイルを指定します。</span></td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2"" rowspan=""2""><span class=""large"">■カメラ内蔵時計<br> 補正値</span></td>" & _
"<td align=""center""><input type=""radio"" name=""offset1"" value=""o11"" checked><b>＋</b></td>" & _
"<td rowspan=""2""><input size=""2"" type=""text"" name=""mm1"" value=""00"">分</td>" & _
"<td rowspan=""2""><input size=""2"" type=""text"" name=""ss1"" value=""00"">秒</td>" & _
"<td colspan=""7"" rowspan=""2""><span class=""small"">GPSに対してカメラが 進み＝（＋） 遅れ＝（－）</span></td>" & _
"</tr>" & _
"<tr>" & _
"<td align=""center""><input type=""radio"" name=""offset1"" value=""o12""><b>－</b></td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""2"" rowspan=""2""><span class=""large"">■画像リサイズ</span></td>" & _
"<td colspan=""1"" align=""center""><input type=""radio"" name=""resize1"" value=""rs1""checked><b>あり</b></td>" & _
"<td colspan=""3"" rowspan=""2"" align=""center"" height=""120""><input id=""Ok1"" name=""Ok1"" type=""button"" value=""［作成］"" onclick=""onClick(1)"" class=""largest""></td>" & _
"<td colspan=""3"" rowspan=""2""align=""center""><input id=""Ok2"" name=""Ok2"" type=""button"" value=""［保存］"" onclick=""onClick(2)"" class=""largest""></td>" & _
"<td colspan=""3"" rowspan=""2""><span class=""small""><ul><li>［作成］ボタンで、作成状況を確認できます。</li><li>［保存］するまではファイルは登録されせん。</li><li><span class=""red"">［保存］の前には必ず［作成］で作成状況を確認してください。</span></span></li></ul></td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""1"" align=""center""><input type=""radio"" name=""resize1"" value=""rs2""><b>なし</b></td>" & _
"</tr>" & _
"</tbody>" & _
"<tbody>" & _
"<tr>" & _
"<tr><td width=""120""><div id=""thumb0""></div></td><td width=""120""><div id=""thumb1""></div></td><td width=""120""><div id=""thumb2""></div></td><td width=""120""><div id=""thumb3""></div></td><td width=""120""><div id=""thumb4""></div></td><td width=""120""><div id=""thumb5""></div></td><td width=""120""><div id=""thumb6""></div></td><td width=""120""><div id=""thumb7""></div></td><td width=""120""><div id=""thumb8""></div></td><td width=""120""><div id=""thumb9""></div></td></tr>" & _
"<tr><td><div id=""imgName0""></div></td><td><div id=""imgName1""></div></td><td><div id=""imgName2""></div></td><td><div id=""imgName3""></div></td><td><div id=""imgName4""></div></td><td><div id=""imgName5""></div></td><td><div id=""imgName6""></div></td><td><div id=""imgName7""></div></td><td><div id=""imgName8""></div></td><td><div id=""imgName9""></div></td></tr>" & _
"<tr><td width=""120""><div id=""thumb10""></div></td><td width=""120""><div id=""thumb11""></div></td><td width=""120""><div id=""thumb12""></div></td> <td width=""120""><div id=""thumb13""></div></td><td width=""120""><div id=""thumb14""></div></td><td width=""120""><div id=""thumb15""></div></td><td width=""120""><div id=""thumb16""></div></td><td width=""120""><div id=""thumb17""></div></td><td width=""120""><div id=""thumb18""></div></td><td width=""120""><div id=""thumb19""></div></td></tr>" & _
"<tr><td><div id=""imgName10""></div></td><td><div id=""imgName11""></div></td><td><div id=""imgName12""></div></td><td><div id=""imgName13""></div></td><td><div id=""imgName14""></div></td><td><div id=""imgName15""></div></td><td><div id=""imgName16""></div></td><td><div id=""imgName17""></div></td><td><div id=""imgName18""></div></td><td><div id=""imgName19""></div></td></tr>" & _
"</tbody>" & _
"</table>" & _
"<table width=""100%"" border=""0"">" & _
"<tbody>" & _
"<tr>" & _
"<td width=""3%""> </td>" & _
"<td width=""60%""> </td>" & _
"<td width=""35%""> </td>" & _
"</tr>" & _
"<tr>" & _
"<td colspan=""7"" height=""50""><span class=""large"">■画像登録エリア</span></td>" & _
"</tr>" & _
"<tr>" & _
"<td align=""center""><strong>No</strong></td><td colspan=""1""><strong>［ファイル名］</strong></td><td colspan=""1""><strong>［画像タイトル］</strong></td>" & _
"</tr>" & _
"<tr>" & _
"<tr><td align=""center"">1</td><td colspan=""1""><input id=""jpeg0"" name=""jpeg0"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(0)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title0""></td></tr>" & _
"<tr><td align=""center"">2</td><td colspan=""1""><input id=""jpeg1"" name=""jpeg1"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(1)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title1""></td></tr>" & _
"<tr><td align=""center"">3</td><td colspan=""1""><input id=""jpeg2"" name=""jpeg2"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(2)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title2""></td></tr>" & _
"<tr><td align=""center"">4</td><td colspan=""1""><input id=""jpeg3"" name=""jpeg3"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(3)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title3""></td></tr>" & _
"<tr><td align=""center"">5</td><td colspan=""1""><input id=""jpeg4"" name=""jpeg4"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(4)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title4""></td></tr>" & _
"<tr><td align=""center"">6</td><td colspan=""1""><input id=""jpeg5"" name=""jpeg5"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(5)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title5""></td></tr>" & _
"<tr><td align=""center"">7</td><td colspan=""1""><input id=""jpeg6"" name=""jpeg6"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(6)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title6""></td></tr>" & _
"<tr><td align=""center"">8</td><td colspan=""1""><input id=""jpeg7"" name=""jpeg7"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(7)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title7""></td></tr>" & _
"<tr><td align=""center"">9</td><td colspan=""1""><input id=""jpeg8"" name=""jpeg8"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(8)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title8""></td></tr>" & _
"<tr><td align=""center"">10</td><td colspan=""1""><input id=""jpeg9"" name=""jpeg9"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(9)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title9""></td></tr>" & _
"<tr><td align=""center"">11</td><td colspan=""1""><input id=""jpeg10"" name=""jpeg10"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(10)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title10""></td></tr>" & _
"<tr><td align=""center"">12</td><td colspan=""1""><input id=""jpeg11"" name=""jpeg11"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(11)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title11""></td></tr>" & _
"<tr><td align=""center"">13</td><td colspan=""1""><input id=""jpeg12"" name=""jpeg12"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(12)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title12""></td></tr>" & _
"<tr><td align=""center"">14</td><td colspan=""1""><input id=""jpeg13"" name=""jpeg13"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(13)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title13""></td></tr>" & _
"<tr><td align=""center"">15</td><td colspan=""1""><input id=""jpeg14"" name=""jpeg14"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(14)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title14""></td></tr>" & _
"<tr><td align=""center"">16</td><td colspan=""1""><input id=""jpeg15"" name=""jpeg15"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(15)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title15""></td></tr>" & _
"<tr><td align=""center"">17</td><td colspan=""1""><input id=""jpeg16"" name=""jpeg16"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(16)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title16""></td></tr>" & _
"<tr><td align=""center"">18</td><td colspan=""1""><input id=""jpeg17"" name=""jpeg17"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(17)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title17""></td></tr>" & _
"<tr><td align=""center"">19</td><td colspan=""1""><input id=""jpeg18"" name=""jpeg18"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(18)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title18""></td></tr>" & _
"<tr><td align=""center"">20</td><td colspan=""1""><input id=""jpeg19"" name=""jpeg19"" type=""text"" value="""" size=""60""><input type=""file"" onchange=""fnameCopy(19)"" size=""1""></td><td colspan=""1""><input size=""40"" type=""text"" name=""title19""></td></tr>" & _
"</tbody>" & _
"</table>"
下の方の"<tr> 20行は「Wayポイント」の画像登録行で20行あります。この画像は地図内の撮影ポイントに表示する画像です。
次はフォームチェンジとメインルーチンです。
'-------------------------------------------------
'フォームチェンジ
'-------------------------------------------------
Sub fmChange(no)
Select Case no
case 1 '新しく作成
resizeFlag = True '新規作成なら画像リサイズあり
Value = MsgBox ("testPath に前回のデータがあります。" & vbCrLf & vbCrLf & "削除してもいいですか？", 20)
If Value <> 6 Then
MsgBox ("削除してはいけないデータがある場合は" & vbCrLf & "[新しく作成] はできません。" & vbCrLf & vbCrLf & "これを終了します。再度実行してください。")
Window.Close()
End If
Document.getElementById("innerhtml_99").innerHTML = fm0 '日付入力フォーム表示
Call subInit()
case 10 '新しく作成で、日付入力完了
Call procDate()
Set objFolder = objFso.GetFolder(rootPath) 'C:\Users\Owner\Documents\Map\root
Set colFolders = objFolder.SubFolders
dateFolder = fncFolderCheck(NewdateFol) '同一日付フォルダーチェック
fomlen = Document.forms("fom").Length - 2
ReDim fomData(fomlen)
Call dataSave(fomlen) '"data.txt"に残す
Document.getElementById("innerhtml_99").innerHTML = fm1 'データ入力フォーム表示
Call dataCopy()
Document.forms("fom").item(3).Value = dateFolder
Call testFolCreate(dateFolder) '[test]フォルダ作成
case 2 '前回の続き
Document.getElementById("innerhtml_99").innerHTML = fm1 'データ入力フォーム表示
Call dataCopy()
dateFolder = Document.forms("fom").item(3).Value '日付フォルダー読込
case 3 '一覧表示
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "chrome " & rootPath & "\index.html", 1, False
End Select
End Sub
'-------------------------------------------------
'メインルーチン
'-------------------------------------------------
Sub onClick(NO)
If resizeFlag = True Then
document.getElementsByName("resize1")(0).checked = True '新規作成なら画像リサイズあり
End If
If NO = 1 Then '[作成］
Set WshShell = CreateObject("WScript.Shell")
fomlen = Document.forms("fom").Length - 1
Call dataSave(fomlen) '全fomDataを [data.txt] に保存
Call procDate() '日付成形
categoNo = fom.category.value 'カテゴリーNo
category = categoArr(categoNo) 'カテゴリー名
mainTitle = fom.mTitle.value 'メインタイトル
subTitle = fom.sTitle.value 'サブタイトル
Call procTitle()
offsetmm1 = Document.forms("fom").item(10).Value 'カメラオフセット分
offsetss1 = Document.forms("fom").item(11).Value 'カメラオフセット秒
For Each i In document.getElementsByName("offset1")
If i.checked Then
cam1_Offset = i.value 'カメラオフセット
Exit For
End If
Next
offsetT1 = (offsetmm1)*60 + (offsetss1)
If cam1_Offset = "o11" Then
offsetT1 = (-1) * offsetT1
End If
gpxPath = fom.gpxf.value 'GPXファイルPath
gpxFile = objFso.GetFileName(gpxPath) 'GPXファイルネーム
'mkData(i,x) x: 0=lat 1=lon 2=ファイル名 3=撮影Time(utc) 4=高度 5=title 6=coment 7=移動距離(km) 8=撮影Time(m秒) 9=DiffTime(仮の撮影Time)
j = 0
m = 0
For i=0 To 19
If Document.forms("fom").item(i*3+17).Value <> "" Then
jpgData(i,0) = Document.forms("fom").item(i*3+17).Value '画像フルパス
jpgData(i,1) = LCase(Replace(objFso.GetFileName(jpgData(i,0)), " ", "-")) '画像ファイル名
jpgData(i,2) = Document.forms("fom").item(i*3+19).Value '画像タイトル
j = j+1
mkData(m,2) = jpgData(i,1) '画像ファイルネーム
mkData(m,3) = funcExifTimeGet(jpgData(i,0), OffsetT1) 'カメラ撮影時刻
mkData(m,5) = jpgData(i,2) '画像タイトル
mkData(m,9) = 100000000000 'GPS軌跡時刻と撮影時刻との時間差初期値
m = m+1
End If
Next
mkLen = m-1
If gpxPath = "" Then
MsgBox("GPXファイルを登録してください！！")
Else
Call createGPX(gpxPath)
mkMax = createCameraPoint() '撮影位置計算
Call quicksort2(mkData, 8, 0, mkMax, "As") 'マーカーポイントソート
Call objFso.CopyFile (gpxPath, testPath & "\", True) 'GPSファイルをdateFolderにコピー
End If
For Each i In document.getElementsByName("resize1")
If i.checked Then
resizeCheck = i.value 'リサイズあり/なし
Exit For
End If
Next
If resizeCheck = "rs1" Then
Call subJpgResize() '画像リサイズ
End If
Call subIndexCreate() '本文ページ作成
Call dataSave(fomlen) '全fomDataを [data.txt] に保存
MsgBox("作成完了！" & vbCr & vbCr & "map.html を開きます。" & vbCr & "確認してください！")
CreateObject("Shell.Application").ShellExecute testPath & "\map.html"
ElseIf NO = 2 Then '[保存]
objFso.CopyFolder testPath, rootPath & "\" & dateFolder, True 'testフォルダを rootPath に名前を変更してコピー
objFso.CopyFile rootPath & "\data.txt", rootPath & "\" & dateFolder & "\data.txt", True 'root内のdata.txtファイルを［NewdateFol］にコピー
Call createMapIndex() 'index.html作成
Window.Close()
End If
End Sub
次はメインルーチンの中で使っているサブプロシージャ群です。
ニ元配列のクイックソートまではVBScriptですが、撮影位置計算と移動距離計算は、参考例が多いJavascriptで処理しています。
'-------------------------------------------------
'初期値設定
'-------------------------------------------------
Sub subInit()
Document.fom.Year1.Value = Year(Date) '年初期値設定
Document.fom.Month1.Value = Month(Date) '月初期値設定
Document.fom.Day1.Value = Day(Date) '日初期値設定
End Sub
'-------------------------------------------------
'日付成形
'-------------------------------------------------
Sub procDate()
y1 = Document.forms("fom").item(0).value
m1 = Document.forms("fom").item(1).value
d1 = Document.forms("fom").item(2).value
d2 = Document.forms("fom").item(3).value
NewDate1 = DateValue(y1 & "/" & m1 & "/" & d1) 'yyyy/mm/dd
NewDateStr = Replace(CStr(NewDate1), "/", ".") 'Full年月日（yyyy.mm.dd）
NewdateFol = Replace(CStr(NewDate1), "/", "") '4桁年月日（yyyymmdd）
Week1 = WeekdayName(DatePart("w",NewDate1)) '水曜日
Yobi1 = Mid(Week1,1,1) '水（曜日1文字1)
NewDateStr11 = NewDateStr & "（" & Yobi1 & "）" '2016.08.25（水）
myDateStr1 = NewDateStr11 'pageTitle用 2016.08.25（木）
End Sub
'-------------------------------------------------
'同一日付フォルダチェック
'-------------------------------------------------
Function fncFolderCheck(Fol)
Set objFolder = objFso.GetFolder (rootPath) 'rootフォルダオブジェクト
Set colFolders = objFolder.SubFolders '[root]フォルダ内フォルダコレクション
i = 2
For Each objSubFolder in colFolders
dateFol = objSubFolder.Name
If dateFol = "common" Then Exit For
If InStr(dateFol, Fol) > 0 Then '同じ日付の文字列があったら・・・
Fol = Left(Fol, 8) & "-" & i 'フォルダ名に「-2」などと枝番号を付ける
i = i+1
End If
Next
fncFolderCheck = Fol 'チェック結果を返す
End Function
'-------------------------------------------------
'[test]フォルダ 作成
'-------------------------------------------------
Sub testFolCreate(Fol)
If objFso.FolderExists(testPath) = True Then '[test]が有ったら
Call objFso.DeleteFolder (testPath, true) '[test] 削除
End If
Set objFolder = objFso.GetFolder(rootPath) 'C:\Users\go\Documents\Map
Set objsubFol = objFolder.SubFolders
objsubFol.Add ("test") '[test]作成
Set objFolder = objFso.GetFolder(testPath) 'C:\Users\Owner\Documents\Map\test
Set objsubFol = objFolder.SubFolders
objsubFol.Add ("img") 'C:\Users\go\Documents\Map\test\img
End Sub
'--------------------------------------------
'data.txt 書き出し data.txt
'--------------------------------------------
Sub dataSave(no) '再作成時情報を"data.txt"に残す
Path = rootPath & "\data.txt"
Set objTxOut = objFso.CreateTextFile(Path)
txOut = ""
m=0
For i=0 To no
Select Case i
Case 9,12,13,16
txOut = txOut & Document.forms("fom").item(i).checked & vbCrLf
Case Else
txOut = txOut & Document.forms("fom").item(i).Value & vbCrLf
End Select
Next
objTxOut.Write(txOut)
objTxOut.Close()
End Sub
'-------------------------------------------------
'data.txt ファイルからデータをコピー
'-------------------------------------------------
Sub dataCopy()
Path = rootPath & "\data.txt" 'C:\Users\go\Documents\Map\data.txt
If objFso.FileExists(Path) = True Then
Set objtxIn = objFso.OpenTextFile(Path)
i=0
m=0
Do Until objtxIn.AtEndOfStream = True
myDat = objtxIn.ReadLine()
Select Case i
Case 9,12,13,16
Document.forms("fom").item(i).checked = myDat
Case 17+m
Document.forms("fom").item(i).Value = myDat
If myDat <> "" Then
Document.getElementById("thumb" & (i-17)/3).innerHTML = "<a href=""" & Document.forms("fom").item(i).Value & """ data-lightbox=""group""><img id=""pic"" src=""" & Document.forms("fom").item(i).Value & """ width=""120""></a>" 'サムネイルにコピー
Document.getElementById("imgName" & (i-17)/3).innerHTML = (i-17)/3+1 & " = " & objFso.GetFileName(myDat) 'ツールに表示するサムネイル用画像番号
End If
m=m+3
Case Else
Document.forms("fom").item(i).Value = myDat 'その他の場合
End Select
i = i+1
Loop
objtxIn.Close()
End If
End Sub
'-------------------------------------------------
'参照ファイルネームコピー input type="file" には、前回のデータを読み込むことができないので、苦肉の策で input type="file"のデータを１つ前の inputフォームに書き込む形式にしている
'-------------------------------------------------
Sub fnameCopy(num)
If num >=0 And num <= 19 Then
Document.forms("fom").item(num*3+17).Value = Document.forms("fom").item(num*3+18).Value '参照データを1個前のinputにコピー
Document.getElementById("thumb" & num).innerHTML = "<a href=""" & Document.forms("fom").item(num*3+17).Value & """ data-lightbox=""group""><img id=""pic"" src=""" & Document.forms("fom").item(num*3+17).Value & """ width=""120""></a>" 'サムネイルにコピー
Document.getElementById("imgName" & num).innerHTML = num+1 & " = " & objFso.GetFileName(Document.forms("fom").item(num*3+17).Value) 'ツールに表示するサムネイル用画像ファイル名
ElseIf num >= 100 Then
Document.forms("fom").item(num-101).Value = Document.forms("fom").item(num-100).Value '参照データを1個前のinputにコピー（GPSファイル）
End If
End Sub
'-------------------------------------------------
'タイトル整形
'-------------------------------------------------
Sub procTitle()
Set reg = New RegExp 'reg に正規表現クラスをセットする
reg.Global = True '全行検索On
reg.Pattern = "\d"
val = reg.Test(mtAlt)
If val = True Then
mtAlt1 = "（" & mtAlt & "m）"
Else
mtAlt = ""
End If
pageTitle = "<h2 class=""title_date""><span>" & myDateStr1 & category & "</span>" & mainTitle & "<span>" & subtitle & mtAlt1 & "</span></h2>"
End Sub
'----------------------------------------------------------------
'本文ファイル生成 map.html
'----------------------------------------------------------------
Sub subIndexCreate()
motoFile = tmplPath & "\map.html" 'Templateファイル
shinFile = testPath & "\map.html" '作成する新ファイル
Dim tmpFile : tmpFile = shinFile & ".tmp" '臨時のテンプファイル
With CreateObject("ADODB.Stream") 'UTF-8で全文読込
.Charset = "UTF-8"
.Open
.LoadFromFile(motoFile) 'Templateファイルを読み込む
txOut = .ReadText
.Close
End With
Copyright = "<div class=""copyright""><small>Copyright © 2011 - " & Left(Date(),4) & " GPSwalking All Rights Reserved.</small></div>"
Call createMarker()
Call createWayPoint()
txOut = Replace(txOut, "<!-- タイトル名 -->", mainTitle) 'タイトル（山名）
txOut = Replace(txOut, "<!-- ページタイトル -->", pageTitle) 'ページタイトル
txOut = Replace(txOut, "<!-- 著作権表示 -->", Copyright) '著作権表示
txOut = Replace(txOut, "<!-- GPSデータエリア -->", gpxPoint) 'GPSデータ
txOut = Replace(txOut, "<!-- markerポイント -->", markerPoint) 'マーカーポイント
txOut = Replace(txOut, "<!-- wayポイント -->", wayPoint) 'Wayポイント
Call WriteUTF8(txOut, shinFile) '新ファイルをUTF-8で書き込む
End Sub
'-------------------------------------------------
'GPXData 作成 'GPXデータをテキストデータとしてmap.htmlに書き込む
'-------------------------------------------------
Sub createGPX(gpxFile)
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile(gpxFile)
txOut = .ReadText
.Close
End With
Set reg = New RegExp 'reg に正規表現クラスをセットする
reg.Global = True '全行検索On
'--------------------------------------------
'GPXファイル読込 'GPXファイルによって書式が違うので、統一化するための処理
reg.Pattern = "\r?\n" '改行を削除する
txOut = reg.Replace(txOut, "")
reg.Pattern = "</trkpt>" '</trkpt>で改行する
txOut = reg.Replace(txOut, "</trkpt>" & vbCrLf)
gpxPoint = "var points = [" & vbCrLf
reg.Pattern = "\s*<trkpt lat=""(\d{2}\.\d{4,8})"" lon=""(\d{3}\.\d{4,8})"">\s*<ele>(\d{1,4}\.\d{1,13})</ele>\s*<time>(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2})(\.*\d{3})?Z</time>.*</trkpt>"
Set mc = reg.Execute(txOut) 'もの凄く長い１行に変換したデータから lat, lng, ele, date time を取り出す
For Each m in mc
mcStr0 = m.SubMatches(0) 'lat
mcStr1 = m.SubMatches(1) 'lng
mcStr2 = m.SubMatches(2) 'ele
mcStr3 = m.SubMatches(3) 'date time
gpxPoint = gpxPoint & String(3, vbTab) & "[" & mcStr0 & ", " & mcStr1 & ", " & mcStr2 & ", '" & mcStr3 & "']," & vbCrLf
Next
gpxPoint = gpxPoint & String(2, vbTab) & "];"
End Sub
'-------------------------------------------------
'markerPoint 作成
'-------------------------------------------------
Sub createMarker()
markerPoint = "var markers = [" & vbCrLf
For i=0 To mkMax
myDate = mkData(i,3)
myTime = DatePart("h", myDate) & ":" & Right("0" & DatePart("n", myDate), 2) & ":" & Right("0" & DatePart("s", myDate), 2)
myTime = Replace(myTime, "0:00:00", "")
markerPoint = markerPoint & String(3, vbTab) & "[" & mkData(i, 0) & ", " & mkData(i, 1) & ", """ & mkData(i, 2) & """, """ & myTime & """, " & mkData(i, 4) & ", """ & mkData(i, 5) & """, """ & """]," & vbCrLf
Next
markerPoint = markerPoint & String(2, vbTab) & "];"
End Sub
'-------------------------------------------------
'wayPoint 作成
'-------------------------------------------------
Sub createWayPoint()
wayPoint = "<dl class=""course_time"">" & vbCrLf
'mkData(i,x) x: 0=lat 1=lon 2=ファイル名 3=Time(JST) 4=ele 5=title 6=coment 7=移動距離(km) 8=Time(mm秒) 9=DiffTime(仮の撮影Time)
For i=0 To mkMax
If mkData(i,5) = "" Then mkData(i,5) = " "
myTitle = mkData(i,5)
myDate = mkData(i,3)
myTime = ""
If mkData(i,3) <>"" then
myTime = DatePart("h", myDate) & ":" & Right("0" & DatePart("n", myDate), 2)
End If
wayPoint = wayPoint & String(3, vbTab) & "<a href=""#map_canvas"" onclick=""popupOn(" & i & ");""><dt>" & myTime & "</dt><dd>" & myTitle & "</dd></a>" & vbCrLf
If InStr(mkData(i,5), "goal") > 0 Then
wayPoint = wayPoint & String(3, vbTab) & " " & vbCrLf '区間と区間の間は距離を書かない
Else
wayPoint = wayPoint & String(3, vbTab) & " " & Round((mkData(i+1,7) - mkData(i,7))/1000, 1) & "km" & vbCrLf 'Roundの引数１は小数点以下1桁
End If
Next
wayPoint = wayPoint & String(2, vbTab) & "</dl>"
End Sub
'-------------------------------------------------
'マーカー用画像配列ソート mkData(i,x) 0=lat 1=lng 2=file 3=utc 4=ele 5=title 6=coment 7=km 8=撮影Time(m秒) 9=DiffTime(仮の撮影Time)
'-------------------------------------------------
Sub mkDataSort()
Call quicksort2(mkData, 3, 0, mkLen, "As") 'クイックソート本体(昇順降順）（再帰）
' quicksort2(sqa, col, first, last, "As")
' sqa:配列名
' col:ソート対象0から始まる列番号
' first:ソート行範囲最初行番号
' last:ソート行範囲最終行番号
' sort:昇・降順別 "As"/"Des"と文字列を記述する。
End Sub
'-------------------------------------------------
'walkData 整形
'-------------------------------------------------
Sub procWalkData()
' wDist = FormatNumber(Round(walkDist/1000, 1), 1) & "km" 'FormatNumberの引数=1は少数点以下1桁，3桁ごとに(,)区切り
wDist = Round(walkDist/1000, 1) & "km" 'Roundの引数=1は少数点以下1桁
wTime = Replace(walkTime, "：", "時間") & "分"
If numGPS=1 Then 'GPSあり
walkData = String(3, vbTab) & "<p class=""subject"">移動距離</p><p class=""data"">" & wDist & "</p>" & vbCrLf & _
String(3, vbTab) & "<p class=""subject"">行動時間</p><p class=""data"">" & wTime & "</p>" & vbCrLf
End If
End Sub
'--------------------------------------------
'function funcExifTimeGet Exifタイム取得 '画像のExifデータから撮影時刻を取り出す方法が分からないので、
'-------------------------------------------- '素人っぽい方法で取り出している
Function funcExifTimeGet(Filname, Offset)
Dim jpgFil, i, j, binDate(9), binTime(7), binData(19)
Dim byt, jpgTimeStr
set jpgFil = CreateObject("ADODB.Stream")
jpgFil.Open
jpgFil.Type = 1
jpgFil.LoadFromFile(Filname)
Flag = 0
i = 0
Do
i = i + 1
byt = jpgFil.Read(1)
Select Case i
Case 1,2,3,4,6,7,9,10,12,13,15,16,18,19
If AscB(midb(byt,1))=>48 And AscB(midb(byt,1))=<57 Then
binData(i) = Chr(AscB(midb(byt,1)))
Else
i = 0
End If
Case 5,8,14,17
If Chr(AscB(midb(byt,1)))=":" Then
binData(i) = Chr(AscB(midb(byt,1)))
Else
i = 0
End If
Case 11
If Chr(AscB(midb(byt,1)))=" " Then
binData(i) = Chr(AscB(midb(byt,1)))
Else
i = 0
End If
End Select
If Flag=0 And i=19 Then
i = 0
Flag = 1
ElseIf Flag=1 And i=19 Then
Exit Do
End If
Loop
jpgFil.Close
jpgdateStr = ""
For i=1 To 19
If i<10 And binData(i) = ":" Then
binData(i) = "/"
End If
jpgdateStr = jpgdateStr & binData(i)
Next
jpgDate = DateAdd("s", Offset, CDate(jpgdateStr))
funcExifTimeGet = CStr(jpgDate)
End Function
'--------------------------------------------
'JPEG画像リサイズ コマンドラインから実行できる「photoshifter」を使ってリサイズ
'--------------------------------------------
Sub subJpgResize()
Set WshShell = CreateObject("WScript.Shell")
exeFile = toolPath & "\photoshifter\photoshifter.exe"
setFile0 = toolPath & "\photoshifter\mysetting0.xml" '横1024ピクセル
outPath0 = testPath & "\img\"
'jpgData(i,j) j: 0=jpgFullPath 1=ファイル名 2=title 3=coment 4=マーカー 5=撮影time(2018/09/16 9:25:30) 6=noResize
Set reg = New RegExp '正規表現を使えるようにする
reg.Global = True '全行検索
For i=0 To 19
reg.Pattern = "\.JPG|\.jpg|\.png|\.gif"
If reg.Test(jpgData(i,0)) Then 'jpg|png|gifなら・・・
copyFileStr = exeFile & " /overwrite /par " & setFile0 & " /format JPEG /file " & """" & jpgData(i,0) & """ " & outPath0 & jpgData(i,1)
Call WshShell.Run (copyFileStr,,True)
End If
reg.Pattern = "\.mp4"
If reg.Test(jpgData(i,0)) Then 'mp4なら・・・
Call objFso.CopyFile(jpgData(i,0), outPath0 & jpgData(i,1), True) 'ファイルを［test］にコピー
End If
Next
Set WshShell = Nothing
End Sub
'-------------------------------------------------
'Map一覧作成
'-------------------------------------------------
Sub createMapIndex()
shinFile = rootPath & "\index.html" '作成する新ファイル
hinaFile = tmplPath & "\index.html" 'Templateファイル
Set objFolder = objFso.GetFolder(rootPath) 'C:\Users\Owner\Documents\Map
Set colFolders = objFolder.SubFolders
Dim lstArr(999,7) 'リストの配列 999個まで登録可
i = 0
For Each objSubFolder in colFolders
dateFol = objSubFolder.Name
If dateFol = "common" Then Exit For
dataFile = rootPath & "\" & dateFol & "\data.txt"
With CreateObject("ADODB.Stream")
.Charset = "Shift_JIS"
.Open
.LoadFromFile(dataFile)
txIn = .ReadText
.Close
End With
Arr = Split(txIn, vbCrLf)
Arr(0) = Right("20" & Arr(0), 4) '年（4桁）
Arr(1) = Right("0" & Arr(1), 2) '月（2桁）
Arr(2) = Right("0" & Arr(2), 2) '日（2桁）
For j = 0 To 6
lstArr(i, j) = Arr(j)
Next
lstArr(i,7) = Arr(0) & Arr(1) & Arr(2) '年月日（20240910）
i = i+1
Next
lstMax = i-1
' Call QuickSort2(lstArr, 7, LBound(lstArr), UBound(lstArr), "Des") '一覧リストソート(降順)'ソートをしないことにした（24.09.18）
With CreateObject("ADODB.Stream") 'UTF-8で全文読込
.Charset = "UTF-8"
.Open
.LoadFromFile(hinaFile)
txOut = .ReadText
.Close
End With
lstStr = "<!-- mapList -->" & vbCrLf
For i=0 To lstMax '日付フォルダーList読込
If lstArr(i,7) <> "" Then
Str4 = categoArr(lstArr(i,4)) 'カテゴリー名
lstStr = lstStr & String(4, vbTab) & "<tr title=""0," & lstArr(i,4) & """ data-href=""" & lstArr(i,3) & "/map.html""><td>" & lstArr(i,0) & "." & lstArr(i,1) & "." & lstArr(i,2) & "</td><td>" & Str4 & "</td><td>" & lstArr(i,5) & "</td><td>" & lstArr(i,6) & "</td><tr>" & vbCrLf
End If
Next
lstStr = lstStr & String(4, vbTab) & "<!-- /mapList -->"
txOut = Replace(txOut, "<!-- mapList -->", lstStr) 'Map一覧書き換え
Call WriteUTF8(txOut, shinFile)
End Sub
'--------------------------------------------
'UTF8で書込む
'--------------------------------------------
Sub WriteUTF8(text, fileName)
tmpFile = fileName & ".tmp"
' UTF-8で書きこむと自動的にBOM(Byte Order Mark)が、先頭に3バイト付加されてしまう。
' それを回避するため、一旦一時ファイルにUTF-8形式で書き込む
With CreateObject("ADODB.Stream")
.Type = 2
.charset = "UTF-8"
.Open
.WriteText text
.SaveToFile tmpFile, 2
.Close
End With
' 一時ファイルをバイナリで読み取る
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.LoadFromFile(tmpFile) '一時ファイルをバイナリで読み取る
.Position = 3 'BOMの3バイトを読み飛ばす
'4バイト目から出力ファイルにバイナリで書き込む
Dim ws : Set ws = CreateObject("ADODB.Stream")
ws.Type = 1
ws.Open
ws.Write(.Read(-1))
ws.SaveToFile fileName, 2
ws.Close
.Close
End With
' 一時ファイルの削除
Call CreateObject("Scripting.FileSystemObject").DeleteFile(tmpFile)
End Sub
'----------------------------------------------------------------------------------
'クイックソート(配列データ, 配列データ最小インデックス, 配列データ最大インデックス), 昇・降順別"As"/"Des" '使ってないけど使うかもしれないと思って残している
'----------------------------------------------------------------------------------
Sub QuickSort(vntSortData(), lngMin, lngMax, asdes)
Dim lngIdxL '左側のインデックス
Dim lngIdxR '右側のインデックス
Dim vntKijunChi '中央付近の基準値
Dim vntWk 'スワップの作業領域
vntKijunChi = vntSortData((lngMin + lngMax) \ 2) '中央付近のインデックス内容値を基準値とする
lngIdxL = lngMin '最小インデックスをセット
lngIdxR = lngMax '最大インデックスをセット
Do
For lngIdxL = lngIdxL To lngMax Step 1 '配列のインデックスの小さい方から基準値に向かって、インデックス内容値が基準値より大きい値かイコールな値を探す
If asdes = "As" Then
If (vntSortData(lngIdxL) >= vntKijunChi) Then '*1：降順は『>=』を『<=』 にする
Exit For
End If
Else
If (vntSortData(lngIdxL) <= vntKijunChi) Then '*1：降順は『>=』を『<=』 にする
Exit For
End If
End If
Next
For lngIdxR = lngIdxR To lngMin Step -1 '配列のインデックスの大きい方から基準値に向かって、インデックス内容値が基準値より小さい値かイコールな値を探す
If asdes = "As" Then
If (vntSortData(lngIdxR) <= vntKijunChi) Then '*2：降順は『<=』を『>=』 にする
Exit For
End If
Else
If (vntSortData(lngIdxR) >= vntKijunChi) Then '*2：降順は『<=』を『>=』 にする
Exit For
End If
End If
Next
If lngIdxL >= lngIdxR Then '最小インデックスと最大インデックスが同じか大きくになったらブレイクDOループ
Exit Do 'この段階で、基準値より小さな値が基準値より左に、大きな値が基準値より右にきている（昇順の場合）
End If
vntWk = vntSortData(lngIdxL) '双方の値を交換
vntSortData(lngIdxL) = vntSortData(lngIdxR)
vntSortData(lngIdxR) = vntWk
lngIdxL = lngIdxL + 1 '配列のインデックスの小さい方から基準値に向かってのインデックスを更新する
lngIdxR = lngIdxR - 1 '配列のインデックスの大きい方から基準値に向かってのインデックスを更新する
Loop
If (lngMin < lngIdxL - 1) Then '左の配列の処理が必要か
QuickSort vntSortData, lngMin, lngIdxL - 1, asdes '基準値の左の配列に対してのソート処理を行う（再帰処理）
End If
If (lngMax > lngIdxR + 1) Then '右の配列の処理が必要か
QuickSort vntSortData, lngIdxR + 1, lngMax, asdes '基準値の右の配列に対してのソート処理を行う（再帰処理）
End If
End Sub
'----------------------------------------------------------------------------------
'ニ元配列のクイックソート(配列名, ソート対象0から始まる列番号, ソート行範囲最初行番号, ソート行範囲最終行番号, 昇・降順別"As"/"Des")
'----------------------------------------------------------------------------------
' 【 qsortBinaryArray.vbs 】 - ニ元配列のクイックソート
' http://tuka.s12.xrea.com/index.xcg?p=VBS#p16
' (一元配列のクイックソート）を変更
' ソート行範囲を指定できるので、CSVなど最初行が項目名の
' 二元配列のソートに便利である。
'
' Dim sB, sE, sF
' Dim qA(4,3)
' qA(0,0)=" A": qA(0,1)=" B": qA(0,2)=" C": qA(0,3)=" D"
' qA(1,0)=22: qA(1,1)=34: qA(1,2)=45: qA(1,3)=56
' qA(2,0)=23: qA(2,1)=33: qA(2,2)=43: qA(2,3)=55
' qA(3,0)=24: qA(3,1)=32: qA(3,2)=42: qA(3,3)=54
' qA(4,0)=25: qA(4,1)=31: qA(4,2)=44: qA(4,3)=53
'sB =dispArray(qA)
'行0を除いた範囲で列1で昇順にソート
'Call quicksort(qA, 1, 1, UBound(qA), "As")
'sE =dispArray(qA)
'行0を除いた範囲で列2で降順にソート
'Call quicksort(qA, 2, 1, UBound(qA), "Des")
'sF =dispArray(qA)
'msgbox sB & vbCrlf & sE & vbCrlf & sF
Sub quicksort2(sqa, col, first, last, sort) 'クイックソート本体(昇順降順）（再帰）
' sqa:配列名
' col:ソート対象0から始まる列番号
' first:ソート行範囲最初行番号
' last:ソート行範囲最終行番号
' sort:昇・降順別 "As"/"Des"と文字列を記述する。
Dim point, f, l, m, wk
point = sqa(first,col)
f = first: l = last
Do
If sort = "As" then
While (sqa(f,col) < point)
f = f + 1
Wend
While (sqa(l,col) > point)
l = l - 1
Wend
Else
While (sqa(f,col) > point)
f = f + 1
Wend
While (sqa(l,col) < point)
l = l - 1
Wend
End if
If (f >= l) Then Exit Do
'tmp = sqa(f): sqa(f) = sqa(l): sqa(l) = tmp
For m = 0 to UBound(sqa,2)
wk = sqa(f,m)
sqa(f, m) = sqa(l, m)
sqa(l, m) = wk
Next
f = f + 1
l = l - 1
Loop
If first < f - 1 Then quicksort2 sqa, col, first, f - 1, sort
If l + 1 < last Then quicksort2 sqa, col, l + 1, last, sort
End Sub
'配列内容を表示する
Function dispArray(qD)
Dim i, j, sA
For i = 0 To UBound(qD, 1)
For j = 0 To UBound(qD, 2)
sA = sA + CStr(qD(i, j)) & ", "
Next
sA = Left(sA, Len(sA)-2) '末尾の,を削除
sA = sA & vbCrLf
Next
sA = sA & vbCrLf
dispArray = sA
End Function
</script>
ここまでは、VBScript ですが、これ以降は Javascript です。
撮影位置計算は、画像内に埋め込まれているExif情報の撮影時刻とGPXの時刻情報とを照合して、最も近い時刻の位置情報を撮影地点とするものです。（GPXは数秒間隔でログを取っていますから、撮影時刻にピッタリ一致するということは、ほぼ期待できませんから最も近い時刻を探し出して、それを撮影ポイントとします。GPXの記録間隔が数秒ですから位置の誤差は2～3ｍ程度です）
ヒューベニの公式については、過去のページにちょっとだけ詳しく書いていますから、ご覧ください。
<script language="Javascript">
//--------------------------------------------
// 撮影位置計算
//--------------------------------------------
function createCameraPoint(){
gpxPath2 = "file:///" + gpxPath.replace(/\\/g, "\/");
var dateStr, timeStr, jst;
var stime = new Array();
var gtime = new Array();
var gdist = new Array();
var sstr = new Array();
var gstr = new Array();
var gpsPoints = new Array();
var camPoints = new Array();
var seglen;
//GPXのデータを取得する
$.get(gpxPath2, function(xml){
var seg = $("trkseg", xml);
//切れているログを処理
var trkpt, lat, lng, i, j, ele, gmt, utc, gpsTime, jpgTime, dt, diffTime, mySt, myGl, Od, Ev
var lat1 = "";
var lat2 = "";
var lng1 = "";
var lng2 = "";
var dist1 = 0;
var dist2 = 0;
seglen = seg.length;
for (n = 0; n < seg.length; n++) {
if (seglen > 1) {
mySt = "区間" + (n+1) + " start";
myGl = "区間" + (n+1) + " goal";
} else {
mySt = "start";
myGl = "goal";
}
Od = (n+1) * 2;
Ev = (n+1) * 2 - 1;
mkMax = mkLen + seglen * 2;
var gpx = $("trkpt", seg[n]);
//mkData(i,x) x: 0=lat 1=lon 2=ファイル名 3=撮影Time(utc) 4=高度 5=title 6=coment 7=移動距離(km) 8=撮影Time(m秒) 9=DiffTime(仮の撮影Time)
//受け取った結果から緯度経度データを取り出し、配列に格納
for (i = 0; i < gpx.length; i++) {
if (i==0) {
lat1 = "";
lat2 = "";
lng1 = "";
lng2 = "";
dist1 = 0;
dist2 = 0;
}
lat = $(gpx[i]).attr("lat"); //<trkpt lat="yyy" lon="xxx">からyyy,xxxを取り出す
lng = $(gpx[i]).attr("lon");
ele = $(gpx[i]).find("ele").text();
gmt = $(gpx[i]).find("time").text(); //2015-08-01T21:42:44Z
gpsTime = gpsTime2JSTtimeStr(gmt); //9時間プラスした日本標準時、2015/8/2 6:42:44 表示
gpsTmm = new Date(gpsTime).getTime();
lat1 = lat;
lng1 = lng;
if (lat1 != "" && lat2 !=""){
dist1 = hubeny(lat1, lng1, lat2, lng2); //gpsポイント間の距離
}
dist2 += dist1; //ポイント間の距離の累積値
lat2 = lat1;
lng2 = lng1;
for (j=0; j <= mkLen; j++) {
var myTime = new Date(mkData(j,3)).getTime();
diffTime = Math.abs(gpsTmm - myTime);
if (mkData(j,9) > diffTime) {
mkData(j,9) = diffTime;
mkData(j,0) = lat;
mkData(j,1) = lng;
mkData(j,4) = Math.round(ele);
mkData(j,7) = dist2; //ポイントまでの距離
mkData(j,8) = myTime; //Time（mm秒）
}
}
if (i == 0) {
mkData(mkLen+Ev,0) = lat;
mkData(mkLen+Ev,1) = lng;
mkData(mkLen+Ev,2) = "";
mkData(mkLen+Ev,3) = gpsTime2gpsTimeHmmssStr(gpsTime);
mkData(mkLen+Ev,4) = Math.round(ele);
mkData(mkLen+Ev,5) = mySt;
mkData(mkLen+Ev,7) = dist2; //ポイントまでの距離
mkData(mkLen+Ev,8) = new Date(gpsTime).getTime(); //utc（mm秒）
}
if (i == gpx.length-1) {
mkData(mkLen+Od,0) = lat;
mkData(mkLen+Od,1) = lng;
mkData(mkLen+Od,2) = "";
mkData(mkLen+Od,3) = gpsTime2gpsTimeHmmssStr(gpsTime);
mkData(mkLen+Od,4) = Math.round(ele); //高度
mkData(mkLen+Od,5) = myGl;
mkData(mkLen+Od,7) = dist2; //ポイントまでの距離
mkData(mkLen+Od,8) = new Date(gpsTime).getTime(); //utc（mm秒）
}
gpsPoints.push(lat, lng, ele, gpsTime, gpsTmm, dist2);
}
}
});
var wtime = 0;
var wdist = 0;
for (n=0; n < seglen; n++ ){
wtime += (mkData(mkLen+(n+1)*2,8) - mkData(mkLen+(n+1)*2-1,8))/1000; //ウォークタイム（秒）
wdist += mkData(mkLen+(n+1)*2,7);
}
walkDist = wdist;
walkTime = parseInt(wtime/3600,10) + "：" + ("0" + parseInt((wtime % 3600)/60,10)).slice(-2); //歩いた時間（セグメント時間の累計）
return mkMax;
}
// GPX形式TimeをJSTタイムに書き換える (例)2015-08-01T21:42:44Z → [JSTStr] "2015/08/02 6:42:44"
function gpsTime2JSTtimeStr(s){
var t = s.replace(/-/g,"/");
t = t.replace(/T/," ");
t = t.match(/^\d{4}\/\d{2}\/\d{2}\s\d{2}:\d{2}:\d{2}/);
var d = new Date(t);
d = new Date(d.setHours(d.getHours() + 9)); //日本標準にするため9時間プラス
d = d.toLocaleString(); //2015年8月2日 6:42:44 形式
d = d.replace(/年|月/g,"/");
d = d.replace(/日/g,""); //2015/8/2 6:42:44
return (d);
}
// JSTタイムから h:mm:ss 形式を得る (例)[JSTStr] "2015/08/02 6:42:44" → 6:42:44
function gpsTime2gpsTimeHmmssStr(s){
var d = new Date(s);
// d = new Date(d.setSeconds(d.getSeconds() + 30)); //秒を四捨五入するために30秒加算
var hmm = d.getHours() + ":" + d.getMinutes() + ":" + d.getSeconds();
return (hmm);
}
// 日付形式を書き換える DDMMYY形式 (例)1994年11月19日 → [NMEA]191194 → [dateStr] "1994/11/19"
function gpsDate2dateStr(s){
var yy = s.substr(0,4);
var mm = s.substr(5,2);
var dd = s.substr(8,2);
return (yy + '/' + mm + '/' + dd);
}
// 時刻形式を書き換える hhmmss形式 (例)22:54:46 → [NMEA] 225446.000 → [timeStr] "22:54:46" (例)8:54:46 → [NMEA] 85446.000 → [timeStr] " 8:54:46"
function gpsTime2timeStr(s){
var pos = s.indexOf(":");
var hh = s.substr(pos-2, 2);
var mm = s.substr(pos+1, 2);
var ss = s.substr(pos+4, 2);
return (hh + ':' + mm + ':' + ss);
}
function dateTimeStr2dateJST(dateStr,timeStr){
var d = new Date(dateStr + ' ' + timeStr);
return d;
}
//--------------------------------------------
// 移動距離計算 ヒュベニの公式（URL=yamadarake.jp/trdi/report000001.html と URL=tech-blog.s-yoshiki.com/2018/05/92/ を参考にしました）
//--------------------------------------------
function hubeny(lat1, lng1, lat2, lng2) {
function rad(deg) {
return deg * Math.PI / 180; //degreeをラジアンに変換
}
lat1 = rad(lat1);
lng1 = rad(lng1);
lat2 = rad(lat2);
lng2 = rad(lng2);
var latDiff = lat1 - lat2; // 緯度差
var lngDiff = lng1 - lng2; // 経度差
var latAvg = (lat1 + lat2) / 2.0; // 緯度の平均
var a = 6378137.0; // 赤道半径（WGS84系）
var b = 6356752.314245; // 極半径（WGS84系）
var e2 = 0.00669437999019758; // 第一離心率^2 e^2 = (a^2 - b^2) / a^2
var a1e2 = 6335439.32729246; // 赤道上の子午線曲率半径 a(1 - e^2)
var sinLat = Math.sin(latAvg);
var W2 = 1.0 - e2 * (sinLat * sinLat);
var M = a1e2 / (Math.sqrt(W2) * W2); // 子午線曲率半径M
var N = a / Math.sqrt(W2); // 卯酉線（ぼうゆうせん）曲率半径N
t1 = M * latDiff;
t2 = N * Math.cos(latAvg) * lngDiff;
return Math.sqrt((t1 * t1) + (t2 * t2));
}
</script>
コードは以上です。VBScript の部分は、余りにも古いので参考にはならないと思いますが、JavaScriptの部分は多少は参考になるかも？ と思います。