Filer: code

• Een globale variabele om beelden te behandelen:
  'Als we een tekening opslaan, wordt dezelfde indeling gebruikt
  'Dus moeten we onthouden welke het oorspronkelijke formaat was
  Global pictureextensie As String
  
• Om de extensie te vinden
  Function napunt(instring As String) As String
  Dim temp As String
  Dim buffer As String
  Dim pos As Integer
  For pos = Len(instring) To 1 Step -1
  temp = Mid(instring, pos, 1)
  If Not temp = "." Then
  buffer = temp & buffer
  Else
  Exit For
  End If
  Next pos
  napunt = buffer
  'We moeten vermijden dat de hele string wordt teruggegeven als er nu per ongeluk geen punt zou instaan
  If InStr(instring, ".") = 0 Then napunt = ""
  End Function

• Bij het opstarten
  Private Sub Form_Load()
  leessettings
  'Verberg alle containers
  brwBrowser.Visible = False
  RTFBox.Visible = False
  picPicture.Visible = False
  'is er een parameter meegegeven?
  If Not Command = "" Then openbestand (Command)
  End Sub
  
• Om aan te passen aan de grootte
  Private Sub Form_Resize()
  'Alle containers op de grootte van het formulier zetten
  brwBrowser.top = 0
  brwBrowser.left = 0
  brwBrowser.Width = Me.Width
  brwBrowser.height = Me.height
  RTFBox.top = 0
  RTFBox.left = 0
  RTFBox.Width = Me.Width
  RTFBox.height = Me.height
  picPicture.top = 0
  picPicture.left = 0
  picPicture.Width = Me.Width
  picPicture.height = Me.height
  End Sub
  
• Settings bijhouden bij afsluiten
  Private Sub Form_Unload(Cancel As Integer)
  bewaarsettings
  End Sub
  
• De menu's om bestanden van een specifiek type te openen
  Private Sub mnuopenHTML_Click()
  On Error GoTo ErrOpenHTML
  cdlopen.Filter = "HTML bestanden (*.htm)|*.HTM;*.HTML|Alle bestanden|*.*"
  cdlopen.ShowOpen
  If Not cdlopen.FileName = "" Then
  Form_Load
  brwBrowser.Navigate (cdlopen.FileName)
  brwBrowser.Visible = True
  End If
  Exit Sub
  ErrOpenHTML:
  Select Case MsgBox(Err.Number & ": " & Err.Description, vbCritical + vbAbortRetryIgnore)
  Case vbAbort
  Exit Sub
  Case vbRetry
  Resume
  Case vbIgnore
  Resume Next
  End Select
  End Sub
  Private Sub mnuopenIMG_Click()
  On erroro GoTo ErrOpenImg
  cdlopen.Filter = "Beeldbestanden|*.BMP;*.WMF;*.ICO,*.*.GIF;*.JPG;*.JPEG|Alle bestanden|*.*"
  cdlopen.ShowOpen
  If Not cdlopen.FileName = "" Then
  Form_Load
  picPicture.Picture = LoadPicture(cdlopen.FileName)
  picPicture.Visible = True
  pictureextensie = napunt(cdlopen.FileName)
  End If
  Exit Sub
  ErrOpenImg:
  Select Case MsgBox(Err.Number & ": " & Err.Description, vbCritical + vbAbortRetryIgnore)
  Case vbAbort
  Exit Sub
  Case vbRetry
  Resume
  Case vbIgnore
  Resume Next
  End Select
  End Sub
  
  Private Sub mnuopenRTF_Click()
  On erroro GoTo ErrorOpenRTF
  cdlopen.Filter = "RTF bestanden (*.rtf)|*.RTF|Alle bestanden|*.*"
  cdlopen.ShowOpen
  If Not cdlopen.FileName = "" Then
  Form_Load
  RTFBox.LoadFile (cdlopen.FileName)
  RTFBox.Visible = True
  End If
  Exit Sub
  ErrOpenRTF:
  Select Case MsgBox(Err.Number & ": " & Err.Description, vbCritical + vbAbortRetryIgnore)
  Case vbAbort
  Exit Sub
  Case vbRetry
  Resume
  Case vbIgnore
  Resume Next
  End Select
  End Sub
  
  Private Sub mnuopenTXT_Click()
  On erroro GoTo ErrorOpenTXT
  'de filter instellen voor teksten
  cdlopen.Filter = "Tekstbestanden (*.txt)|*.TXT|Alle bestanden|*.*"
  cdlopen.Flags = &H80000
  cdlopen.ShowOpen
  If Not cdlopen.FileName = "" Then
  Form_Load
  'we zullen regel per regel inlezen
  Dim regel As String
  'en dan de tekst opbouwen
  Dim buffer As String
  Open cdlopen.FileName For Input As #1
  Do While Not EOF(1)
  Input #1, regel
  'regel per regel inlezen
  buffer = buffer & regel & vbCrLf
  Loop
  Close #1
  'alles is ingelezen, nu weergeven
  RTFBox.Text = buffer
  RTFBox.Visible = True
  End If
  Exit Sub
  ErrOpenTXT:
  Select Case MsgBox(Err.Number & ": " & Err.Description, vbCritical + vbAbortRetryIgnore)
  Case vbAbort
  Exit Sub
  Case vbRetry
  Resume
  Case vbIgnore
  Resume Next
  End Select
  End Sub
  
  Private Sub mnuopenurl_Click()
  Form_Load
  Dim url As String
  url = InputBox("Geef de URL waar je naar toe wil surfen", , "http://")
  If Not url = "" Then
  brwBrowser.Visible = True
  brwBrowser.Navigate (url)
  End If
  End Sub
  
  Private Sub mnuSave_Click()
  'Is het een tekst?
  If RTFBox.Visible Then
  cdlsave.Filter = "Tekstbestand|*.txt|RTF bestand|*.rtf"
  cdlsave.ShowSave
  'opslaan als er een bestandsnaam is gegeven
  If Not cdlsave.FileName = "" Then
  'Is er TXT of RTF als extensie gegeven?
  Select Case napunt(cdlsave.FileName)
  'Opslaan als tekst
  Case txt
  RTFBox.SaveFile cdlsave.FileName, rtfText
  'Opslaan als RTF
  Case rtf
  RTFBox.SaveFile cdlsave.FileName, rtfRTF
  End Select
  End If
  End If
  If picPicture.Visible Then 'image
  cdlsave.Filter = pictureextensie & "|*." & picturextensie
  'Als er geen extensie gegeven wordt, geven we de Default extensie
  cdlsave.DefaultExt = "." & pictureextensie
  cdlsave.ShowSave
  'opslaan als er een bestandsnaam is gegeven
  If Not cdlsave.FileName = "" Then SavePicture picPicture.Picture, cdlsave.FileName
  End If
  If brwBrowser.Visible Then 'HTML document
  cdlsave.Filter = "HTML bestand|*.htm"
  cdlsave.ShowSave
  If Not cdlsave.FileName = "" Then
  Open cdlsave.FileName For Output As #1
  Print #1, brwBrowser.Document
  Close #1
  End If
  End If
  End Sub
  
  Private Sub mnuSluit_Click()
  End
  End Sub
  
• Een willekeurig bestand opeenn: eerst de extensie vinden, dan openen
  Private Sub openbestand(fn As String)
  'welke is de extensie?
  Select Case napunt(fn)
  Case "txt"
  'langs CommonDialog, dan wordt het bestand opgenomen in de laatst bewerkte bestanden
  cdlopen.FileName = fn
  Form_Load
  Dim regel As String
  Dim buffer As String
  Open cdlopen.FileName For Input As #1
  Do While Not EOF(1)
  Input #1, regel
  buffer = buffer & regel & vbCrLf
  Loop
  Close #1
  RTFBox.Text = buffer
  RTFBox.Visible = True
  End If
  Case "rtf"
  
  Case "bmp", "wmf", "ico", "gif", "jpg", "jpeg"
  cdlopen.FileName = fn
  Form_Load
  picPicture.Picture = LoadPicture(cdlopen.FileName)
  picPicture.Visible = True
  pictureextensie = napunt(cdlopen.FileName)
  Case "htm", "html"
  cdlopen.FileName = fn
  Form_Load
  brwBrowser.Navigate (cdlopen.FileName)
  brwBrowser.Visible = True
  End Sub
  
• De instellingen oplsaan en inlezen
  Private Sub bewaarsettings()
  On Error Resume Next
  SaveSetting App.EXEName, "settings", "top", top
  SaveSetting App.EXEName, "settings", "left", left
  SaveSetting App.EXEName, "settings", "height", heigth
  End Sub
  Private Sub leessettings()
  On Error Resume Next
  Dim top As Integer
  Dim left As Integer
  Dim height As Integer
  top = CInt(GetSetting(App.EXEName, "settings", "top"))
  left = CInt(GetSetting(App.EXEName, "settings", "left"))
  height = CInt(GetSetting(App.EXEName, "settings", "height"))
  frmFiler.top = top
  frmFiler.left = left
  frmFiler.height = height
  End Sub
  

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