@@ -313,7 +313,7 @@ Public Function OLCRecoverNearest(ByVal code As String, ByVal latitude As Double
313
313
ElseIf Not OLCIsShort(code) Then
314
314
Err.raise vbObjectError + 513 , "OLCDecode" , "Invalid code"
315
315
Else
316
- Dim lat, lng, resolution, toEdge, diff As Double
316
+ Dim lat, lng, resolution, halfRes As Double
317
317
Dim paddingLength As Integer
318
318
Dim codeArea As OLCArea
319
319
' Ensure that the latitude and longitude are valid.
@@ -324,26 +324,25 @@ Public Function OLCRecoverNearest(ByVal code As String, ByVal latitude As Double
324
324
' The resolution (height and width) of the padded area in degrees.
325
325
resolution = ENCODING_BASE_ ^ (2 - (paddingLength / 2 ))
326
326
' Distance from the center to an edge (in degrees).
327
- toEdge = resolution / 2 #
327
+ halfRes = resolution / 2
328
328
' Use the reference location to pad the supplied short code and decode it.
329
329
codeArea = OLCDecode(Mid(OLCEncode(lat, lng), 1 , paddingLength) + code)
330
330
' How many degrees latitude is the code from the reference? If it is more
331
- ' than half the resolution, we need to move it east or west.
332
- diff = codeArea.LatCenter - lat
333
- If diff > toEdge Then
334
- ' If the center of the short code is more than half a cell east ,
335
- ' then the best match will be one position west .
331
+ ' than half the resolution, we need to move it nort or south but keep it
332
+ ' within -90 to 90 degrees.
333
+ If lat + halfRes < codeArea.LatCenter And codeArea.LatCenter - resolution > LATITUDE_MAX_ Then
334
+ ' If the proposed code is more than half a cell north of the reference location ,
335
+ ' it's too far, and the best match will be one cell south .
336
336
codeArea.LatCenter = codeArea.LatCenter - resolution
337
- ElseIf diff < -toEdge Then
338
- ' If the center of the short code is more than half a cell west ,
339
- ' then the best match will be one position east .
337
+ ElseIf lat - halfRes > codeArea.LatCenter And codeArea.LatCenter + resolution < LATITUDE_MAX_ Then
338
+ ' If the proposed code is more than half a cell south of the reference location ,
339
+ ' it's too far, and the best match will be one cell north .
340
340
codeArea.LatCenter = codeArea.LatCenter + resolution
341
341
End If
342
342
' How many degrees longitude is the code from the reference?
343
- diff = codeArea.LngCenter - lng
344
- If diff > toEdge Then
343
+ If lng + halfRes < codeArea.LngCenter Then
345
344
codeArea.LngCenter = codeArea.LngCenter - resolution
346
- ElseIf diff < -toEdge Then
345
+ ElseIf lng - halfRes > codeArea.LngCenter Then
347
346
codeArea.LngCenter = codeArea.LngCenter + resolution
348
347
End If
349
348
OLCRecoverNearest = OLCEncode(codeArea.LatCenter, codeArea.LngCenter, codeArea.CodeLength)
@@ -692,5 +691,19 @@ Sub TestOLCLibrary()
692
691
End If
693
692
Next
694
693
694
+ ' North pole recovery test.
695
+ c = OLCRecoverNearest("2222+22" , 89.6 , 0.0 )
696
+ If c <> "CFX22222+22" Then
697
+ MsgBox ("North pole recovery test, expected: CFX22222+22, actual: " + c)
698
+ Exit Sub
699
+ End If
700
+ ' South pole recovery test.
701
+ c = OLCRecoverNearest("XXXXXX+XX" , -81.0 , 0.0 )
702
+ If c <> "2CXXXXXX+XX" Then
703
+ MsgBox ("South pole recovery test, expected: 2CXXXXXX+XX, actual: " + c)
704
+ Exit Sub
705
+ End If
706
+
707
+
695
708
MsgBox ("All tests pass" )
696
709
End Sub
0 commit comments