home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch9 / Dissolve.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-05-31  |  7.2 KB  |  219 lines

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmDissolve 
  4.    Caption         =   "Dissolve"
  5.    ClientHeight    =   3885
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   5940
  9.    LinkTopic       =   "Form2"
  10.    ScaleHeight     =   3885
  11.    ScaleWidth      =   5940
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.PictureBox picCanvas 
  14.       AutoSize        =   -1  'True
  15.       Height          =   2295
  16.       Index           =   1
  17.       Left            =   2640
  18.       ScaleHeight     =   149
  19.       ScaleMode       =   3  'Pixel
  20.       ScaleWidth      =   157
  21.       TabIndex        =   7
  22.       Top             =   720
  23.       Width           =   2415
  24.    End
  25.    Begin VB.TextBox txtNumFrames 
  26.       Height          =   285
  27.       Left            =   1080
  28.       TabIndex        =   5
  29.       Text            =   "10"
  30.       Top             =   360
  31.       Width           =   495
  32.    End
  33.    Begin VB.CommandButton cmdDissolve 
  34.       Caption         =   "Dissolve"
  35.       Height          =   375
  36.       Left            =   5040
  37.       TabIndex        =   3
  38.       Top             =   0
  39.       Width           =   855
  40.    End
  41.    Begin VB.TextBox txtBaseName 
  42.       Height          =   285
  43.       Left            =   1080
  44.       TabIndex        =   2
  45.       Top             =   0
  46.       Width           =   3855
  47.    End
  48.    Begin MSComDlg.CommonDialog dlgOpenFile 
  49.       Left            =   0
  50.       Top             =   720
  51.       _ExtentX        =   847
  52.       _ExtentY        =   847
  53.       _Version        =   393216
  54.    End
  55.    Begin VB.PictureBox picCanvas 
  56.       AutoSize        =   -1  'True
  57.       Height          =   2295
  58.       Index           =   0
  59.       Left            =   120
  60.       ScaleHeight     =   149
  61.       ScaleMode       =   3  'Pixel
  62.       ScaleWidth      =   157
  63.       TabIndex        =   0
  64.       Top             =   720
  65.       Width           =   2415
  66.    End
  67.    Begin VB.Label lblFrameNumber 
  68.       Height          =   255
  69.       Left            =   1680
  70.       TabIndex        =   6
  71.       Top             =   360
  72.       Width           =   495
  73.    End
  74.    Begin VB.Label Label1 
  75.       Caption         =   "Num Frames"
  76.       Height          =   255
  77.       Index           =   1
  78.       Left            =   120
  79.       TabIndex        =   4
  80.       Top             =   360
  81.       Width           =   975
  82.    End
  83.    Begin VB.Label Label1 
  84.       Caption         =   "Base Name"
  85.       Height          =   255
  86.       Index           =   0
  87.       Left            =   120
  88.       TabIndex        =   1
  89.       Top             =   0
  90.       Width           =   855
  91.    End
  92.    Begin VB.Menu mnuFile 
  93.       Caption         =   "&File"
  94.       Begin VB.Menu mnuFileOpen 
  95.          Caption         =   "Open &From Image..."
  96.          Index           =   0
  97.          Shortcut        =   {F5}
  98.       End
  99.       Begin VB.Menu mnuFileOpen 
  100.          Caption         =   "Open &To Image..."
  101.          Index           =   1
  102.          Shortcut        =   {F6}
  103.       End
  104.    End
  105. Attribute VB_Name = "frmDissolve"
  106. Attribute VB_GlobalNameSpace = False
  107. Attribute VB_Creatable = False
  108. Attribute VB_PredeclaredId = True
  109. Attribute VB_Exposed = False
  110. Option Explicit
  111. ' Make the fade frames.
  112. Private Sub cmdDissolve_Click()
  113. Dim num_frames As Integer
  114. Dim base_name As String
  115. Dim pic0_pixels() As RGBTriplet
  116. Dim pic1_pixels() As RGBTriplet
  117. Dim new_pixels() As RGBTriplet
  118. Dim bits_per_pixel As Integer
  119. Dim X As Integer
  120. Dim Y As Integer
  121. Dim i As Integer
  122. Dim f0 As Single
  123. Dim f1 As Single
  124.     If Not IsNumeric(txtNumFrames.Text) Then txtNumFrames.Text = "10"
  125.     num_frames = CInt(txtNumFrames.Text)
  126.     base_name = txtBaseName.Text
  127.     ' Get the input pixels.
  128.     GetBitmapPixels picCanvas(0), pic0_pixels, bits_per_pixel
  129.     GetBitmapPixels picCanvas(1), pic1_pixels, bits_per_pixel
  130.     ' Make room for the output pixels.
  131.     ReDim new_pixels(0 To UBound(pic0_pixels, 1), 0 To UBound(pic0_pixels, 2))
  132.     ' Build the frames.
  133.     For i = 1 To num_frames
  134.         lblFrameNumber.Caption = Format$(i)
  135.         DoEvents
  136.         f1 = i / num_frames
  137.         f0 = 1 - f1
  138.         For X = 0 To picCanvas(0).ScaleWidth - 1
  139.             For Y = 0 To picCanvas(0).ScaleHeight - 1
  140.                 With new_pixels(X, Y)
  141.                     .rgbRed = f0 * pic0_pixels(X, Y).rgbRed + f1 * pic1_pixels(X, Y).rgbRed
  142.                     .rgbGreen = f0 * pic0_pixels(X, Y).rgbGreen + f1 * pic1_pixels(X, Y).rgbGreen
  143.                     .rgbBlue = f0 * pic0_pixels(X, Y).rgbBlue + f1 * pic1_pixels(X, Y).rgbBlue
  144.                 End With
  145.             Next Y
  146.         Next X
  147.         ' Update the image.
  148.         SetBitmapPixels picCanvas(0), bits_per_pixel, new_pixels
  149.         picCanvas(0).Picture = picCanvas(0).Image
  150.         ' Save the results.
  151.         SavePicture picCanvas(0).Picture, base_name & Format$(i) & ".bmp"
  152.     Next i
  153.     ' Restore the original image.
  154.     SetBitmapPixels picCanvas(0), bits_per_pixel, pic0_pixels
  155.     picCanvas(0).Picture = picCanvas(0).Image
  156.     lblFrameNumber.Caption = ""
  157. End Sub
  158. ' Start in the current directory.
  159. Private Sub Form_Load()
  160. Dim base_name As String
  161. Dim i As Integer
  162.     base_name = App.Path
  163.     If Right$(base_name, 1) <> "\" Then base_name = base_name & "\"
  164.     txtBaseName = base_name & "Diss_"
  165.     For i = 0 To 1
  166.         picCanvas(i).AutoSize = True
  167.         picCanvas(i).ScaleMode = vbPixels
  168.         picCanvas(i).AutoRedraw = True
  169.     Next i
  170.     dlgOpenFile.CancelError = True
  171.     dlgOpenFile.InitDir = App.Path
  172.     dlgOpenFile.Filter = _
  173.         "Bitmaps (*.bmp)|*.bmp|" & _
  174.         "GIFs (*.gif)|*.gif|" & _
  175.         "JPEGs (*.jpg)|*.jpg;*.jpeg|" & _
  176.         "Icons (*.ico)|*.ico|" & _
  177.         "Cursors (*.cur)|*.cur|" & _
  178.         "Run-Length Encoded (*.rle)|*.rle|" & _
  179.         "Metafiles (*.wmf)|*.wmf|" & _
  180.         "Enhanced Metafiles (*.emf)|*.emf|" & _
  181.         "Graphic Files|*.bmp;*.gif;*.jpg;*.jpeg;*.ico;*.cur;*.rle;*.wmf;*.emf|" & _
  182.         "All Files (*.*)|*.*"
  183. End Sub
  184. ' Load the indicated file.
  185. Private Sub mnuFileOpen_Click(Index As Integer)
  186. Dim file_name As String
  187.     ' Let the user select a file.
  188.     On Error Resume Next
  189.     dlgOpenFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  190.     dlgOpenFile.ShowOpen
  191.     If Err.Number = cdlCancel Then
  192.         Exit Sub
  193.     ElseIf Err.Number <> 0 Then
  194.         Beep
  195.         MsgBox "Error selecting file.", , vbExclamation
  196.         Exit Sub
  197.     End If
  198.     On Error GoTo 0
  199.     Screen.MousePointer = vbHourglass
  200.     DoEvents
  201.     file_name = Trim$(dlgOpenFile.FileName)
  202.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  203.         - Len(dlgOpenFile.FileTitle) - 1)
  204.     ' Open the file.
  205.     On Error GoTo LoadError
  206.     picCanvas(Index).Picture = LoadPicture(file_name)
  207.     On Error GoTo 0
  208.     picCanvas(Index).Picture = picCanvas(Index).Image
  209.     ' Arrange the controls.
  210.     picCanvas(1).Left = picCanvas(0).Left + picCanvas(0).Width + 120
  211.     Screen.MousePointer = vbDefault
  212.     Exit Sub
  213. LoadError:
  214.     Screen.MousePointer = vbDefault
  215.     MsgBox "Error " & Format$(Err.Number) & _
  216.         " opening file '" & file_name & "'" & vbCrLf & _
  217.         Err.Description
  218. End Sub
  219.