' ------------------------------------------------------------------------------------
'				WorldMap.vbs
' I use this script to put tiny red dots on a world map on the places I have visited.
' Along with generating a new picture an HTML map is build for making the dots
' clickable in the web browser.
' It may not be usable as-is but contains anyway some interresting things:
'  - Creating and drawing on a new picture, saving it,
'  - Reading data from an Excel spreadsheet,
'  - Generating HTML code,...
' ------------------------------------------------------------------------------------


Option Explicit

Const xlNormal = -4143 '(&HFFFFEFD1)
Const ForReading = 1, ForWriting = 2

app.ClearTrace

dim alb, i, picWM, picNew, nb, sContinent, sCountry, sYear, x, y, sSName, rc, kPos, sURL, s
dim outputFileName

' The current album contains the orginal (without dots) world map picture
set alb = app.GetCurrentAlbum
set picWM = alb.GetPictureByFileName( "w1c.jpg" )
kPos = picWM.num
outputFileName = alb.ExpandMacro( picWM, "%RP" )
i = instrrev( outputFileName, "." )
outputFileName = left( outputFileName, i-1 ) & "2.html"
app.Trace outputFileName
set picNew = alb.NewPicture( picWM.w, picWM.h, 16, 0 )

' Copy the world map at paste it back as a new picture
picWM.Copy 0
picNew.Paste 0,0

' The list of countries and their coordinates are in an Excel speadsheet
dim xl, xls, sheet
set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.WindowState = xlNormal

set rc = CreateObject("MyAlbum.rect")

xl.Visible = True
' Open the Excel sheet in read-only mode
Set xls = xl.Workbooks.Open("d:\WebPages\DMS\Voyage\Pays.xls", 0, True)
set sheet = xls.ActiveSheet

' Create the HTML file
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile( outputFileName, ForWriting, True)
f.WriteLine "<script LANGUAGE=""JavaScript"">"
f.WriteLine "function loadPics() {"

i = 2	' Skip header on first line
Do
  sContinent = sheet.Cells(i, 1)
  if sContinent = "" Then Exit Do
  sCountry = sheet.Cells(i, 2)
  sYear = sheet.Cells(i, 3)
  x = cint(sheet.Cells(i, 4))
  y = cint(sheet.Cells(i, 5))
  sSName = sheet.Cells(i, 6)
  sURL = sheet.Cells(i, 7)
  app.Trace sCountry & " - (" & x & "," & y & ")"

  rc.x = x-4
  rc.y = y-4
  rc.w = 8
  rc.h = 8
  picNew.DrawRectangle rc, 0, 255, 255, 2, 0, 0

  f.WriteLine "   imgPre[" & i-1 & "] = new Thumbnail( ""htmlpic/" & sSName & "_th.jpg"", """ & sCountry & """, """" );"

  i = i + 1
Loop

f.WriteLine "}"
f.WriteLine vbCRLF & "var imgPre = new Array(" & i-2 & ");"
f.WriteLine "</script>"
f.WriteLine "<map name=""WorldMap"">"

i = 1
Do
  sContinent = sheet.Cells(i, 1)
  if sContinent = "" Then Exit Do
  sCountry = sheet.Cells(i, 2)
  sYear = sheet.Cells(i, 3)
  x = cint(sheet.Cells(i, 4))
  y = cint(sheet.Cells(i, 5))
  sSName = sheet.Cells(i, 6)
  sURL = sheet.Cells(i, 7)

  s = ""
  if sURL <> "" then s = "href=""" & sURL & """ target=""_blank"" " 
  f.WriteLine "   <area shape=""circle"" coords=""" & x & "," & y & ",6"" " & s & "ONMOUSEOVER=""showTh(" & i-1 & ");"" ONMOUSEOUT=""hideTh();"">"

  i = i + 1
Loop
f.WriteLine "</map>"

f.Close

' Copy the whole picture to the clipboard
picNew.copy(0)
alb.DeletePicture picNew
set picNew = Nothing

' Now create a "real" picture with it's name derived from the original picture
dim filename, k, pic
filename = picWM.sFileName
k = instrrev( filename, "." )
' The new picture will have "_c" appended to its name and will be a JPEG picture
filename = left( filename, k-1 ) & "_c.jpg"
k = instrrev( filename, "\" )
app.Trace "New map is: " & filename
set pic = alb.GetPictureByFileName( mid(filename,k+1) )
if not pic is nothing then alb.DeletePicture pic
' Paste the picture on the clipboard to a new picture and save it
alb.paste filename
' The new picture is at the end of the album, move it next to the original picture
alb.MovePicture alb.GetPicture( alb.nbPicture-1), kPos, True

' Close Excel
set xls = nothing
xl.Quit
set xl = nothing
set rc = nothing	' so MyAlbum can be closed

alb.redraw
app.Trace "Done !"