Title | Quickly view graphic files |
Keywords | viewer, graphic files, view files, utilities |
Categories | Utilities |
|
|
Use the DriveListBox, DirListBox, and FileListBox controls. When the user selects a new drive, set the DirListBox's
path to the new drive. When the user selects a new directory, set the FileListBox's path to the new directory.
When the user selects a new file, display it.
|
|
Private Sub DriveList_Change()
'On Error GoTo DriveError
DirList.Path = DriveList.Drive
Exit Sub
DriveError:
DriveList.Drive = DirList.Path
Exit Sub
End Sub
Private Sub DirList_Change()
FileList.Path = DirList.Path
End Sub
Private Sub FileList_Click()
Dim fname As String
fname = FileList.Path & "\" & FileList.FileName
MousePointer = vbHourglass
DoEvents
Caption = "Viewer [" & fname & "]"
On Error GoTo LoadPictureError
picImage.Picture = LoadPicture(fname)
On Error GoTo 0
ArrangeScrollbars
MousePointer = vbDefault
Exit Sub
LoadPictureError:
Beep
picImage.Picture = Nothing
Caption = "Viewer [Invalid picture]"
Resume Next
End Sub
|
|
The picScroller PictureBox contains the picImage control that holds the picture. The picImage control's
AutoSize property is True so picImage resizes itself to fit whenever the program loads a picture.
Subroutine ArrangeScrollbars displays appropriate scroll bars. It determines the amount of room the
picImage PictureBox needs and the amount of room available. It compares those values to see if it needs
the scroll bars. Note that displaying a scrol bar takes a little room so using one scroll bar may
make the other necessary, too.
Next the routine positions the needed scroll bars and sets their properties. It positions the
picScroller PictureBox to use the available area (less the space needed
for any scroll bars).
|
|
' Set scroll bar parameters if necessary.
Private Sub ArrangeScrollbars()
Dim need_hgt As Single
Dim need_wid As Single
Dim got_hgt As Single
Dim got_wid As Single
Dim need_hbar As Boolean
Dim need_vbar As Boolean
' See which scroll bars we need.
need_wid = picImage.Width
need_hgt = picImage.Height
got_wid = ScaleWidth - picScroller.Left
got_hgt = ScaleHeight - picScroller.Top
' See if we need the horizontal scroll bar.
need_hbar = (got_wid < need_wid)
If need_hbar Then
got_hgt = got_hgt - hbar.Height
End If
' See if we need the vertical scroll bar.
need_vbar = (got_hgt < need_hgt)
If need_vbar Then
got_wid = got_wid - vbar.Width
' See if we did not need the horizontal
' scroll bar but we now do.
If Not need_hbar Then
need_hbar = (got_wid < need_wid)
If need_hbar Then
got_hgt = got_hgt - hbar.Height
End If
End If
End If
If got_hgt < 120 Then got_hgt = 120
If got_wid < 120 Then got_wid = 120
' Display the needed scroll bars.
If need_hbar Then
hbar.Move picScroller.Left, got_hgt, got_wid
hbar.Min = 0
hbar.Max = got_wid - need_wid
hbar.SmallChange = got_wid / 3
hbar.LargeChange = picScroller.ScaleWidth
hbar.Visible = True
Else
hbar.Value = 0
hbar.Visible = False
End If
If need_vbar Then
vbar.Move picScroller.Left + got_wid, 0, _
vbar.Width, got_hgt
vbar.Min = 0
vbar.Max = got_hgt - need_hgt
vbar.SmallChange = got_hgt / 3
vbar.LargeChange = picScroller.ScaleHeight
vbar.Visible = True
Else
vbar.Value = 0
vbar.Visible = False
End If
' Arrange the window.
picScroller.Move picScroller.Left, 0, got_wid, got_hgt
End Sub
|
|
When the user adjusts the scroll bars, the program moves picImage inside picScroller to make the image move.
|
|
Private Sub hbar_Change()
picImage.Left = hbar.Value
End Sub
Private Sub hbar_Scroll()
picImage.Left = hbar.Value
End Sub
Private Sub vbar_Change()
picImage.Top = vbar.Value
End Sub
Private Sub vbar_Scroll()
picImage.Top = vbar.Value
End Sub
|
|
In the form's KeyDown event handler, process these user keys:
Key | Effect |
Delete | Move the file into the wastebasket. |
Backspace | Permanently kill the file. |
F5 | Hide/show the file selection controls. |
|
|
Private Sub Form_KeyDown(KeyCode As Integer, Shift As _
Integer)
Dim op As SHFILEOPSTRUCT
On Error GoTo KeyError
If KeyCode = vbKeyDelete Then
' Move the file into the wastebasket.
With op
.wFunc = FO_DELETE
.pFrom = FileList.Path & "\" & FileList.FileName
.fFlags = _
FOF_ALLOWUNDO Or _
FOF_NOCONFIRMATION
End With
SHFileOperation op
picImage.Picture = Nothing
vbar.Value = 0
hbar.Value = 0
vbar.Visible = False
hbar.Visible = False
ElseIf KeyCode = vbKeyBack Then
' Delete the file permanently.
Kill FileList.Path & "\" & FileList.FileName
picImage.Picture = Nothing
vbar.Value = 0
hbar.Value = 0
vbar.Visible = False
hbar.Visible = False
ElseIf KeyCode = vbKeyF5 Then
If picScroller.Left = 0 Then
picScroller.Left = 2 * DriveList.Left + _
DriveList.Width
Else
picScroller.Left = 0
End If
picScroller.Width = ScaleWidth - picScroller.Left
Form_Resize
End If
Exit Sub
KeyError:
MsgBox "Error " & Format$(Err.Number) & _
vbCrLf & Err.Description
Exit Sub
End Sub
|
|
In the form's KeyPress event handler, process these user keys:
Key | Effect |
Ctrl-D | Use the picture as the desktop wallpaper. |
The SystemParametersInfo API function expects the file to be a bitmap. If it is some other type of picture file, the program saves the picture in a temporary bitmap file and assigns it to the wallpaper.
|
|
' If the user presses Ctrl_D, set the picture as
' the desktop wallpaper.
Private Sub Form_KeyPress(KeyAscii As Integer)
Const KEY_CTRL_D = 4
Dim file_name As String
If KeyAscii = KEY_CTRL_D Then
KeyAscii = 0
file_name = FileList.Path & "\" & FileList.FileName
If UCase$(Right$(file_name, 4)) = ".BMP" Then
SystemParametersInfo _
SPI_SETDESKWALLPAPER, 0, _
file_name, 0
Else
file_name = TempFile("tmp")
file_name = Left$(file_name, Len(file_name) - _
3) & "bmp"
SavePicture picImage, file_name
SystemParametersInfo _
SPI_SETDESKWALLPAPER, 0, _
file_name, 0
Kill file_name
End If
Screen.MousePointer = vbDefault
End If
End Sub
|
|
Note that this code only sets the wallpaper until the next time the system boots. To make the wallpaper permanent, set SystemParametersInfo's final parameter to SPIF_UPDATEINIFILE (1).
|
|
|
|