Public Sub GE_Load() '************************************************************************************ 'This procedure loads the GE interface 'The input parameters are: ' None 'Notes on this procedure: ' o The GE_... procedures use the Google Earth API, which is embedded in ' googleearth.exe (typically at C:\Program Files\Google\Google Earth) - at ' the time of writing, this API is documented at: ' http://earth.google.com/comapi/index.html ' o Amongst other things, the GE_... procedures create and send kml files ' to GE - at the time of writing, the kml specification is documented at: ' http://earth.google.com/kml/kml_intro.html ' o To access the API, install Google Earth at version 4.0.2416 or later then: ' [VB5] > [Project] > [References...] > [Browse...] > [Files of type: *.exe] ' > navigate to: [C:\Program Files\Google\Google Earth\googleearth.exe] ' > double click it, resulting in [Earth 1.0 Type Library] being checked ' in [Available References:] > [OK] ' o To view the properties and methods exposed: ' [VB5] > [View] > [Object Browser] > [<All Libraries>] > [EARTHLib] ' o The subset of Google Earth API properties and methods used in the ' GE_... procedures are summarised as follows: ' --------------------------- ' GoogleEarth API ' Library EARTHLib ' Earth 1.0 Type Library ' --------------------------- ' Class ApplicationGE ' Function GetMainHwnd() As Long ' comment: see GE_Load ' Function IsInitialized() As Long ' comment: see GE_Load ' Function GetCamera(considerTerrain As Long) As CameraInfoGE ' comment: see GE_Load, GE_interrogate_Timer, must ' set considerTerrain to True ' Sub SetCamera(camera As CameraInfoGE, speed As Double) ' comment: see GE_Update_Chart, GE_Update_Vessel ' Sub OpenKmlFile(fileName As String, suppressMessages As Long) ' comment: see GE_Update_Vessel, GE_Flush, ' GE_Update_Chart ' --------------------------- ' Class CameraInfoGE ' Property Azimuth As Double ' comment: see GE_interrogate_Timer, GE_Update_Chart, ' GE_Update_Vessel, aka heading or bearing ' Property FocusPointLatitude As Double ' comment: see GE_Update_Chart, GE_Update_Vessel ' Property FocusPointLongitude As Double ' comment: see GE_Update_Chart, GE_Update_Vessel ' Property Range As Double ' comment: see GE_Load, GE_interrogate_Timer, ' GE_Update_Chart, GE_Update_Vessel ' Property Tilt As Double ' comment: see GE_interrogate_Timer, GE_Update_Chart, ' GE_Update_Vessel '************************************************************************************ 'Reset everything Call GE_Tidy '************************************************************************************ 'Check if the GE executable has the GetCamera method, indicating GE is at version '4.0.2416 or later... '************************************************************************************ '************************************************************************************ 'Note Note Note 'There has to be a more elegant way to do this - had a look for a Windows API call 'that would do the job to no avail - the impact is minimal because this procedure is 'called sparingly and the GE executable is only about 60K - still any suggestions 'gladly accepted '************************************************************************************ 'If GE version unknown... If GE_ver_OK = 0 Then 'Open GE executable File_xge = FreeFile Open GE_exe For Binary As #File_xge 'Set up buffer a$ = Space(LOF(File_xge)) 'Suck GE executable into buffer Get #File_xge, , a$ 'Close GE executable Close #File_xge 'Drop out if the GE API doesn't have the GetCamera method If InStr(a$, "GetCamera") = 0 Then GoSub OLD_GE 'Flag GE version as OK GE_ver_OK = 1 End If '************************************************************************************ 'Initialize GE range, bearing and tilt... '************************************************************************************ 'Some C_wiz co-existence code here, setting up initial range, bearing and tilt GE_range = ... GE_bearing = ... GE_tilt = ... 'Initialize latitude and longitude to which GE view was last moved GE_view_last_lat = 91 GE_view_last_long = 0 '************************************************************************************ 'Launch GE... '************************************************************************************ 'Flush any old references, just in case Set GE_interface = Nothing Set GE_interface_view = Nothing 'Set up error handler On Error GoTo BAD_GE 'This will launch the sucker Set GE_interface = CreateObject("GoogleEarth.ApplicationGE") Set GE_interface_view = CreateObject("GoogleEarth.CameraInfoGE") 'Loop forever... Do 'Let the system have control DoEvents 'Quit loop if GE initialized If GE_interface.IsInitialized Then Exit Do Loop 'Turn default error handling back on On Error GoTo 0 'Get handle of main GE window GE_main_window_handle = GE_interface.GetMainHwnd 'If GE window characteristics known If GE_savewindow_flags <> -32000 Then 'Set up WINDOWPLACEMENT data type Dim wp As WINDOWPLACEMENT wp.Length = Len(wp) 'Load it with known characteristics wp.flags = GE_savewindow_flags wp.showCmd = GE_savewindow_showCmd wp.ptMinPosition.X = GE_savewindow_ptMinPositionX wp.ptMinPosition.Y = GE_savewindow_ptMinPositionY wp.ptMaxPosition.X = GE_savewindow_ptMaxPositionX wp.ptMaxPosition.Y = GE_savewindow_ptMaxPositionY wp.rcNormalPosition.Left = GE_savewindow_rcNormalPosition_Left wp.rcNormalPosition.Top = GE_savewindow_rcNormalPosition_Top wp.rcNormalPosition.Bottom = GE_savewindow_rcNormalPosition_Bottom wp.rcNormalPosition.Right = GE_savewindow_rcNormalPosition_Right 'Fire at GE rc& = SetWindowPlacement(GE_main_window_handle, wp) End If 'Flag GE not temporarily minimized... GE_status_temp_minimize = False 'Give it 2 GE latency periods to settle down Call Sleeper(2 * GE_latency) 'Flag GE launched GE_status_launched = True 'Update GE chart Call GE_Update_Chart 'Update GE vessels Call GE_Update_Vessel 'Enable GE_interrogate timer GE_interrogate.Enabled = True 'Enable GE_kill_fetch_error timer GE_kill_fetch_error.Enabled = True 'Tidy up GoSub TIDYUP '************************************************************************************ 'This GOSUB handles a GE error... '************************************************************************************ BAD_GE: 'Turn default error handling back on On Error GoTo 0 'Generate a message a$ = "Error during Google Earth load" + vbCr rc& = MsgBox(a$, vbOKOnly + vbInformation, "Map GE Interface") 'Tidy up GoSub TIDYUP '************************************************************************************ 'This GOSUB handles an old version of GE... '************************************************************************************ OLD_GE: 'Turn default error handling back on On Error GoTo 0 'Generate a message a$ = "Google Earth version must be 4.0.2416 or later" + vbCr rc& = MsgBox(a$, vbOKOnly + vbInformation, "Map GE Interface") 'Flag GE version as NOK GE_ver_OK = 2 '************************************************************************************ 'This GOSUB tidies up... '************************************************************************************ TIDYUP: 'Some C_wiz co-existence code here, hiding splash screens, repositioning windows, 'setting some flags etc End Sub