国土数値情報は，建設省国土地理院が構築した国土に関する数値情報である．
国土情報の数値化にあたり，日本の国土をメッシュ区分した1次メッシュコードを与えている（例えば仙台付近のメッシュには5740というコードが与えられている）．地形情報は，これらのメッシュをさらに細区分し，そのメッシュの交点についての高度を，数値標高モデル（DEM)データとして提供している．現段階では，1kmメッシュ，250m，50m等の地形情報が日本地図センターより数値地図として販売されている．
この講義では，これらの数値情報をもとにした画像処理技術について学ぶものとする．
作成されるプログラムのイメージを図-1に示す．
国土数値情報は定められた形式のデータとして提供される．その仕様は以下の通りである
弘前（6040.SEM)
国土数値情報の仕様
ここでは以下の２つのメッシュの標高データを用いる．
仙台（5740.SEM） データの入手方法については蒔苗まで．．
３．画像ファイルからのデータの読み込みと表示
これらの地形のデジタル情報をコンピュータディスプレイ上で可視化することを考える．
提供される高度情報は南北方向等間隔の格子である．これは画像を取り扱う場合のピクセルと同じである．
そこで高度の情報をそのまま色情報に置きかえればよい．
しかしコンピュータ上で扱う色情報は，RGBそれぞれ255階調であり，一方，高度の情報はメートル単位であり，メッシュ内の高度は0mからその図副内の最高高度（例えば1625m）までの範囲である．ここでは，高度情報をグレースケール（すなわちRGBが等値であると考える）とし，その図幅内の高度を255段階に分類することを考える．
それは以下の式で表現される．高度を表現するための階調＝対象ポイントの高度×（255/最高高度）
この式により階調数は0〜255までの範囲に置きかえることができる．実際にはこれを整数化する必要があるが，VB上のRGB関数は整数でなくても受け付けるので，このままRGBを等値として，RGB関数に与えてやればよい．
注）ただし海は-9999と扱われているので，除外して色を任意に与える必要がある．実際の処理フローは以下の手順ｊによって行なう
1)ファイルのOPEN処理
2)ファイルのヘッダー情報の読み取り（高度，横方向データ数，縦方向データ数）
3)データの2次元配列への読み込み及び図幅内の最高高度を探す処理を同時に行う．
4)高度係数（255/最高高度)の計算
5)ピクチャボックスへのピクセル単位での描画処理（Pset関数）
４．フィルタ処理
高度情報を読み込んで表示した画像に対するフィルタ処理を行ない，新しい画像の生成を行う．
（フィルタ処理については第４回の授業の資料を参照してください．）
フィルタ処理を行なう配列を定義し，これにフィルタとなる数値を設定する．表示された画像とそれぞれ掛け合わせる演算処理をプログラムする．なお，ここではフィルタの数値の設定はテキストボックスに入れた数値を利用するものとしている．
その計算結果を同時にもうひとつのピクチャボックスへ出力するという処理を行なう．５．実際のプログラム
1)Form1の構成
図-2参照
2)ソースコード
Option Explicit
Dim xSize As Integer
Dim ySize As Integer
Dim stopFlag As Boolean
Dim Altitude() As Integer '高度を格納するための動的配列（配列をプログラム内で定義できる）Sub Form_Load() 'プログラム読み込み時の初期化
Picture1.BackColor = &H0
Picture1.ScaleMode = vbPixels
Picture2.BackColor = &H0
Picture2.ScaleMode = vbPixels
End Sub
Private Sub Command1_Click()
Dim buf As String '文字列の宣言（文字列は個別に宣言しておく）
Dim mapName As String '文字列の宣言
Dim m As Integer
Dim n As Integer
Dim k As Integer
Dim j As Integer
Dim max As Integer '単精度整数の宣言'
Dim color As Long '倍精度整数の宣言
Dim colorScale As Single '単精度浮動小数点の宣言
Dim h As Single '単精度浮動小数点の宣言
Picture1.BackColor = &H0
Picture1.ScaleMode = vbPixels
'ファイルを#1として開く
'
'ファイル名がわかっている場合には以下のように打ち込む
'
' Open "R:\DATA\250M\6040.sem" For Input As #1
'
'しかし，汎用性がないので, ここではCommonDialogControlを
'用いる．
'CommonDialogControlはプロジェクト>>コンポーネントの中の
'Microsoft Common Dialog Controlのチェックボックスに
'チェックすればコントロールウィンドウに追加されるので，
'それをForm1上に貼り付けておく．
CommonDialog1.filter = "数値地図|*.sem;*.tem;*.mem" '拡張子でフィルタする
CommonDialog1.ShowOpen 'コモンダイアログコントロールを開く
Open CommonDialog1.filename For Input As #1 '得られたファイルを#1で開く
Form1.Refresh 'Form1の描画をrefresh
Input #1, buf '最初の１行のデータを変数bufに読み込む
mapName = Mid$(buf, 59, 20) '図幅名を得る
xSize = Val(Mid$(buf, 24, 3)) '横方向のデータ数を得る
ySize = Val(Mid$(buf, 27, 3)) '縦方向のデータ数を得る
Text1.Text = mapName 'Text1のボックスに図幅名を表示する．
ReDim Altitude(xSize-1, ySize-1) '配列の再定義
'データを読み込む
max = 0
For n = 0 To ySize - 1
If EOF(1) Then Exit For 'ファイルが終わりだったらFOR..Nextから抜ける
Input #1, buf
For m = 0 To xSize - 1
Altitude(m, n) = Val(Mid$(buf, m * 5 + 10, 5))/10 'VAL関数で数値化
'高度は小数点無しで0.1m単位で入っているので注意
If Altitude(m, n) > max Then max = Altitude(m, n)
Next
Next
Close #1
colorScale = 255 / max '図副内の最高点が255となるような係数を計算する
For n = 0 To ySize - 1
For m = 0 To xSize - 1
h = Altitude(m, n)
If h < 0 Then '海は-9999で表現されるので，それを青で描く
color = RGB(0, 0, 255)
Else
color = RGB(h * colorScale, h * colorScale, h * colorScale)
End If
Picture1.PSet (m, n), color
Next
Next
End SubPrivate Sub command2_click()
Call drawFilter
End SubPrivate Sub drawFilter() 'フィルタ計算を行ない，その結果をPicture2に表示
Dim j As Integer, k As Integer, m As Integer, n As Integer, sumR As Integer, sumG As Integer, sumB As Integer
Dim filter(-1 To 1, -1 To 1) As Single 'フィルタの配列
Dim enbosBase As Integer 'エンボスのベース
enbosBase = 128 'エンボスのベースとなる色
'テキストボックスの数値をフィルタにセットする
filter(-1, -1) = Text2(0).Text
filter(0, -1) = Text2(1).Text
filter(1, -1) = Text2(2).Text
filter(-1, 0) = Text2(3).Text
filter(0, 0) = Text2(4).Text
filter(1, 0) = Text2(5).Text
filter(-1, 1) = Text2(6).Text
filter(0, 1) = Text2(7).Text
filter(1, 1) = Text2(8).Text
For n = 1 To ySize - 1
For m = 1 To xSize - 1
sumR = 0: sumG = 0: sumB = 0
For k = -1 To 1
For j = -1 To 1
sumR = getR(Picture1.Point(m + k, n + j)) * filter(k, j) + sumR
sumG = getG(Picture1.Point(m + k, n + j)) * filter(k, j) + sumG
sumB = getB(Picture1.Point(m + k, n + j)) * filter(k, j) + sumB
Next
Next
DoEvents '途中でマウス操作を検知させる
If stopFlag = True Then 'Command4ボタンが押されたらキャンセル
stopFlag = False
Exit Sub
End If
'間違ってRGB()に負の値が入るとエラーが生じるので以下の3行
If sumR < 0 Then sumR = 0
If sumG < 0 Then sumG = 0
If sumB < 0 Then sumB = 0
'Picture2に計算結果を表示
Picture2.PSet (m, n), RGB(sumR + enbosBase, sumG + enbosBase, sumB + enbosBase)
Next
Next
End SubPrivate Sub Command3_Click() '計算の中断処理
stopFlag = 1
MsgBox "Cancelされました"
End SubPublic Function getR(color As Long) 'Longの整数からR成分を抜き出す関数を設定
getR = color And &HFF&
End FunctionPublic Function getG(color As Long) 'Longの整数からG成分を抜き出す関数を設定
getG = (color And &HFF00&) / &H100&
End FunctionPublic Function getB(color As Long) 'Longの整数からB成分を抜き出す関数
getB = (color And &HFF0000) / &H10000
End Function
'オプション
'
'画像の入れ替え，保存をする場合には，あらかじめ
'Picture1,2のAutoRedrawをTrueにしておかなければ
'ならない．画像情報をメモリ上に蓄積するため，処理は
'極めて遅くなる'画像の入れ替え
Private Sub Command4_Click()
Picture1.Picture = Picture2.Image
End Sub'画像の保存 .BMP形式のみサポート
Private Sub Command5_Click() '
SavePicture Picture1.Image, "map1.bmp"
SavePicture Picture2.Image, "mapf1.bmp"
MsgBox "2枚の画像はmap1.bmp, mapf2.bmpに保存されました"
End Sub
