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

Visual Basic Form | 1996-05-01 | 24.7 KB | 816 lines

VERSION 4.00
Begin VB.Form WarpForm
   Caption         =   "Warp"
   ClientHeight    =   4560
   ClientLeft      =   735
   ClientTop       =   1065
   ClientWidth     =   8235
   Height          =   5250
   Left            =   675
   LinkTopic       =   "Form1"
   ScaleHeight     =   304
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   549
   Top             =   435
   Width           =   8355
   Begin VB.CommandButton CmdWarp
      Caption         =   "Warp"
      Enabled         =   0   'False
      Height          =   375
      Left            =   1320
      TabIndex        =   3
      Top             =   4125
      Width           =   855
   End
   Begin VB.ComboBox WarpCombo
      Height          =   315
      ItemData        =   "WARPFORM.frx":0000
      Left            =   720
      List            =   "WARPFORM.frx":0010
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   3720
      Width           =   2175
   End
   Begin VB.PictureBox ToPict
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0C0C0&
      Height          =   4560
      Left            =   3660
      Picture         =   "WARPFORM.frx":0032
      ScaleHeight     =   300
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   300
      TabIndex        =   1
      Top             =   0
      Width           =   4560
   End
   Begin VB.PictureBox FromPict
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0C0C0&
      Height          =   3615
      Left            =   0
      Picture         =   "WARPFORM.frx":0478
      ScaleHeight     =   237
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   237
      TabIndex        =   0
      Top             =   0
      Width           =   3615
   End
   Begin MSComDlg.CommonDialog FileDialog
      Left            =   3000
      Top             =   3840
      _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 mnuFileSep
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "WarpForm"
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 LogPal As Integer
Dim palentry(0 To 255) As PALETTEENTRY
Dim wid As Long
Dim hgt As Long
Dim bytes() As Byte
' ************************************************
' Return the arc tangent of y/x taking into
' account the proper quadrant.
' ************************************************
Function Arctan2(x As Single, y As Single)
Const PI = 3.14159
Const PI_OVER_2 = PI / 2
Dim theta As Single
    If x = 0 Then
        If y > 0 Then
            Arctan2 = PI_OVER_2
        Else
            Arctan2 = -PI_OVER_2
        End If
    Else
        theta = Atn(y / x)
        If x < 0 Then theta = PI + theta
        Arctan2 = theta
    End If
End Function
' ************************************************
' Draw the warped image.
' ************************************************
Sub DrawImage()
Dim x2 As Integer
Dim y2 As Integer
Dim idx As Integer
    ToPict.Cls
    x2 = FromPict.ScaleWidth - 1
    y2 = FromPict.ScaleHeight - 1
    ' See which kind of warping the user wants.
    idx = WarpCombo.ListIndex
    If idx < 0 Then
        Beep
        Exit Sub
    End If
    Select Case WarpCombo.List(idx)
        Case "Wave"
            WavePicture FromPict, ToPict, _
                0, 0, x2, y2

        Case "Twist"
            TwistPicture FromPict, ToPict, _
                0, 0, x2, y2

        Case "Fisheye"
            FisheyePicture FromPict, ToPict, _
                0, 0, x2, y2

        Case "Narrow"
            NarrowPicture FromPict, ToPict, _
                0, 0, x2, y2

        Case Else
            Beep
            Exit Sub
    End Select
End Sub
' ************************************************
' Narrow X towards the top.
' ************************************************
Sub NarrowPicture( _
    ByVal from_pic As Control, ByVal to_pic As Control, _
    ByVal fx1 As Integer, ByVal fy1 As Integer, _
    ByVal fx2 As Integer, ByVal fy2 As Integer)
Const MIN_FACT = 0.3
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim from_bytes() As Byte
Dim to_bytes() As Byte
Dim from_wid As Long
Dim from_hgt As Long
Dim to_wid As Long
Dim to_hgt As Long
Dim tx1 As Single
Dim tx2 As Single
Dim ty1 As Single
Dim ty2 As Single
Dim fx As Single
Dim fy As Single
Dim tx As Single
Dim ty As Single
Dim fxmid As Single
Dim txmid As Single
Dim x As Single
Dim y As Single
Dim ifx As Integer
Dim ify As Integer
Dim dx As Single
Dim dy As Single
Dim fact As Single
Dim dfact As Single
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim c4 As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim clr As Integer
    ' Get from_pic's pixels.
    hbm = from_pic.Image
    status = GetObject(hbm, 14, bm)
    from_wid = bm.bmWidthBytes
    from_hgt = bm.bmHeight
    ReDim from_bytes(0 To from_wid - 1, 0 To from_hgt - 1)
    status = GetBitmapBits(hbm, from_wid * from_hgt, from_bytes(0, 0))
    ' Get to_pic's pixels.
    hbm = to_pic.Image
    status = GetObject(hbm, 14, bm)
    to_wid = bm.bmWidthBytes
    to_hgt = bm.bmHeight
    ReDim to_bytes(0 To to_wid - 1, 0 To to_hgt - 1)
    status = GetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))

    ' Set the bounds for to_pic.
    tx1 = fx1
    tx2 = fx2
    ty1 = fy1
    ty2 = fy2
    txmid = (tx1 + tx2) / 2
    fxmid = (fx1 + fx2) / 2
    ' Perform the transformation.
    fact = MIN_FACT
    dfact = (1 - MIN_FACT) / (ty2 - ty1)
    For ty = ty1 To ty2
        For tx = tx1 To tx2
            ' See where the point came from.
            dx = tx - txmid
            fx = dx / fact + fxmid
            fy = ty

            ' Skip it if any of the four nearest
            ' source pixels lie outside the allowed
            ' source area.
            ify = Int(fy)
            ifx = Int(fx)
            If ifx >= fx1 And ifx < fx2 And _
               ify >= fy1 And ify < fy2 Then
                ' Interpolate using the four nearest
                ' pixels in from_pic.
                dy = fy - ify
                dx = fx - ifx
                c1 = palentry(from_bytes(ifx, ify)).peRed
                c2 = palentry(from_bytes(ifx + 1, ify)).peRed
                c3 = palentry(from_bytes(ifx, ify + 1)).peRed
                c4 = palentry(from_bytes(ifx + 1, ify + 1)).peRed
                ' Interpolate in the Y direction.
                i1 = c1 * (1 - dy) + c3 * dy
                i2 = c2 * (1 - dy) + c4 * dy
                ' Interpolate the results in the X direction.
                clr = i1 * (1 - dx) + i2 * dx
                to_bytes(tx, ty) = NearestNonstaticGray(clr)
            End If
        Next tx
        fact = fact + dfact
    Next ty
    ' Update from_pic.
    status = SetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))
    to_pic.Refresh
End Sub
' ************************************************
' Warp using:
'   x' = r * Cos(theta + r / K - OFFSET)
'   y' = r * Sin(theta + r / K - OFFSET)
' The inverse transformation is:
'   r = Sqr(x' * x' + y' * y')
'   theta = Atn(x' / y')
' All of this with origin at the center of the
' input and output areas.
' ************************************************
Sub TwistPicture( _
    ByVal from_pic As Control, ByVal to_pic As Control, _
    ByVal fx1 As Integer, ByVal fy1 As Integer, _
    ByVal fx2 As Integer, ByVal fy2 As Integer)
Const PI = 3.14159
Const PI_OVER_2 = PI / 2
Const K = 100
Const OFFSET = -PI_OVER_2
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim from_bytes() As Byte
Dim to_bytes() As Byte
Dim from_wid As Long
Dim from_hgt As Long
Dim to_wid As Long
Dim to_hgt As Long
Dim tx1 As Single
Dim tx2 As Single
Dim ty1 As Single
Dim ty2 As Single
Dim fx As Single
Dim fy As Single
Dim tx As Single
Dim ty As Single
Dim fxmid As Single
Dim fymid As Single
Dim txmid As Single
Dim tymid As Single
Dim x As Single
Dim y As Single
Dim ifx As Integer
Dim ify As Integer
Dim dx As Single
Dim dy As Single
Dim r As Single
Dim arctan As Single
Dim theta As Single
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim c4 As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim clr As Integer
    ' Get from_pic's pixels.
    hbm = from_pic.Image
    status = GetObject(hbm, 14, bm)
    from_wid = bm.bmWidthBytes
    from_hgt = bm.bmHeight
    ReDim from_bytes(0 To from_wid - 1, 0 To from_hgt - 1)
    status = GetBitmapBits(hbm, from_wid * from_hgt, from_bytes(0, 0))
    ' Get to_pic's pixels.
    hbm = to_pic.Image
    status = GetObject(hbm, 14, bm)
    to_wid = bm.bmWidthBytes
    to_hgt = bm.bmHeight
    ReDim to_bytes(0 To to_wid - 1, 0 To to_hgt - 1)
    status = GetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))

    ' Set the bounds for to_pic.
    dx = fx2 - fx1
    dy = fy2 - fy1
    r = Sqr(dx * dx + dy * dy)
    tx1 = fx1
    tx2 = fx1 + r
    ty1 = fy1
    ty2 = fy1 + r
    txmid = tx1 + r / 2
    tymid = ty1 + r / 2
    fxmid = (fx1 + fx2) / 2
    fymid = (fy1 + fy2) / 2
    If tx2 >= to_wid Then tx2 = to_wid - 1
    If ty2 >= to_hgt Then ty2 = to_hgt - 1
    ' Perform the transformation.
    For ty = ty1 To ty2
        For tx = tx1 To tx2
            ' See where the point came from.
            dx = tx - txmid
            dy = ty - tymid
            r = Sqr(dx * dx + dy * dy)
            If r = 0 Then
                fx = 0
                fy = 0
            Else
                theta = Arctan2(dx, dy) - r / K - OFFSET
                fx = r * Cos(theta)
                fy = r * Sin(theta)
            End If
            fx = fx + fxmid
            fy = fy + fymid

            ' Skip it if any of the four nearest
            ' source pixels lie outside the allowed
            ' source area.
            ify = Int(fy)
            ifx = Int(fx)
            If ifx >= fx1 And ifx < fx2 And _
               ify >= fy1 And ify < fy2 Then
                ' Interpolate using the four nearest
                ' pixels in from_pic.
                dy = fy - ify
                dx = fx - ifx
                c1 = palentry(from_bytes(ifx, ify)).peRed
                c2 = palentry(from_bytes(ifx + 1, ify)).peRed
                c3 = palentry(from_bytes(ifx, ify + 1)).peRed
                c4 = palentry(from_bytes(ifx + 1, ify + 1)).peRed
                ' Interpolate in the Y direction.
                i1 = c1 * (1 - dy) + c3 * dy
                i2 = c2 * (1 - dy) + c4 * dy
                ' Interpolate the results in the X direction.
                clr = i1 * (1 - dx) + i2 * dx
                to_bytes(tx, ty) = NearestNonstaticGray(clr)
            End If
        Next tx
    Next ty
    ' Update from_pic.
    status = SetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))
    to_pic.Refresh
End Sub
' ************************************************
' Fisheye warping.
' ************************************************
Sub FisheyePicture( _
    ByVal from_pic As Control, ByVal to_pic As Control, _
    ByVal fx1 As Integer, ByVal fy1 As Integer, _
    ByVal fx2 As Integer, ByVal fy2 As Integer)
Const PI = 3.14159
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim from_bytes() As Byte
Dim to_bytes() As Byte
Dim from_wid As Long
Dim from_hgt As Long
Dim to_wid As Long
Dim to_hgt As Long
Dim tx1 As Single
Dim tx2 As Single
Dim ty1 As Single
Dim ty2 As Single
Dim txmid As Single
Dim tymid As Single
Dim fxmid As Single
Dim fymid As Single
Dim fx As Single
Dim fy As Single
Dim tx As Single
Dim ty As Single
Dim x As Single
Dim y As Single
Dim r1 As Single
Dim r2 As Single
Dim ifx As Integer
Dim ify As Integer
Dim dx As Single
Dim dy As Single
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim c4 As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim clr As Integer
Dim Rmax As Single
    ' Get from_pic's pixels.
    hbm = from_pic.Image
    status = GetObject(hbm, 14, bm)
    from_wid = bm.bmWidthBytes
    from_hgt = bm.bmHeight
    ReDim from_bytes(0 To from_wid - 1, 0 To from_hgt - 1)
    status = GetBitmapBits(hbm, from_wid * from_hgt, from_bytes(0, 0))
    ' Get to_pic's pixels.
    hbm = to_pic.Image
    status = GetObject(hbm, 14, bm)
    to_wid = bm.bmWidthBytes
    to_hgt = bm.bmHeight
    ReDim to_bytes(0 To to_wid - 1, 0 To to_hgt - 1)
    status = GetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))

    ' Set the bounds for to_pic.
    tx1 = fx1
    tx2 = fx2 + 2 * Rmax
    ty1 = fy1
    ty2 = fy2 + 2 * Rmax
    If tx2 >= to_wid Then tx2 = to_wid - 1
    If ty2 >= to_hgt Then ty2 = to_hgt - 1
    txmid = (tx1 + tx2) / 2
    tymid = (ty1 + ty2) / 2
    fxmid = (fx1 + fx2) / 2
    fymid = (fy1 + fy2) / 2
    Rmax = to_wid * 0.75
    ' Perform the transformation.
    For ty = ty1 To ty2
        For tx = tx1 To tx2
            ' See where the point came from.
            dx = tx - txmid
            dy = ty - tymid
            r1 = Sqr(dx * dx + dy * dy)
            If r1 = 0 Then
                fx = fxmid
                fy = fymid
            Else
                r2 = Rmax / 2 * (1 / (1 - r1 / Rmax) - 1)
                fx = dx * r2 / r1 + fxmid
                fy = dy * r2 / r1 + fymid
            End If
            ' Skip it if any of the four nearest
            ' source pixels lie outside the allowed
            ' source area.
            ify = Int(fy)
            ifx = Int(fx)
            If ifx >= fx1 And ifx < fx2 And _
               ify >= fy1 And ify < fy2 Then
                ' Interpolate using the four nearest
                ' pixels in from_pic.
                dy = fy - ify
                dx = fx - ifx
                c1 = palentry(from_bytes(ifx, ify)).peRed
                c2 = palentry(from_bytes(ifx + 1, ify)).peRed
                c3 = palentry(from_bytes(ifx, ify + 1)).peRed
                c4 = palentry(from_bytes(ifx + 1, ify + 1)).peRed
                ' Interpolate in the Y direction.
                i1 = c1 * (1 - dy) + c3 * dy
                i2 = c2 * (1 - dy) + c4 * dy
                ' Interpolate the results in the X direction.
                clr = i1 * (1 - dx) + i2 * dx
                to_bytes(tx, ty) = NearestNonstaticGray(clr)
            End If
        Next tx
    Next ty
    ' Update from_pic.
    status = SetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))
    to_pic.Refresh
End Sub
' ************************************************
' Warp using:
'   x' = x
'   y' = y + 20(sin(x/100 * PI) + 1)
' The inverse transformation is:
'   x = x'
'   y = y' - 20(sin(x'/100 * PI) + 1)
' ************************************************
Sub WavePicture( _
    ByVal from_pic As Control, ByVal to_pic As Control, _
    ByVal fx1 As Integer, ByVal fy1 As Integer, _
    ByVal fx2 As Integer, ByVal fy2 As Integer)
Const PI = 3.14159
Dim bm As BITMAP
Dim hbm As Integer
Dim status As Long
Dim from_bytes() As Byte
Dim to_bytes() As Byte
Dim from_wid As Long
Dim from_hgt As Long
Dim to_wid As Long
Dim to_hgt As Long
Dim tx1 As Single
Dim tx2 As Single
Dim ty1 As Single
Dim ty2 As Single
Dim fx As Single
Dim fy As Single
Dim tx As Single
Dim ty As Single
Dim x As Single
Dim y As Single
Dim ifx As Integer
Dim ify As Integer
Dim dx As Single
Dim dy As Single
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim c4 As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim clr As Integer
    ' Get from_pic's pixels.
    hbm = from_pic.Image
    status = GetObject(hbm, 14, bm)
    from_wid = bm.bmWidthBytes
    from_hgt = bm.bmHeight
    ReDim from_bytes(0 To from_wid - 1, 0 To from_hgt - 1)
    status = GetBitmapBits(hbm, from_wid * from_hgt, from_bytes(0, 0))
    ' Get to_pic's pixels.
    hbm = to_pic.Image
    status = GetObject(hbm, 14, bm)
    to_wid = bm.bmWidthBytes
    to_hgt = bm.bmHeight
    ReDim to_bytes(0 To to_wid - 1, 0 To to_hgt - 1)
    status = GetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))

    ' Set the bounds for to_pic.
    tx1 = fx1
    tx2 = fx2
    ty1 = fy1
    ty2 = fy2 + 40
    ' Perform the transformation.
    For ty = ty1 To ty2
        For tx = tx1 To tx2
            ' See where the point came from.
            fx = tx
            fy = ty - 20 * (Sin(tx / 100 * PI) + 1)
            ' Skip it if any of the four nearest
            ' source pixels lie outside the allowed
            ' source area.
            ify = Int(fy)
            ifx = Int(fx)
            If ifx >= fx1 And ifx < fx2 And _
               ify >= fy1 And ify < fy2 Then
                ' Interpolate using the four nearest
                ' pixels in from_pic.
                dy = fy - ify
                dx = fx - ifx
                c1 = palentry(from_bytes(ifx, ify)).peRed
                c2 = palentry(from_bytes(ifx + 1, ify)).peRed
                c3 = palentry(from_bytes(ifx, ify + 1)).peRed
                c4 = palentry(from_bytes(ifx + 1, ify + 1)).peRed
                ' Interpolate in the Y direction.
                i1 = c1 * (1 - dy) + c3 * dy
                i2 = c2 * (1 - dy) + c4 * dy
                ' Interpolate the results in the X direction.
                clr = i1 * (1 - dx) + i2 * dx
                to_bytes(tx, ty) = NearestNonstaticGray(clr)
            End If
        Next tx
    Next ty
    ' Update from_pic.
    status = SetBitmapBits(hbm, to_wid * to_hgt, to_bytes(0, 0))
    to_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, 14, 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
' ************************************************
' Create the warped image.
' ************************************************
Private Sub CmdWarp_Click()
    WaitStart
    DrawImage
    WaitEnd
End Sub
Private Sub Form_Load()
Dim i As Integer
    ' 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
    ' Make a deafult selection.
    WarpCombo.ListIndex = 0
    ' Make the pictures all use gray palettes.
    Me.Show
    DoEvents
    WaitStart
    MatchGrayPalette ToPict
    DoEvents
    ' Let each image repair its palette if needed.
    FromPict.ZOrder
    DoEvents
    ToPict.ZOrder
    DoEvents
    WaitEnd
End Sub
' ***********************************************
' Reset the cursors for the form and all the
' picture boxes.
' ***********************************************
Sub WaitEnd()
    MousePointer = vbDefault
    FromPict.MousePointer = vbDefault
    ToPict.MousePointer = vbDefault
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
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
' ***********************************************
' Load a new image file.
' ***********************************************
Private Sub mnuFileLoad_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 = 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
' ***********************************************
' Load the indicated file and prepare to work
' with its palette.
' ***********************************************
Sub LoadFromPict(fname As String)
Dim status As Long
    On Error GoTo LoadFileError
    FromPict.Picture = LoadPicture(fname)
    On Error GoTo 0

    MatchGrayPalette FromPict
    ToPict.Cls
    Caption = "Warp [" & fname & "]"
    CmdWarp.Enabled = True
    Exit Sub
LoadFileError:
    Beep
    MsgBox "Error loading file " & fname & "." & _
        vbCrLf & Error$
    Exit Sub
End Sub