[Update v0.4] Image plus Text Viewer (HTA)

Author	Message

Fredledingue

Total Posts : 572
Scores: 2
Reward points : 0
Joined: 5/9/2005
Location: Europe
Status: offline

[Update v0.4] Image plus Text Viewer (HTA) Saturday, November 18, 2006 9:52 AM (permalink)

0

NO JS!

FEATURES:
-A very simple picture viewer displaying at the same time as a text refering to this picture.
-Texts can be short comments or long descriptions, stories, jokes, etc that you write yourself in notepad
-Supports only picture formats supported by Internet Explorer
_______________________________
Mouse over *Show Toolbar* : Shows the following BUTTONS:
Mouse over *Hide Toolbar* : Erases them:
.
[Edit Text]: Create or edit the text for the image
[Zoom in]: Enlarge the image by 1/3
[Zoom out]: Reduce the image by 1/3
[100%]: Display the image back to its original size
[Open]: Return to the list of files and folders
[<--]: Display the previous image in the same folder
[-->]: Display the next image in the same folder
[_]: Minimize ==> [_-]: Maximize
[X]: Exit
.
CHECK BOXES
From left to right:
1: Display file name and file infos on/off
2: Display text on/off
3: Display text on black/transparent background when overlaping the image (*)
*: The text appears on the right of the picture unless there is no room left for it. When the image cover all the screen, the text is displayed on the picture.
_______________________________
KNOWN BUGS AND LIMITATIONS:
-You can't modify the size of the window: It's either maximized or "reduced".
-You can't realy minimize it. The minimize button will reduce it on a small area in the right bottom of the screen.
-No context menu on the task bar.
-Huge zoom may not display.
-Huge images may take a few seconds to display.

 <HTML>
 <HEAD>
 <HTA:APPLICATION
 ID="FileBrowser" 
    APPLICATIONNAME="PicViewer"
    WINDOWSTATE="maximize"
 BORDER="none"
 SINGLEINSTANCE="no">
 <meta name="VI60_defaultClientScript" content="VBScript">
 <TITLE>Select a file</TITLE>
 <SCRIPT LANGUAGE="VBScript">
 Public FolPath, fso, ExtFilter, SortBy, ViewDetails ,t
 Public PictureWidth, PictureHeight, OriginalPictureWidth, OriginalPictureHeight, ScreenHeight, ScreenWidth
 Public FilePath, fName, ShowInfo, ShowBackgroundText, ShowText
 Public ListNumber, mlNumPrev, FileList(2000)
 Sub window_onLoad()
 ScreenHeight = window.screen.height
 ScreenWidth = window.screen.width
 ShowInfo = True
 ShowBackgroundText = False
 ShowText = True
 Set fso = CreateObject("scripting.FilesystemObject")
 t = Split(FileBrowser.commandLine, "/")
 '----read arguments-----
 FolPath = ""
 SortBy = ""
 ViewDetails = ""
 ExtFilter = ","
 If UBound(t)>0 Then
 For i=1 To UBound(t)
  If InStr(t(i), ":\") Then
  FolPath = t(i)
  ElseIf InStr(t(i), "O:") Then
  SortBy = UCase(Replace( Mid(t(i), InStr(t(i), ":")+1) ," ",""))
  ElseIf InStr(t(i), "V:") Then
  ViewDetails = UCase(Replace( Mid(t(i), InStr(t(i), ":")+1) ," ",""))
  ElseIf t(i)<>"" Then
  ExtFilter = Replace(t(i)," ","") & ","
  End If
 Next
 End If
 '---------SortBy---------
 '    N - by name 
 '    E - by extension 
 '    A - by last access date
 '    S - by size 
 '    D - by date and time
 '----added for pic viewer
 If ExtFilter = "," Then
 ExtFilter = "jpg,gif,png,"
 End If
 If SortBy = "" Then
 SortBy = "N"
 End If
 '------ViewDetails (info)-------
 '    A -  last access date
 '    S -  size 
 '    D -  date and time
 '    B -  attribute
 '    L -  full details
 '   ""
 '--------------
 t=""
 If Len(FolPath)>0 Then
  Do While Right(FolPath,1) = " "
  FolPath = Left(FolPath, Len(FolPath)-1)
  Loop
 End If
 If FolPath = "" Then
 FolPath = CreateObject("WScript.Shell").CurrentDirectory
 Call DoList(FolPath)
 Else
 '---debug-----
 'MsgBox "InStrRev(FolPath, ""."") = " & InStrRev(FolPath, ".") _
 ' & VBCrlf &  "Len(FolPath)-3 = " & Len(FolPath)-3 _
 ' & VBCrlf &  "FolPath = """ & FolPath & """" ,,"debug FolPath" 
 '---end debug---
  If InStrRev(FolPath, ".") = Len(FolPath)-3 Then
  FilePath = FolPath
  FolPath = Left(FolPath, InStrRev(FolPath, "\")-1)
   If Fso.FileExists(FilePath) Then
   t = LCase(fso.GetExtensionName(FilePath))
    If t="jpg" Or t="gif" Or t="png" Then
    t=""
 '   MsgBox FilePath,,"ok"
    Call SelectFile(FilePath)
    Exit Sub
    Else
    MsgBox "file not compatible",0+48,"Error"
    t=""
    Call DoList(FolPath)
    End If
   Else
   MsgBox "File not found.",0+48,"Error"
   Call DoList(FolPath)
   End If
  End If
  '-----
  If Fso.FolderExists(FolPath) Then
  Call DoList(FolPath)
  Else
  MsgBox "folder not found",0+48,"Error"
  FolPath = CreateObject("WScript.Shell").CurrentDirectory
  Call DoList(FolPath)
  End If
 End If
 End Sub
 Sub DoList(fPath)
 FolPath = fPath
 LinkCount = 0
 fCount = 0
 t=""
 '------------do buttons------
 TextToStart = "<p align=""center""><strong>" & fPath & "</strong>&nbsp;&nbsp;<INPUT NAME=""BtnUpOneLevel"" TYPE=""BUTTON"" VALUE=""&#8593;...Up one level"" "
 If InStr(fPath, "\")=0 Then
 fPath = fPath & "\"
 End If
 If InStrRev(fPath, ":\") = Len(fPath)-1 Then
 TextToStart = TextToStart & "disabled>"
 Else
 TextToStart = TextToStart & "onclick=""DoList('" &   Left(fPath, InStrRev(fPath,"\")-1)   & "')"">"
 End If
 TextToStart = TextToStart &  "<INPUT NAME=""BtnExit"" ONCLICK=""ExitViewer()"" TYPE=""BUTTON"" VALUE=""X"">" _
 & "<INPUT NAME=""BtnTaskBar"" ONCLICK=""ShowTaskBar()"" TYPE=""BUTTON"" VALUE=""_""></p>" _
 & "<span id=""This"" onmouseover=""this.style.cursor='hand'"" onmouseout=""this.style.cursor='auto'"">"
 '----------do subfolders--------
 Set folder = fso.getfolder(fPath)
 For Each f in folder.subfolders
 t = t & "<A onclick=""DoList('"  &  f.path  & _
  "')"" ><img name=""BtnOpenFolder"" src=""openfolblack.gif"" border=""0"" alt=""go to this directory"">&nbsp;&nbsp;" &_
  Replace(f.name," ","&nbsp") & "</A> &nbsp;&nbsp;"
 Next
 If t <>"" Then
 TextToStart = TextToStart & t
 End If
 '-------------do files---------
 '---------SortBy---------
 Select Case SortBy
 Case ""  t="MyString = UCase(f.name) & VbTab &"
 Case "N" t="MyString = UCase(f.name) & VbTab &"
 Case "E" t="MyString = fso.GetExtensionName(f.name) & UCase(f.name) & VbTab &"
 Case "A" t="MyDate = f.DateLastAccessed" _
 & VbCrlf & "MyString = Right(Year(MyDate),2) & Right( ""0"" & Month(MyDate),2 ) & Right( ""0"" & Day(MyDate),2 ) " _
 & "& UCase(f.name) & VbTab &"
 Case "S" t="MyString = Chr(Len(f.size)+65) & f.size & VbTab &"
 Case "D" t="MyDate = f.DateLastModified" _
 & VbCrlf & "MyString = Right(Year(MyDate),2) & Right( ""0"" & Month(MyDate),2 ) & Right( ""0"" & Day(MyDate),2 ) " _
 & " & Right( ""0"" & Hour(MyDate),2 ) & Right( ""0"" & Minute(MyDate),2 ) & Right( ""0"" & Second(MyDate),2 )" _
 & "& UCase(f.name) & VbTab &"
 End Select
 '------ViewDetails-------
 Select Case True
 Case ViewDetails="" t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _ 
      & " & Replace(f.name,"" "",""&nbsp"") & "";;</b></A></span>"""
 Case InStr(ViewDetails,"L")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
      & " & Replace(f.name,"" "",""&nbsp"") & "";;*3*""" _
      & " & FormatNumber(f.Size, 0,0,0,-1) & "";b, Modified: "" & f.DateLastModified & "", Accessed: "" & f.DateLastAccessed" _
      & " & Replace(Replace(Replace(Replace(""["" & f.Attributes,""1"",""Read Only""),""[2"",""[Hidden""),""4"",""System File""),""32"",""Archive"") & ""]</font><br>"""
 Case InStr(ViewDetails,"A")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
      & " & Replace(f.name,"" "",""&nbsp"") & "";;*3*""" _
      & " & "" Acc.: "" & f.DateLastAccessed"
 Case InStr(ViewDetails,"S")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
      & " & Replace(f.name,"" "",""&nbsp"") & "";;*3*""" _
      & " & FormatNumber(f.Size, 0,0,0,-1) & "";b"""
 Case InStr(ViewDetails,"D")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
      & " & Replace(f.name,"" "",""&nbsp"") & "";;*3*""" _
      & " & f.DateLastModified"
 Case InStr(ViewDetails,"B")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
      & " & Replace(f.name,"" "",""&nbsp"") & "";;*3*""" _
      & " & Replace(Replace(Replace(Replace(""["" & f.Attributes,""1"",""Read Only""),""[2"",""[Hidden""),""4"",""System File""),""32"",""Archive"") & ""]"""
 End Select
 '----if more than one---
 If Len(ViewDetails)>1 Then
  For i=2 To Len(ViewDetails)
   Select Case True
   Case InStr(i,ViewDetails,"A",1)>0 t=t & " & "";Acc.:;"" & f.DateLastAccessed"
   Case InStr(i,ViewDetails,"S",1)>0 t=t & " & "";-;"" & FormatNumber(f.Size, 0,0,0,-1) & "";b"""
   Case InStr(i,ViewDetails,"D",1)>0 t=t & " & "";-;"" & f.DateLastModified"
   Case InStr(i,ViewDetails,"B",1)>0 t=t & " & "";-;"" & Replace(Replace(Replace(Replace(""["" & f.Attributes,""1"",""Read Only""),""[2"",""[Hidden""),""4"",""System File""),""32"",""Archive"") & ""]"""
   End Select
  Next
 End If
 If InStr(ViewDetails,"L")=0 And ViewDetails<>"" Then
  If Len(ViewDetails)>2 Then
  t=t & " & ""</font></A></span><br>"""
  Else
  t=t & " & ""</font></A></span>"""
  End If
 End If
 '-------------
 Set oMyCatString = New AddString '---utilise la classe pour ajouter les ficheirs dans la liste rapidement
 For Each f in folder.files
  If ExtFilter = "," Or InStr(1, ExtFilter,  fso.GetExtensionName(f.name) & ",", 1) Then
  Execute t
  oMyCatString MyString
  '------ajoute à la liste simple----
   If fCount < 2000 Then
   FileList(fCount) = f.Path
   End If
  '---------
  fCount = fCount+1  
  End If
 Next
 mlNumPrev = -2
 If fCount > 2000 Then
 MsgBox "Buttons ""Next"" and ""Previous"" disabled: Too many files.",0+48,"Picture viewer"
 ElseIf fCount < 2000 Then
  For i=fCount+1 To 2000
  FileList(fCount) = ""
  Next
 End If
 If fCount > 1 Then
 FileListHtml = oMyCatString.Flush
 ElseIf fcount = 0 Then
 FileListHtml = ""
 Else
 MyString = Mid(MyString, InStr(MyString, VbTab)+1)
 MyString = Replace(Replace(Replace(Replace(MyString, ";", "&nbsp;"),"*1*","<span id=""f"), "*2*", """><A onclick=""SelectFile('"), "*3*", "</b><font color=""#009933"">")
 FileListHtml = MyString
 End If
 document.all.ListOfItems.innerhtml = TextToStart & "<hr>" & FileListHtml & "</p></span><p><font color=""#FF0000"">Number of files: " & fCount & "</font></p>"
 End Sub
 '-----class to concatenate strings (modified)-----
 Class AddString
 Dim iElement, NewStrArray
 Private Sub Class_Initialize()
 iElement = 0
 ReDim NewStrArray(iElement)
 End Sub
 Public Default Sub AddString(Value)
 NewStrArray(iElement) = Value
 iElement = iElement + 1
 ReDim Preserve NewStrArray(iElement)
 End Sub
 Public Function Flush
 iElement = iElement - 1
 Redim Preserve NewStrArray(iElement)
 '------sort list-----
 ArraySort NewStrArray
 '-----remove sorting mark------
 '-----and add html code that where replaced by "*1*" to make string shorter when sorting-----
 For iel = 0 To  UBound(NewStrArray)
 Word = NewStrArray(iel)
 Word = Mid(Word, InStr(Word, VbTab)+1)
 Word = Replace(Replace(Replace(Replace(Word, ";", "&nbsp;"),"*1*","<span id=""f"), "*2*", """><A onclick=""SelectFile('"), "*3*", "</b><font color=""#009933"">")
 NewStrArray(iel) = Word
 Next
 '--------------------
 Flush = Join(NewStrArray,VbCrLf)
 End Function
 '-----sort function---------
 Private Function ArraySort(ArrY)
 ReDim TempArray(255)
 For Each Word in ArrY
 UCaseWord = UCase(Word) & "   "
 TempArrayNum = Asc(Left(UCaseWord,1))
 TempArray(TempArrayNum) = TempArray(TempArrayNum) & Word & VBCrlf 
 Next
 For Each SmallList In TempArray
  If SmallList <>"" Then
  SmallArray = Split( Mid(SmallList,2 ),VBCrlf)
  InsertionSort SmallArray
  BigList = BigList & Join(SmallArray,VbCrlf)
  End If
 Next
 time2 = Timer
 ArrY = Split(BigList,VbCrlf)
 Erase SmallArray
 Erase TempArray
 End Function
 '-----sort function-----
 Private Function InsertionSort(arrX)
   Dim nUB : nUB = UBound(arrX)
   Dim i, j, v
   For i=1 To nUB
       v=arrX(i)
       j=i
       Do While arrX(j-1) > v
          arrX(j) = arrX(j-1)
          j=j-1
          If j<=0 Then
          Exit Do
          End If
       Loop
       arrX(j) = v
   Next
 End Function
 '--------
 Private Sub Class_Terminate()
 Erase NewStrArray
 End Sub
 End Class
 '----------
 Sub Open()
 document.body.innerhtml = "<FORM NAME=""form""><span id=""ListOfItems""></span></FORM>"
 Call DoList(FolPath)
 End Sub
 Sub ShowTaskBar()
 If document.form.BtnTaskBar.value = "_" Then
 document.form.BtnTaskBar.value = "_-"
 window.moveTo ScreenWidth -400, ScreenHeight -240
 window.ResizeTo 400,240
 Else
 document.form.BtnTaskBar.value = "_" 
 window.moveTo 0, 0
 window.ResizeTo ScreenWidth ,ScreenHeight
 End If
 End Sub
 Sub ExitViewer()
 Window.Close
 End Sub
 Sub AddPrev(i)
 If mlNumPrev =-2 Then
  For mlNumPrev=0 To 2000
   If FilePath = FileList(mlNumPrev) Then
   Exit For
   End If
  Next
 End If
 mlNumPrev = mlNumPrev +i
 If mlNumPrev >= 2000 Then
 mlNumPrev = 2000
 MsgBox "Loop list cannot contain more than 2000 files.",48+0,"Picture viewer"
 If InsTr(document.form.innertext, "*Hide ToolBar*") Then
  document.form.BtnNext.disabled = True
  document.form.BtnPrev.disabled = False
  End If
 ElseIf mlNumPrev =-1 Then
 mlNumPrev = 0
  If InsTr(document.form.innertext, "*Hide ToolBar*") Then
  document.form.BtnNext.disabled = False
  document.form.BtnPrev.disabled = True
  Else
  MsgBox "Start of loop list.",,"Picture viewer"
  End If
 ElseIf  FileList(mlNumPrev)="" Then
  If InsTr(document.form.innertext, "*Hide ToolBar*") Then
  document.form.BtnNext.disabled = True
  document.form.BtnPrev.disabled = False
  Else
  MsgBox "End of loop list.",,"Picture viewer"
  End If
 Else
 FilePath = FileList(mlNumPrev)
 document.all.MyPic.innerhtml = "<img border=""0"" src=""[link=http://visualbasicscript.com/file:///]file:///[/link]" &  Replace(FilePath, " ","%20")  & """ id=""MyPicture"">"
 PictureWidth = document.all.MyPicture.width
 PictureHeight = document.all.MyPicture.height 
 OriginalPictureWidth = PictureWidth
 OriginalPictureHeight = PictureHeight
  If ShowInfo = True Then
  Call WriteInfo(0)
  End If
  If ShowText = True Then
  Call WriteText(0)
  End If
  If InsTr(document.form.innertext, "*Hide ToolBar*") Then
  document.form.BtnNext.disabled = False
  document.form.BtnPrev.disabled = False
  End If
 End If
 End Sub
 Sub WriteInfo(Var)
 Select Case Var
 Case -1
  ShowInfo = -(ShowInfo+1)
 Case 1
  If document.form.Info.checked = True Then
  ShowInfo = True
  Else
  ShowInfo = False
  End If
 End Select
 If ShowInfo = True Then
 Set f = fso.GetFile(FilePath)
 FileDate = f.DateLastModified
 FileDate = Left(FileDate, InStrRev(FileDate, ":")-1)
 document.all.PicInfo.innerhtml = f.name & " <font color=""#00FFFF"">" _
   & "[" & OriginalPictureWidth & "/" & OriginalPictureHeight & " " & f.size & " b " & FileDate & "]</font>"  
 Else
 document.all.PicInfo.innertext = ""
 End If
 End Sub
 Sub WriteText(Var)
 Select Case Var
 Case -1
  ShowText = -(ShowText+1)
 Case 1
  If document.form.Text.checked = True Then
  ShowText = True
  Else
  ShowText = False
  End If
 Case 2
  If document.form.BackgroundText.checked = True Then
  ShowBackgroundText = True
  Else
  ShowBackgroundText = False
  End If
 End Select
 If ShowText = True Then
 TextFile = Left( FilePath, InStr(FilePath,".")-1 ) & ".txt"
  If fso.FileExists(TextFile) Then
  Set ts = fso.GetFile(TextFile).OpenAsTextStream(1)
  t= Replace(Replace(ts.ReadAll, VbCrlf, "<br>"), VbTab,"&nbsp;&nbsp;&nbsp; ")
  ts.Close
  PosLeft = PictureWidth +16
  PosWidth = ScreenWidth -PictureWidth -32
   If PosLeft > ScreenWidth -150 Then
   PosLeft = Round(ScreenWidth *0.66, 0)
   PosWidth = Round(ScreenWidth *0.33 -32, 0)
   End If
   If ShowBackgroundText = False Then
   document.all.PicText.innerhtml = "<p style=""position: absolute; left: " & PosLeft & "; top: 50; width: "  & PosWidth & ";"">" _
    & VbCrlf & t & "</p>"
   Else
   document.all.PicText.innerhtml = "<p style=""position: absolute; left: " & PosLeft & "; top: 50; width: "  & PosWidth & ";"">" _
    & VbCrlf & "<font style=""background-color: #000000"">" & t & "</font></p>"
   End If
  Else
  document.all.PicText.innerhtml = ""
  End If
 Else
 document.all.PicText.innerhtml = ""
 End If
 End Sub
 Sub SaveText()
 TextFile = Left(FilePath, InStrRev(FilePath, ".")) & "txt"
 Set ts = fso.OpenTextFile(TextFile , 2, -1)
 ts.Write document.all.MyText.innertext
 ts.Close
 If document.form.Text.checked = True Then
 Call WriteText()
 End If
 End Sub
 Sub EditText
 TextFile = Left(FilePath, InStrRev(FilePath, ".")) & "txt"
 PosLeft = PictureWidth +16
 PosWidth = ScreenWidth -PictureWidth -32
 If PosLeft > ScreenWidth -150 Then
 PosLeft = Round(ScreenWidth *0.66, 0)
 PosWidth = Round(ScreenWidth *0.33 -32, 0)
 End If
 If Fso.FileExists(TextFile) Then
 'MsgBox """" & TextFile & """",,"debug text file"
 Set ts = fso.GetFile(TextFile).OpenAsTextStream(1)
 t= ts.ReadAll
 ts.Close
 document.all.PicText.innerhtml = "<p style=""position: absolute; left: " & PosLeft & "; top: 50; width: "  & PosWidth & ";"">" _
  & "<INPUT NAME=""BtnSaveText"" ONCLICK=""SaveText()"" TYPE=""BUTTON"" VALUE=""Save"">" _
  & "<INPUT NAME=""BtnCancelText"" ONCLICK=""WriteText()"" TYPE=""BUTTON"" VALUE=""Cancel""><br>" _
  & "<textarea name=""MyText"" cols=""50"" rows=""30"" >" & t &  "</textarea></p>"
 ElseIf MsgBox("""" & TextFile & """ doesn't exists. Create it?", 32+4, "Create a text for this image") = 6 Then
 fso.CreateTextFile TextFile, True
 document.all.PicText.innerhtml = "<p style=""position: absolute; left: " & PosLeft & "; top: 50; width: "  & PosWidth & ";"">" _
  & "<INPUT NAME=""BtnSaveText"" ONCLICK=""SaveText()"" TYPE=""BUTTON"" VALUE=""Save"">" _
  & "<INPUT NAME=""BtnCancelText"" ONCLICK=""WriteText()"" TYPE=""BUTTON"" VALUE=""Cancel""><br>" _
  & "<textarea name=""MyText"" cols=""50"" rows=""30"" ></textarea></p>"
 End If
 End Sub
 Sub ShowToolBar(Var)
 t = document.all.PicInfo.innerhtml
 Select Case Var
 Case 0
 document.form.innerhtml = "<span id=""ToolBar"" onmouseover=""ShowToolBar(1)"">" _
   & "<font color=""#C0C0C0"">" _
   & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; *Show ToolBar* &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" _
   & "</font></span><span id=""PicInfo""></span>"
 Case 1
 document.form.innerhtml = "<font color=""#FFFFFF"">" _
   & "<INPUT NAME=""BtnEditText"" ONCLICK=""EditText()"" TYPE=""BUTTON"" VALUE=""Edit Text"">" _
   & "<INPUT NAME=""BtnZoomIn"" ONCLICK=""Zoom('1')"" TYPE=""BUTTON"" VALUE=""Zoom in"">" _
   & "<INPUT NAME=""BtnZoomOut"" ONCLICK=""Zoom('2')"" TYPE=""BUTTON"" VALUE=""100%"">" _
   & "<INPUT NAME=""BtnZoomOut"" ONCLICK=""Zoom('3')"" TYPE=""BUTTON"" VALUE=""Zoom out"">" _
   & "<INPUT NAME=""BtnOpen"" ONCLICK=""Open()"" TYPE=""BUTTON"" VALUE=""Open"">" _
   & "<INPUT NAME=""BtnPrev"" ONCLICK=""AddPrev(-1)"" TYPE=""BUTTON"" VALUE=""&#8592;"">" _
   & "<INPUT NAME=""BtnNext"" ONCLICK=""AddPrev(1)"" TYPE=""BUTTON"" VALUE=""&#8594;"">" _
   & "<INPUT NAME=""BtnTaskBar"" ONCLICK=""ShowTaskBar()"" TYPE=""BUTTON"" VALUE=""_"">" _
   & "<INPUT NAME=""BtnExit"" ONCLICK=""ExitViewer()"" TYPE=""BUTTON"" VALUE=""X"">" _
   & "Show infos<input type=""checkbox"" value=""ON"" name=""Info"" ONCLICK=""WriteInfo(1)"">" _
   & "Show text<input type=""checkbox"" value=""on"" name=""Text"" ONCLICK=""WriteText(1)"">" _
   & "Text on black<input type=""checkbox"" value=""on"" name=""BackgroundText"" ONCLICK=""WriteText(2)"">" _
   & "<span id=""ToolBar"" onmouseover=""ShowToolBar(0)"">" _
   & "<font color=""#C0C0C0"">" _
   & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; *Hide ToolBar* &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" _
   & "</font></span>" _
   & "</font><br>" _
   & "<span id=""PicInfo""></span>"
  If ShowInfo = False Then
  document.form.Info.checked = False
  Else
  document.form.Info.checked = True
  End If
  If ShowBackgroundText = True Then
  document.form.BackgroundText.checked = True
  Else
  document.form.BackgroundText.checked = False
  End If
  If ShowText = True Then
  document.form.Text.checked = True
  Else
  document.form.Text.checked = False
  End If  
 End Select
 document.all.PicInfo.innerhtml = t
 End Sub
 Sub SelectFile(fPath)
 FilePath = fPath
 fName = Replace(fPath, " ","%20")
 document.body.innerhtml = "<FORM NAME=""form"">" _
 & "<span id=""ToolBar"" onmouseover=""ShowToolBar(1)"">" _
 & "<font color=""#C0C0C0"">" _
 & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; *Show ToolBar* &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" _
 & "</font></span>" _
 & "<span id=""PicInfo""></span></FORM>"  _
 & "<span id=""PicText""></span>" _
    & "<span id=""MyPic"">" _
    & "<img border=""0"" src=""[link=http://visualbasicscript.com/file:///]file:///[/link]" &  fName  & """ id=""MyPicture""></span>"
 PictureWidth = document.all.MyPicture.width
 PictureHeight = document.all.MyPicture.height 
 OriginalPictureWidth = PictureWidth
 OriginalPictureHeight = PictureHeight
 If ShowInfo = True Then
 Call WriteInfo(0)
 End If
 If ShowText = True Then
 Call WriteText(0)
 End If
 End Sub
 Sub Zoom(Var)
 Select Case Var
 Case 1
 PictureWidth = Round(PictureWidth * 1.3 ,0)
 PictureHeight = Round(PictureHeight * 1.3 ,0)
 Case 2
 PictureWidth = OriginalPictureWidth
 PictureHeight = OriginalPictureHeight
 Case 3
 PictureWidth = Round(PictureWidth / 1.3 ,0)
 PictureHeight = Round(PictureHeight / 1.3 ,0)
 End Select
 Document.all.MyPic.Innerhtml = "<img border=""0"" src=""[link=http://visualbasicscript.com/file:///]file:///[/link]" &  fName  & """ width=""" & PictureWidth & """ height=""" & PictureHeight & """>"
 Call WriteText()
 End Sub
 Sub Help()
 MsgBox "[Esc] :" & VBTab & VbTab & "Exit" _
 & VBCrlf & "- :" & VBTab & VbTab & "Zoom out" _
 & VBCrlf & "+ :" & VBTab & VbTab & "Zoom in" _
 & VBCrlf & "? :" & VBTab & VbTab & "Help" _
 & VBCrlf & "b :" & VBTab & VbTab & "Show toolbar" _
 & VBCrlf & "i :" & VBTab & VbTab & "Show file infos (on/off)" _
 & VBCrlf & "n or [White Space] : Show next picture" _
 & VBCrlf & "o :" & VBTab & VbTab & "Open file" _
 & VBCrlf & "p :" & VBTab & VbTab & "Show previous picture" _
 & VBCrlf & "t :" & VBTab & VbTab & "Edit text" _
 & VBCrlf & "w :" & VBTab & VbTab & "Show text (on/off)"
 End Sub
 Sub checkKey()
 If InsTr(document.form.innertext, "ToolBar*") Then
 t = window.event.keycode
 Select Case t
 Case 27 Window.Close
 Case 32 Call AddPrev(1)
 Case 43 Call Zoom(1)
 Case 45 Call Zoom(3)
 Case 63 Call Help()
 Case 98 Call ShowToolBar(1)
 Case 105 Call WriteInfo(-1)
 Case 110 Call AddPrev(1)
 Case 111 Call Open()
 Case 112 Call AddPrev(-1)
 Case 116 Call EditText()
 Case 119 Call WriteText(-1)
 Case Else MsgBox t
 End Select
 Else
 MsgBox "not ok",,"debug checkkey"
 End If
 End Sub
 </SCRIPT>
 </HEAD>
 <BODY style="color: #00FF00" bgcolor="#000000" onKeyPress="checkKey()">
 <font color="#00FFFF">Click on file name to open</font><br>
 <FORM NAME="form">
 <span id="ListOfItems"></span>
 </FORM>
 </BODY>
 <!--Free to use and distribute for private and non commercial and non professional purpose. 
 This hta application is under copyright protection." -->
 </HTML>

Fred

#1

TNO

Total Posts : 2094
Scores: 36
Reward points : 0
Joined: 12/18/2004
Location: Earth
Status: offline

RE: Image plus Text Viewer (HTA) Saturday, November 18, 2006 10:28 PM (permalink)

0

Not a bad idea, but the user friendliness is pretty limited for the things you mentioned.

-You can't modify the size of the window: It's either maximized or "reduced".
-You can't realy minimize it. The minimize button will reduce it on a small area in the right bottom of the screen.
-No context menu on the task bar.

For these bugs, why don't you just delete this part of your code to fix it?

BORDER="none"

With that you can also eliminate your 2 buttons (and related functions) for close and minimize. A program like this that goes fullscreen could easily irritate the user (unless it was a game or something like that where they would expect it).

Suggestions:

Use fullscreen when the user clicks on an image
put all the picture comment textfiles in one spot so they arent scattered all over the hard drive
For your list of picture files, make it so the mouse-cursor becomes a hand when you hover on it

And finally, could you include openfolblack.gif here on the board so we could see what the program looks like with it?

To iterate is human, to recurse divine. -- L. Peter Deutsch

#2

Fredledingue

Total Posts : 572
Scores: 2
Reward points : 0
Joined: 5/9/2005
Location: Europe
Status: offline

RE: Image plus Text Viewer (HTA) Sunday, November 19, 2006 7:00 AM (permalink)

0

Thanks for your suggestiong TNO.

Do you know how to do suggestions 1 and 3?
1: How to switch to real full screen from a bordered window and vice versa.
3: How to change the mouse cursor while hovering

For suggestion 2: There are pro and cons.
First they are not scattered all over the place: they are where the pictures are and if you sort the files by name they will be next to each others.
I was thinking to put all the comments in one file per folder (comments.txt for example)
But that could complicate the search, editing or deletion of these comments with possible performance hit. The same with storing all the file in a single folder.
One singel file per folder is good for small comments (like 30 words each). It's less good for long comments like 500 words each. It depends what you want to do.
Maybe I will add some code to find both image-specific text file and comment.txt if it exists.
This way the user can choose to store the comments in a single files or in multiple file.

Here is the "open folder" 'icon'.

[image]local://6751/2F47E42A3216413CA2437469B4990246.gif[/image]

Attachment(s)Attachments are not available: Download requirements not met

Fred

#3

Fredledingue Total Posts : 572 Scores: 2 Reward points : 0 Joined: 5/9/2005 Location: Europe Status: offline	RE: Image plus Text Viewer (HTA) Sunday, November 19, 2006 7:08 AM (permalink) 0 Here is the complete "readme" file. Attachment(s)Attachments are not available: Download requirements not met Fred
	#4

TNO

Total Posts : 2094
Scores: 36
Reward points : 0
Joined: 12/18/2004
Location: Earth
Status: offline

RE: Image plus Text Viewer (HTA) Sunday, November 19, 2006 9:38 PM (permalink)

0

heres the fullscreen method:

document.open(sUrl [, sName] [, sFeatures] [, bReplace])

example:
document.open('about:blank','win1','fullscreen=yes')

There a few ways to change the cursor, but I think the best way for your program would be like this:

<span onmouseover="this.style.cursor='hand'" onmouseout="this.style.cursor='auto'">blah</span>

For suggeston 2.....You culd always try an XML file:

 <?xml  version="1.0" encoding="ISO-8859-1" ?>
 
 <images>
   <image>
        <path>C:\Images\</path>
        <file>doggy.gif</file>
        <comment>A picture of my pet dog</comment>
   </image>
   <image>
          <path>C:\Images\</path>
          <file>kitty.gif</file>
          <comment>A picture of my pet cat</comment>
     </image>
   <image>
          <path>C:\Images\Documents and Settings\</path>
          <file>birdy.jpg</file>
          <comment>The Bird is the word</comment>
     </image>
 ...
 </images>

To iterate is human, to recurse divine. -- L. Peter Deutsch

#5

Fredledingue

Total Posts : 572
Scores: 2
Reward points : 0
Joined: 5/9/2005
Location: Europe
Status: offline

RE: Image plus Text Viewer (HTA) Tuesday, November 21, 2006 8:52 AM (permalink)

0

I have added the onmouseover cursor style.

ORIGINAL: TNO
There a few ways to change the cursor, but I think the best way for your program would be like this:

<span onmouseover="this.style.cursor='hand'" onmouseout="this.style.cursor='auto'">blah</span>

This:

heres the fullscreen method:

document.open(sUrl [, sName] [, sFeatures] [, bReplace])

example:
document.open('about:blank','win1','fullscreen=yes')

...doesn't work for hta applications.

The only way is to create two hta's, one opening in full screen, the other one in normal screen.
Then switching from one to the other. That requires closing the application and opening the other one with the same parameters.

I'v tried resizing and repositioning off the screen. That works for repositioning, not for resizing.
Top and left borders disapear, not right and bottom borders and the taskbar is always visible.

There is realy poor window view management in hta...

For suggeston 2.....You culd always try an XML file:

Maybe I will study XML in the future...

Fred

#6

TNO

Total Posts : 2094
Scores: 36
Reward points : 0
Joined: 12/18/2004
Location: Earth
Status: offline

RE: Image plus Text Viewer (HTA) Tuesday, November 21, 2006 7:03 PM (permalink)

0

Fullscreen does work:

Example:

 <html>
 <head>
 
 <HTA:APPLICATION
 ID="durka" 
 APPLICATIONNAME="PicViewer"
 WINDOWSTATE="maximize"
 SINGLEINSTANCE="no">
 
 <title>button</title>
 </head>
 
 <body>
 <button onclick="document.open('about:blank','win1','fullscreen=yes')">click</button>
 </body>
 </html>

To iterate is human, to recurse divine. -- L. Peter Deutsch

#7

Fredledingue Total Posts : 572 Scores: 2 Reward points : 0 Joined: 5/9/2005 Location: Europe Status: offline	RE: Image plus Text Viewer (HTA) Wednesday, November 22, 2006 3:46 AM (permalink) 0 That code open a new blank IE window in full screen. It doesn't resize the hta window. Moreover if you try to open an hta application with this method, you will be warned that it can damage your computer, then prompted to save it on your hard drive. Fred
	#8

TNO

Total Posts : 2094
Scores: 36
Reward points : 0
Joined: 12/18/2004
Location: Earth
Status: offline

RE: Image plus Text Viewer (HTA) Wednesday, November 22, 2006 6:05 AM (permalink)

0

oooooh.....I didin't know you wanted to toggle the current window. I was thinking of making the image display portion open in a fullscreen mode. The window attributes of an HTA are readonly defined at startup, so as a work-around guess you could document.write() the html of your HTA into the fullscreen pop-up window, then make it close when the window loses focus, hence giving the illusion of toggling modes.

While trying to figure this out I came across this interesting piece of HTA ingenuity:

 <HTA:APPLICATION 
      ID="objNoTitleBar"
      APPLICATIONNAME="Warning"
      BORDERSTYLE="static"
      BORDER="thick"
      SCROLL="no"
      SINGLEINSTANCE="yes"
      CAPTION="no"
 >
 
 <html>
 
 <SCRIPT LANGUAGE="VBScript">
 
     Sub Window_OnLoad
         window.resizeTo 200,1
         window.moveTo 0,0
         For i = 1 to 200
             window.resizeTo 200, i
         Next
         iTimerID = window.setInterval("CloseWindow", 5000)
     End Sub
 
     Sub CloseWindow
         For i = 200 to 1 Step -1
             window.resizeTo 200, i
         Next
        self.close
     End Sub
 
 </SCRIPT>
 
 <body bgcolor="buttonface" onkeypress="CloseWindow">
     <center>
     <font face="Arial" size="2"><b>Problem Detected</b><p>
     The domain controller is not responding to ping attempts.</font>
     </center>
 </body>
 </html>

To iterate is human, to recurse divine. -- L. Peter Deutsch

#9

Fredledingue

Total Posts : 572
Scores: 2
Reward points : 0
Joined: 5/9/2005
Location: Europe
Status: offline

RE: Image plus Text Viewer (HTA) Wednesday, November 22, 2006 10:18 AM (permalink)

0

ORIGINAL: TNO
I was thinking of making the image display portion open in a fullscreen mode.

Not a bad idea! I didn't think about that... I will try this solution.

The window attributes of an HTA are readonly defined at startup, so as a work-around guess you could document.write() the html of your HTA into the fullscreen pop-up window, then make it close when the window loses focus, hence giving the illusion of toggling modes.

I'm not sure if it will work properly or efficiently because some script won't benefit from the hta security waiver.

While trying to figure this out I came across this interesting piece of HTA ingenuity:

Nice. There are many things to do!
______________________

UPDATES:

v0.4

-Added "onmouseover" toolbar
-Added keyboard hotkeys (press "?" to see them)

Fred

#10

TNO

Total Posts : 2094
Scores: 36
Reward points : 0
Joined: 12/18/2004
Location: Earth
Status: offline

RE: Image plus Text Viewer (HTA) Friday, December 08, 2006 9:35 PM (permalink)

0

Have you considered using this for your zoom method? This should allow even humongoid sizes to still be displayed

<img src="http://www.visualbasicscript.com/images/logo.gif" onmouseover="this.style.zoom='250%'" onmouseout="this.style.zoom='100%'">

And for the popup problem (lack of HTA privelages), use one of thes methods insead:

http://msdn.microsoft.com/workshop/author/dhtml/reference/methods/showmodaldialog.asp

http://msdn.microsoft.com/workshop/author/dhtml/reference/methods/showmodelessdialog.asp