Converting between world and tile file names

World files have names with two numbers such as w-012489+014772.w and tile files have encoded names such as -01a4d768.t.

Code to convert world to tile file names

    function WorldNameToTileName(world)
      Dim x,z
      Dim tile
      if len(world) = 15 then
        x = mid(world,2,7)
        z = mid(world,9,7)
        If IsNumeric(x) And IsNumeric(z) then
          tile = WorldNamesToTileName(x,z)
        end if
      end if
      WorldNameToTileName = tile
    end function
    function WorldNamesToTileName (x,z)
      dim tile
      dim m
      dim wx,wz
      dim qx,qz,q
      dim i

      tile = 0
      m = 1
      wx = CInt(x) + 16384
      wz = CInt(z) + 16384
      for i = 0 to 14
        m = m * 4
        qx = wx and 1
        wx = CInt(wx \ 2)
        qz = wz and 1
        wz = CInt(wz \ 2)
        if qx = 1 then
          if qz = 1 then
            q = 1
          else
            q = 2
          end if
        else
          if qz = 1 then
            q = 0
          else
            q = 3
          end if
        end if
        tile = tile + (m * q)
      next
      WorldNamesToTileName = "-" & Right("0000000" & LCase(Hex(tile)),8)
    end Function

Code to convert tile to world file name

function TileNameToWorldName(sTileName)
    on error resume next
    dim x
    dim z
    dim m
    dim sTile
    dim tile
    dim q ' quandrant encoded in two bits NW=0, NE=1, SE=2, SW=3
    dim i
    dim sWorldName

    if left(sTileName,1) = "-" and len(sTileName) = 11 then
        sTile = mid(sTileName,2,8)
        tile = CLng("&h" & sTile) ' error occurs if file name includes non-hex characters
        if Err.Number = 0 then
            x = -16384
            z = -16384
            m = 1
            for i = 0 to 14
                tile = CLng(tile \ 2) ' shift 2 bits right
                tile = CLng(tile \ 2)
                q = tile and 3 ' extract right 2 bits
                if q = 1 or q = 2 then ' east quads NE and SE
                    x = x + m
                end if
                if q = 0 or q = 1 then ' north quads NW and NE
                    z = z + m
                end if
                m = m * 2
            next
            sWorldName = "w"
            if x < 0 then
                sWorldName = sWorldName & "-"
            else
                sWorldName = sWorldName & "+"
            end if
            sWorldName = sWorldName & right("00000" & Abs(x), 6)
            if z < 0 then
                sWorldName = sWorldName & "-"
            else
                sWorldName = sWorldName & "+"
            end if
            sWorldName = sWorldName & right("00000" & Abs(z), 6)
        else
            sWorldName = "ERROR: Invalid character in tile name."
            Err.Clear
        end if
    else
        sWorldName = "ERROR: Not a fully divided tile."
    end if
    TileNameToWorldName = sWorldName
end function

Leave a Reply