Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH4/SRC/FILTER.FRM

Visual Basic Form | 1997-01-03 | 27.8 KB | 864 lines

VERSION 4.00
Begin VB.Form FilterForm
   Caption         =   "Filters"
   ClientHeight    =   4020
   ClientLeft      =   840
   ClientTop       =   1275
   ClientWidth     =   8310
   Height          =   4710
   Left            =   780
   LinkTopic       =   "Form1"
   ScaleHeight     =   268
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   554
   Top             =   645
   Width           =   8430
   Begin VB.ComboBox FilterCombo
      Height          =   315
      Left            =   3360
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   480
      Width           =   1575
   End
   Begin VB.PictureBox ToSwin
      Height          =   3735
      Left            =   5040
      ScaleHeight     =   245
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   197
      TabIndex        =   9
      Top             =   0
      Width           =   3015
      Begin VB.PictureBox ToPict
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         Height          =   75
         Left            =   0
         MousePointer    =   2  'Cross
         Picture         =   "FILTER.frx":0000
         ScaleHeight     =   1
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   1
         TabIndex        =   10
         Top             =   0
         Width           =   75
      End
   End
   Begin VB.PictureBox FromSwin
      Height          =   3735
      Left            =   0
      ScaleHeight     =   245
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   197
      TabIndex        =   7
      Top             =   0
      Width           =   3015
      Begin VB.PictureBox FromPict
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         Height          =   75
         Left            =   0
         MousePointer    =   2  'Cross
         Picture         =   "FILTER.frx":0446
         ScaleHeight     =   1
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   1
         TabIndex        =   8
         Top             =   0
         Width           =   75
      End
   End
   Begin VB.VScrollBar ToVBar
      Height          =   3735
      Left            =   8040
      TabIndex        =   6
      Top             =   0
      Width           =   255
   End
   Begin VB.HScrollBar ToHBar
      Height          =   255
      Left            =   5040
      TabIndex        =   5
      Top             =   3720
      Width           =   3045
   End
   Begin VB.CommandButton CmdCopy
      Caption         =   "<-- Copy"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3720
      TabIndex        =   4
      Top             =   1920
      Width           =   855
   End
   Begin VB.CommandButton CmdApply
      Caption         =   "Apply -->"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3720
      TabIndex        =   3
      Top             =   1080
      Width           =   855
   End
   Begin VB.CheckBox ProgressCheck
      Caption         =   "Show Progress"
      Height          =   255
      Left            =   3360
      TabIndex        =   2
      Top             =   120
      Width           =   1575
   End
   Begin VB.HScrollBar FromHBar
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   3720
      Width           =   3045
   End
   Begin VB.VScrollBar FromVBar
      Height          =   3735
      Left            =   3000
      TabIndex        =   0
      Top             =   0
      Width           =   255
   End
   Begin MSComDlg.CommonDialog FileDialog
      Left            =   3960
      Top             =   2880
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileLoad
         Caption         =   "&Load..."
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuFileSave
         Caption         =   "&Save"
         Enabled         =   0   'False
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFileSaveAs
         Caption         =   "Save &As..."
         Enabled         =   0   'False
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuFileSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileRevert
         Caption         =   "&Revert"
         Enabled         =   0   'False
         Shortcut        =   ^R
      End
      Begin VB.Menu mnuFileSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuOpt
      Caption         =   "&Options"
      Begin VB.Menu mnuOptShowFilter
         Caption         =   "&Show Filter..."
         Shortcut        =   ^F
      End
   End
Attribute VB_Name = "FilterForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim SysPalSize As Integer
Dim NumStaticColors As Integer
Dim StaticColor1 As Integer
Dim StaticColor2 As Integer
Dim DataChanged As Boolean
Dim FileLoaded As String
Dim LogPal As Integer
Dim palentry(0 To 255) As PALETTEENTRY
Dim wid As Long
Dim hgt As Long
Dim bytes() As Byte
' ************************************************
' Put the names of the available filters in the
' filter combo box.
' ************************************************
Sub LoadFilterChoices()
    FilterCombo.AddItem "Average 3x3"
    FilterCombo.AddItem "Low Pass 3x3"
    FilterCombo.AddItem "Low Pass 5x5"
    FilterCombo.AddItem "Low Pass 7x7"
    FilterCombo.AddItem "High Pass 1"
    FilterCombo.AddItem "High Pass 2"
    FilterCombo.AddItem "High Pass 3"
    FilterCombo.AddItem "High Pass 4"
    FilterCombo.AddItem "Prewitt Up"
    FilterCombo.AddItem "Prewitt Up-Right"
    FilterCombo.AddItem "Prewitt Right"
    FilterCombo.AddItem "Prewitt Down-Right"
    FilterCombo.AddItem "Prewitt Down"
    FilterCombo.AddItem "Prewitt Down-Left"
    FilterCombo.AddItem "Prewitt Left"
    FilterCombo.AddItem "Prewitt Up-Left"
    FilterCombo.AddItem "Laplacian 1"
    FilterCombo.AddItem "Laplacian 2"
    FilterCombo.AddItem "Minimum 3x3"
    FilterCombo.AddItem "Median 3x3"
    FilterCombo.AddItem "Maximum 3x3"
    FilterCombo.AddItem "Voting 3x3"
    FilterCombo.AddItem "Emboss Up"
    FilterCombo.AddItem "Emboss Up-Right"
    FilterCombo.AddItem "Emboss Right"
    FilterCombo.AddItem "Emboss Down-Right"
    FilterCombo.AddItem "Emboss Down"
    FilterCombo.AddItem "Emboss Down-Left"
    FilterCombo.AddItem "Emboss Left"
    FilterCombo.AddItem "Emboss Up-Left"
    FilterCombo.AddItem "Erosion"
    FilterCombo.AddItem "Dilation"
    FilterCombo.AddItem "Erosion Outline"
    FilterCombo.AddItem "Dilation Outline"
    FilterCombo.ListIndex = 0
End Sub
' ***********************************************
' Load the control's palette so it matches the
' the system palette. Remap any of the image's
' pixels that use static colors to non-static
' colors.
' Set the following module global variables.
'   LogPal      Image logical palette handle.
'   palentry()  Image logical palette entries.
'   wid         Width of image.
'   hgt         Height of image.
'   bytes(1 To wid, 1 To hgt)
'               Image pixel values.
' ***********************************************
Sub MatchColorPalette(pic As Control)
Dim sys(0 To 255) As PALETTEENTRY
Dim i As Integer
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim x As Integer
Dim y As Integer
Dim clr As Integer
    ' Make sure pic has the foreground palette.
    pic.ZOrder
    i = RealizePalette(pic.hdc)
    DoEvents
    ' Get the system palette entries.
    i = GetSystemPaletteEntries(pic.hdc, 0, SysPalSize, sys(0))

    ' Make the logical palette as big as possible.
    LogPal = pic.Picture.hPal
    If ResizePalette(LogPal, SysPalSize) = 0 Then
        Beep
        MsgBox "Error resizing logical palette.", _
            vbExclamation
        Exit Sub
    End If
    ' Blank the non-static colors.
    For i = 0 To StaticColor1
        palentry(i) = sys(i)
    Next i
    For i = StaticColor1 + 1 To StaticColor2 - 1
        With palentry(i)
            .peRed = 0
            .peGreen = 0
            .peBlue = 0
            .peFlags = PC_NOCOLLAPSE
        End With
    Next i
    For i = StaticColor2 To 255
        palentry(i) = sys(i)
    Next i
    i = SetPaletteEntries(LogPal, 0, SysPalSize, palentry(0))
    ' Insert the non-static colors.
    For i = StaticColor1 + 1 To StaticColor2 - 1
        palentry(i) = sys(i)
        palentry(i).peFlags = PC_NOCOLLAPSE
    Next i
    i = SetPaletteEntries(LogPal, StaticColor1 + 1, StaticColor2 - StaticColor1 - 1, palentry(StaticColor1 + 1))
    ' Realize the new palette.
    i = RealizePalette(pic.hdc)
    ' Get the image pixels.
    hbm = pic.Image
    status = GetObject(hbm, BITMAP_SIZE, bm)
    wid = bm.bmWidthBytes
    hgt = bm.bmHeight
    ReDim bytes(1 To wid, 1 To hgt)
    status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
    ' Remap any pixels using static colors.
    For y = 1 To hgt
        For x = 1 To wid
            clr = bytes(x, y)
            If clr <= StaticColor1 Or clr >= StaticColor2 Then
                With sys(clr)
                    bytes(x, y) = _
                        NearestNonstaticColor( _
                        .peRed, .peGreen, .peBlue)
                End With
            End If
        Next x
    Next y
    ' Update the image's pixel values.
    status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
    pic.Refresh
End Sub
' ***********************************************
' Load the control's palette so the non-static
' colors are grays. Map the logical palette to
' match the system palette. Convert the image to
' use the non-static grays.
' Set the following module global variables.
'   LogPal      Image logical palette handle.
'   palentry()  Image logical palette entries.
'   wid         Width of image.
'   hgt         Height of image.
'   bytes(1 To wid, 1 To hgt)
'               Image pixel values.
' ***********************************************
Sub MatchGrayPalette(pic As Control)
Dim sys(0 To 255) As PALETTEENTRY
Dim i As Integer
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim x As Integer
Dim y As Integer
Dim gray As Single
Dim dgray As Single
Dim c As Integer
Dim clr As Integer
    ' Make sure pic has the foreground palette.
    pic.ZOrder
    i = RealizePalette(pic.hdc)
    DoEvents
    ' Get the system palette entries.
    i = GetSystemPaletteEntries(pic.hdc, 0, SysPalSize, sys(0))

    ' Get the image pixels.
    hbm = pic.Image
    status = GetObject(hbm, BITMAP_SIZE, bm)
    wid = bm.bmWidthBytes
    hgt = bm.bmHeight
    ReDim bytes(1 To wid, 1 To hgt)
    status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
    ' Make the logical palette as big as possible.
    LogPal = pic.Picture.hPal
    If ResizePalette(LogPal, SysPalSize) = 0 Then
        Beep
        MsgBox "Error resizing logical palette.", _
            vbExclamation
        Exit Sub
    End If
    ' Blank the non-static colors.
    For i = 0 To StaticColor1
        palentry(i) = sys(i)
    Next i
    For i = StaticColor1 + 1 To StaticColor2 - 1
        With palentry(i)
            .peRed = 0
            .peGreen = 0
            .peBlue = 0
            .peFlags = PC_NOCOLLAPSE
        End With
    Next i
    For i = StaticColor2 To 255
        palentry(i) = sys(i)
    Next i
    i = SetPaletteEntries(LogPal, 0, SysPalSize, palentry(0))
    ' Insert the non-static grays.
    gray = 0
    dgray = 255 / (StaticColor2 - StaticColor1 - 2)
    For i = StaticColor1 + 1 To StaticColor2 - 1
        c = gray
        gray = gray + dgray
        With palentry(i)
            .peRed = c
            .peGreen = c
            .peBlue = c
        End With
    Next i
    i = SetPaletteEntries(LogPal, StaticColor1 + 1, StaticColor2 - StaticColor1 - 1, palentry(StaticColor1 + 1))
    ' Recreate the image using the new colors.
    For y = 1 To hgt
        For x = 1 To wid
            clr = bytes(x, y)
            With sys(clr)
                c = (CInt(.peRed) + .peGreen + .peBlue) / 3
            End With
            bytes(x, y) = NearestNonstaticGray(c)
        Next x
    Next y
    status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
    ' Realize the gray palette.
    i = RealizePalette(pic.hdc)
    pic.Refresh
End Sub
' ************************************************
' Return the index of the nonstatic gray closest
' to the given value (assuming the non-static
' colors are a gray scale created by
' MatchGrayPalette).
' ************************************************
Function NearestNonstaticGray(c As Integer) As Integer
Dim dgray As Single
    If c < 0 Then
        c = 0
    ElseIf c > 255 Then
        c = 255
    End If
    dgray = 255 / (StaticColor2 - StaticColor1 - 2)
    NearestNonstaticGray = c / dgray + StaticColor1 + 1
End Function
' ************************************************
' Return the index of the nonstatic color closest
' to the given color value.
' ************************************************
Function NearestNonstaticColor(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As Integer
Dim best_i As Integer
Dim best_dist As Long
Dim dist As Long
Dim dr As Long
Dim dg As Long
Dim db As Long
Dim i As Integer
    best_dist = 1000000
    For i = StaticColor1 + 1 To StaticColor2 - 1
        With palentry(i)
            dr = r - .peRed
            dg = g - .peGreen
            db = b - .peBlue
            dist = dr * dr + dg * dg + db * db
        End With
        If best_dist > dist Then
            best_i = i
            best_dist = dist
        End If
    Next i
    NearestNonstaticColor = best_i
End Function
' ***********************************************
' If the data has been modified, allow the user
' to save the changes or cancel the operation.
' Return True if:
'   - The image data has not been changed since
'       it was loaded.
'   - The user saves the changes.
'   - The user says not to save.
' Return False otherwise.
' ***********************************************
Function DataSafe() As Boolean
    DataSafe = True
    ' This is done in a while loop in case the
    ' user starts a save and then cancels.
    Do While DataChanged
        Select Case MsgBox("The data has been modified. Do you want to save the changes?", vbQuestion + vbYesNoCancel, "Data Modified")
            Case vbYes
                If FileLoaded <> "" Then
                    mnuFileSave_Click
                Else
                    mnuFileSaveAs_Click
                End If
                DataSafe = Not DataChanged

            Case vbNo
                DataSafe = True
                Exit Do
            Case vbCancel
                DataSafe = False
                Exit Do
        End Select
    Loop
End Function
' ***********************************************
' Load the indicated file and prepare to work
' with its palette.
' ***********************************************
Sub LoadFromPict(fname As String)
    On Error GoTo LoadFileError
    FromPict.Picture = LoadPicture(fname)

    FromPict.Move 0, 0
    ToPict.Move 0, 0
    MatchGrayPalette FromPict
    ToPict.Picture = FromPict.Image
    MatchGrayPalette ToPict
    FromSwin.ZOrder
    DoEvents
    ToSwin.ZOrder
    DoEvents
    ResetScrollBars
    FileLoaded = fname
    Caption = "Filters [" & fname & "]"
    mnuFileSave.Enabled = True
    mnuFileSaveAs.Enabled = True
    mnuFileRevert.Enabled = True
    CmdApply.Enabled = True
    CmdCopy.Enabled = True
    DataChanged = False
    Exit Sub
LoadFileError:
    Beep
    MsgBox "Error loading file " & fname & "." & _
        vbCrLf & Error$
    Exit Sub
End Sub
' ***********************************************
' Set the Max and LargeChange properties for the
' image scroll bars.
' ***********************************************
Sub ResetScrollBars()
    ' FromHBar.
    FromHBar.value = 0
    If FromSwin.ScaleWidth >= FromPict.Width Then
        FromHBar.Enabled = False
    Else
        FromHBar.Max = FromPict.Width - FromSwin.ScaleWidth
        FromHBar.LargeChange = FromSwin.ScaleWidth
        FromHBar.Enabled = True
    End If
    ' FromVBar.
    FromVBar.value = 0
    If FromSwin.ScaleHeight >= FromPict.Height Then
        FromVBar.Enabled = False
    Else
        FromVBar.Max = FromPict.Height - FromSwin.ScaleHeight
        FromVBar.LargeChange = FromSwin.ScaleHeight
        FromVBar.Enabled = True
    End If
    ' ToHBar.
    ToHBar.value = 0
    If FromSwin.ScaleWidth >= ToPict.Width Then
        ToHBar.Enabled = False
    Else
        ToHBar.Max = ToPict.Width - ToSwin.ScaleWidth
        ToHBar.LargeChange = ToSwin.ScaleWidth
        ToHBar.Enabled = True
    End If
    ' ToVBar.
    ToVBar.value = 0
    If FromSwin.ScaleHeight >= ToPict.Height Then
        ToVBar.Enabled = False
    Else
        ToVBar.Max = ToPict.Height - ToSwin.ScaleHeight
        ToVBar.LargeChange = ToSwin.ScaleHeight
        ToVBar.Enabled = True
    End If
End Sub
' ***********************************************
' Give the form and all the picture boxes an
' hourglass cursor.
' ***********************************************
Sub WaitStart()
    MousePointer = vbHourglass
    FromPict.MousePointer = vbHourglass
    ToPict.MousePointer = vbHourglass
    DoEvents
End Sub
' ***********************************************
' Restore the mouse pointers for the form and all
' the picture boxes.
' ***********************************************
Sub WaitEnd()
    MousePointer = vbDefault
    FromPict.MousePointer = vbDefault
    ToPict.MousePointer = vbDefault
End Sub
' ************************************************
' Apply the selected filter to FromPict.
' ************************************************
Private Sub CmdApply_Click()
Static btn_caption As String
Dim fil As New Filter
    ' If the filter is running, stop it.
    If OperationRunning Then
        ' Set a flag so the filter will stop.
        OperationRunning = False

        ' Disable this button.
        CmdApply.Enabled = False
        CmdApply.Caption = "Stopping"
        Exit Sub
    End If
    ' Make sure something is selected.
    If FilterCombo.ListIndex < 0 Then
        Beep
        Exit Sub
    End If
    ' Otherwise start the filter running.
    OperationRunning = True
    btn_caption = CmdApply.Caption
    CmdApply.Caption = "Stop"
    CmdCopy.Enabled = False
    WaitStart
    ' Initialize the filter.
    fil.InitializeFilter FilterCombo.List(FilterCombo.ListIndex)
    ' Apply the filter.
    fil.ApplyFilter FromPict, ToPict, _
        (ProgressCheck.value = vbChecked)
    ' Reenable this button.
    CmdApply.Caption = btn_caption
    CmdApply.Enabled = True
    CmdCopy.Enabled = True
    OperationRunning = False
    WaitEnd
    ' This could have taken a long time so wake
    ' the user up.
    Beep
End Sub
' ************************************************
' Copy ToPict into FromPict.
' ************************************************
Private Sub CmdCopy_Click()
    FromPict.PaintPicture ToPict.Image, 0, 0
    DataChanged = True
End Sub
' ***********************************************
' 1. Make sure we can handle palettes.
' 2. Find out how big the system palette is and how
' many static colors there are.
' 3. Load and display the system palette.
' ***********************************************
Private Sub Form_Load()
    ' Make sure the screen supports palettes.
    If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
        Beep
        MsgBox "This monitor does not support palettes.", _
            vbCritical
        End
    End If
    ' Get system palette size and # static colors.
    SysPalSize = GetDeviceCaps(hdc, SIZEPALETTE)
    NumStaticColors = GetDeviceCaps(hdc, NUMRESERVED)
    StaticColor1 = NumStaticColors \ 2 - 1
    StaticColor2 = SysPalSize - NumStaticColors \ 2
    ' Remove the borders from the drawing areas.
    FromPict.BorderStyle = vbTransparent
    ToPict.BorderStyle = vbTransparent
    ' Load the filter choices.
    LoadFilterChoices
End Sub
' ***********************************************
' Refuse to unload if there are unsaved changes.
' ***********************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Cancel = Not DataSafe()
End Sub
' ***********************************************
' Make the picture as large as possible.
' ***********************************************
Private Sub Form_Resize()
Const GAP = 4
Dim hgt As Single
Dim wid As Single
    If WindowState = vbMinimized Then Exit Sub
    hgt = ScaleHeight - FromHBar.Height - 1
    wid = (ScaleWidth - ProgressCheck.Width - 1 - _
        2 * GAP - 2 * FromVBar.Width - 2) / 2
    ' Place FromSwin and its scroll bars.
    FromSwin.Move 0, 0, wid, hgt
    FromVBar.Move _
        FromSwin.Left + FromSwin.Width + 1, _
        0, FromVBar.Width, hgt
    FromHBar.Move _
        FromSwin.Left, FromSwin.Height + 1, _
        wid
    ' Place the command buttons and stuff.
    ProgressCheck.Left = (ScaleWidth - ProgressCheck.Width) / 2
    FilterCombo.Left = (ScaleWidth - FilterCombo.Width) / 2
    CmdApply.Left = (ScaleWidth - CmdApply.Width) / 2
    CmdCopy.Left = (ScaleWidth - CmdCopy.Width) / 2
    ' Place ToSwin and its scroll bars.
    ToSwin.Move ProgressCheck.Left + _
        ProgressCheck.Width + GAP, 0, wid, hgt
    ToVBar.Move _
        ToSwin.Left + ToSwin.Width + 1, _
        0, ToVBar.Width, hgt
    ToHBar.Move _
        ToSwin.Left, ToSwin.Height + 1, _
        wid
    ' Set the scroll bar limits.
    ResetScrollBars
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
' ***********************************************
' Move FromPict within FromSwin.
' ***********************************************
Private Sub FromHBar_Change()
    FromPict.Left = -FromHBar.value
End Sub
' ***********************************************
' Move FromPict within FromSwin.
' ***********************************************
Private Sub FromHBar_Scroll()
    FromPict.Left = -FromHBar.value
End Sub
' ***********************************************
' Load a new image file.
' ***********************************************
Private Sub mnuFileLoad_Click()
Dim fname As String
    ' Make sure any changes have been saved.
    If Not DataSafe() Then Exit Sub
    ' Allow the user to pick a file.
    On Error Resume Next
    FileDialog.filename = "*.BMP;*.ICO;*.RLE;*.WMF;*.DIB"
    FileDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
    FileDialog.ShowOpen
    If Err.Number = cdlCancel Then
        Exit Sub
    ElseIf Err.Number <> 0 Then
        Beep
        MsgBox "Error selecting file.", , vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    fname = Trim$(FileDialog.filename)
    FileDialog.InitDir = Left$(fname, Len(fname) _
        - Len(FileDialog.FileTitle) - 1)
    ' Load the picture.
    WaitStart
    LoadFromPict fname
    WaitEnd
End Sub
' ***********************************************
' Reload the file.
' ***********************************************
Private Sub mnuFileRevert_Click()
    ' If the data has changed, get confirmation.
    If DataChanged Then
        If MsgBox("The data has been modified. Are you sure you want to remove the changes?", _
            vbQuestion + vbYesNo) = vbNo Then _
                Exit Sub
    End If
    ' Reload the picture.
    WaitStart
    DoEvents
    LoadFromPict FileLoaded
    WaitEnd
End Sub
' ***********************************************
' Save the image in the file from which it was
' loaded.
' ***********************************************
Private Sub mnuFileSave_Click()
    WaitStart
    DoEvents
    SaveFromPict FileLoaded
    WaitEnd
End Sub
' ***********************************************
' Save the image in a new file.
' ***********************************************
Private Sub mnuFileSaveAs_Click()
Dim fname As String
    ' Allow the user to pick a file.
    On Error Resume Next
    FileDialog.filename = "*.BMP;*.ICO;*.RLE;*.WMF;*.DIB"
    FileDialog.Flags = cdlOFNOverwritePrompt + _
        cdlOFNHideReadOnly + cdlOFNPathMustExist
    FileDialog.ShowSave
    If Err.Number = cdlCancel Then
        Exit Sub
    ElseIf Err.Number <> 0 Then
        Beep
        MsgBox "Error selecting file.", , vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    fname = Trim$(FileDialog.filename)
    FileDialog.InitDir = Left$(fname, Len(fname) _
        - Len(FileDialog.FileTitle) - 1)
    ' Save the picture.
    WaitStart
    DoEvents
    SaveFromPict fname
    WaitEnd
End Sub
' ***********************************************
' Save the picture in the indicated file.
' ***********************************************
Sub SaveFromPict(fname As String)
    On Error GoTo SaveError
    SavePicture FromPict.Image, fname
    Caption = "Filters [" & fname & "]"
    FileLoaded = fname
    DataChanged = False
    Exit Sub
SaveError:
    Beep
    MsgBox "Error saving picture in file " & _
        fname & "." & vbCrLf & vbCrLf & _
        Error$, , vbExclamation
    Exit Sub
End Sub
' ***********************************************
' End the application. (See also the QueryUnload
' event.)
' ***********************************************
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
' ***********************************************
' Move FromPict within FromSwin.
' ***********************************************
Private Sub FromVBar_Change()
    FromPict.Top = -FromVBar.value
End Sub
' ***********************************************
' Move FromPict within FromSwin.
' ***********************************************
Private Sub FromVBar_Scroll()
    FromPict.Top = -FromVBar.value
End Sub
' ************************************************
' Display a message box showing the filter's
' components and weight.
' ************************************************
Private Sub mnuOptShowFilter_Click()
Dim fil As New Filter
    ' Make sure something is selected.
    If FilterCombo.ListIndex < 0 Then
        Beep
        Exit Sub
    End If
    ' Initialize the filter.
    fil.InitializeFilter FilterCombo.List(FilterCombo.ListIndex)
    ' Show the filter.
    fil.ShowFilter
End Sub
' ***********************************************
' Move ToPict within ToSwin.
' ***********************************************
Private Sub ToHBar_Change()
    ToPict.Left = -ToHBar.value
End Sub
' ***********************************************
' Move ToPict within ToSwin.
' ***********************************************
Private Sub ToHBar_Scroll()
    ToPict.Left = -ToHBar.value
End Sub
' ***********************************************
' Move ToPict within ToSwin.
' ***********************************************
Private Sub ToVBar_Change()
    ToPict.Top = -ToVBar.value
End Sub
' ***********************************************
' Move ToPict within ToSwin.
' ***********************************************
Private Sub ToVBar_Scroll()
    ToPict.Top = -ToVBar.value
End Sub