フォームモジュールの内容



Option Compare Database
Option Explicit

Private pintCurPage As Integer    'カレントページのカウンタ

Private Sub cmd次ページ_Click()
'[次の10件]ボタンクリック時

  '表示するページ番号をインクリメント
   pintCurPage = pintCurPage + 1
  
  'マップの表示処理
  cbfRefreshMap True

End Sub

Private Sub cmd先頭_Click()
'[先頭へ]ボタンクリック時

  '表示するページ番号を初期化
   pintCurPage = 1
  
  'マップの表示処理
  cbfRefreshMap True
  
End Sub

Private Sub cmd前ページ_Click()
'[前の10件]ボタンクリック時

  '表示するページ番号をデクリメント
   pintCurPage = pintCurPage - 1
  
  'マップの表示処理
  cbfRefreshMap True
     
End Sub

Private Sub マップ中心住所_AfterUpdate()
'マップ中心住所の更新後処理

  'マップの表示処理
  cbfRefreshMap True
  
End Sub

Private Sub マップ縮尺_AfterUpdate()
'マップ縮尺の更新後処理

  'マップの表示処理
  cbfRefreshMap True
  
End Sub

Private Sub Form_Load()
'フォーム読み込み時

  'WebブラウザコントロールのURLを設定
  Me!wbマップ.ControlSource = "=""" & CurrentProject.Path & "\index.html"""
  
  '表示するページ番号を初期化
   pintCurPage = 1
   
  'マップの表示処理
  cbfRefreshMap False

End Sub

Private Sub cbfRefreshMap(blnRefreshFlg As Boolean)
'マップの表示処理

  Dim cnn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim strm As New ADODB.Stream
  Dim strSQL As String
  Dim strData As String
  Dim intRecordCnt As Integer
  
  If pintCurPage < 1 Then
    Beep
    MsgBox "先頭ページです!", vbOKOnly + vbExclamation
    pintCurPage = 1
    Exit Sub
  End If
  
  'テーブルからマーカーの住所情報を取得して組み立て
  Set cnn = CurrentProject.Connection
  With rst
    strSQL = "SELECT 名前, 住所 FROM tbl住所情報 ORDER BY ID"
    .Open strSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
    .PageSize = 10                '1回当りの表示件数
    If pintCurPage > .PageCount Then
      '総ページ数を超えているとき
      Beep
      MsgBox "最終ページです!", vbOKOnly + vbExclamation
      pintCurPage = pintCurPage - 1
     .Close: Set rst = Nothing
      cnn.Close: Set cnn = Nothing
      Exit Sub
    End If
    .AbsolutePage = pintCurPage   '今回表示するページ番号
    strData = ""
    For intRecordCnt = 1 To .PageSize
      If .EOF Then Exit For
      strData = strData & _
                  IIf(Len(strData) > 0, "," & vbCrLf, "") & _
                  "['" & !住所 & "','" & !名前 & "', 1]"
      .MoveNext
    Next intRecordCnt
    .Close: Set rst = Nothing
  End With
  cnn.Close: Set cnn = Nothing

  '画面より中心住所と縮尺を取得して組み立て
  strData = "var mapzoom = " & Nz(Me!マップ縮尺, 10) & ";" & vbCrLf & _
              "var places = [" & vbCrLf & _
              "['" & Me!マップ中心住所 & "', """", 0]," & vbCrLf & _
              strData & vbCrLf & _
              "];" & vbCrLf

  '組み立てたデータをmapdata.jsに書き出し
  With strm
    .Charset = "UTF-8"
    .Open
    .WriteText strData
    .SaveToFile CurrentProject.Path & "\mapdata.js", adSaveCreateOverWrite
    .Close: Set strm = Nothing
  End With
  
  'Webブラウザコントロールを最新情報に更新
  If blnRefreshFlg Then
    Me!wbマップ.Refresh
  End If

End Sub







Copyright © T'sWare All rights reserved