Siteviewer: code

• Als het venster van afmetingen verandert, passen we de afmetingen van de browser en de bestandslijst aan.
  Private Sub Form_Resize()
  If Me.WindowState = vbMinimized Then Exit Sub
  With WebBrowser1
  .Width = Me.Width - 2000
  .Height = Me.Height - .Top - 500
  End With
  With File1
  .Height = Me.Height - .Top - 500
  End With
  End Sub
  
• Om de lijst van bestanden te tonen
  Private Sub Dir1_Change()
  File1.Path = Dir1.Path
  End Sub
  
  Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
  End Sub
  
• Om na te gaan of een bestand kan getoond worden in een browser gebruiken we een functie
  Function GetExtension(padnaam As String) As String
  Dim puntpositie As Integer
  Dim positie As Integer
  For positie = Len(padnaam) To 1 Step -1
  If Mid(padnaam, positie, 1) = "." Then
  puntpositie = positie
  Exit For
  End If
  Next positie
  If Not puntpositie = 0 Then GetExtension = Right(padnaam, Len(padnaam) - puntpositie)
  End Function
  
• Als we werken met een DirList en een FileList hebben we ook de volgende functie nodig om het pad van een bestand te vinden:
  Function ext(padnaam As String) As String
  If Right(padnaam, 1) = "\" Then
  ext = padnaam
  Else
  ext = padnaam & "\"
  End If
  End Function
  
• En tenslotte: om het bestand te tonen gebruiken we deze code (met foutenafhandeling)
  Private Sub File1_Click()
  On Error GoTo ErrBrowse
  Dim filename As String
  filename = ext(Dir1.Path) & File1.filename
  Select Case LCase(GetExtension(filename))
  Case "htm", "html", "gif", "jpeg", "jpg", "txt"
  WebBrowser1.Navigate2 filename
  Me.Caption = filename
  End Select
  Exit Sub
  ErrBrowse:
  Select Case MsgBox("Fout " & Err.Number & vbCrLf & Err.Description, vbAbortRetryIgnore)
  Case vbRetry
  Resume
  Case vbIgnore
  Resume 0
  Case vbCancel
  Resume Next
  End Select
  End Sub

[VB Web] - [hlrnet] - [copyright]