vbAccelerator - Contents of code file: frmAlphaCreator.frm

VERSION 5.00
Begin VB.Form frmAlphaCreator 
   Caption         =   "Alpha Image Creator"
   ClientHeight    =   8790
   ClientLeft      =   2835
   ClientTop       =   2235
   ClientWidth     =   7755
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmAlphaCreator.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8790
   ScaleWidth      =   7755
   Begin VB.CommandButton cmdSaveResult 
      Caption         =   "&Save Result..."
      Enabled         =   0   'False
      Height          =   435
      Left            =   180
      TabIndex        =   8
      Top             =   8040
      Width           =   1455
   End
   Begin VB.CommandButton cmdAlpha 
      Caption         =   "Load Al&pha..."
      Height          =   435
      Left            =   3900
      TabIndex        =   7
      Top             =   3300
      Width           =   1455
   End
   Begin VB.CommandButton cmdSource 
      Caption         =   "Load I&mage..."
      Height          =   435
      Left            =   120
      TabIndex        =   6
      Top             =   3300
      Width           =   1455
   End
   Begin VB.PictureBox picResult 
      Height          =   3735
      Left            =   180
      ScaleHeight     =   245
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   493
      TabIndex        =   5
      Top             =   4260
      Width           =   7455
   End
   Begin VB.PictureBox picAlpha 
      Height          =   2775
      Left            =   3900
      ScaleHeight     =   181
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   241
      TabIndex        =   3
      Top             =   480
      Width           =   3675
   End
   Begin VB.PictureBox picSource 
      Height          =   2775
      Left            =   120
      ScaleHeight     =   181
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   241
      TabIndex        =   2
      Top             =   480
      Width           =   3675
   End
   Begin VB.Label lblResult 
      BackColor       =   &H80000010&
      Caption         =   " Result"
      ForeColor       =   &H80000014&
      Height          =   255
      Left            =   180
      TabIndex        =   4
      Top             =   3900
      Width           =   7455
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000010&
      Caption         =   " Alpha Channel"
      ForeColor       =   &H80000014&
      Height          =   255
      Left            =   3900
      TabIndex        =   1
      Top             =   120
      Width           =   3675
   End
   Begin VB.Label lblSource 
      BackColor       =   &H80000010&
      Caption         =   " Source Image"
      ForeColor       =   &H80000014&
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3675
   End
End
Attribute VB_Name = "frmAlphaCreator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cAlphaCreator As New cAlphaImageCreator

Private WithEvents m_scrSource As cScrollBars
Attribute m_scrSource.VB_VarHelpID = -1
Private WithEvents m_scrAlpha As cScrollBars
Attribute m_scrAlpha.VB_VarHelpID = -1
Private WithEvents m_scrResult As cScrollBars
Attribute m_scrResult.VB_VarHelpID = -1

Private Sub createResult()
   m_cAlphaCreator.createAlphaImage
   setScrollBars m_scrResult, m_cAlphaCreator.AlphaImage, picResult
   picResult.Refresh
   cmdSaveResult.Enabled = (m_cAlphaCreator.AlphaChannel.Width > 0)
End Sub

Private Sub setScrollBars( _
      scr As cScrollBars, _
      dib As cAlphaDibSection, _
      pic As PictureBox _
   )
Dim xDiff As Long
Dim yDiff As Long
   xDiff = dib.Width - pic.ScaleWidth
   yDiff = dib.Height - pic.ScaleHeight
   If (xDiff > 0) Then
      scr.SmallChange(efsHorizontal) = 8
      scr.LargeChange(efsHorizontal) = pic.ScaleHeight \ 2
      scr.Max(efsHorizontal) = xDiff
      scr.Visible(efsHorizontal) = True
   Else
      scr.Value(efsHorizontal) = 0
      scr.Visible(efsHorizontal) = False
   End If
   If (yDiff > 0) Then
      scr.SmallChange(efsVertical) = 8
      scr.LargeChange(efsVertical) = pic.ScaleHeight \ 2
      scr.Max(efsVertical) = yDiff
      scr.Visible(efsVertical) = True
   Else
      scr.Value(efsVertical) = 0
      scr.Visible(efsVertical) = False
   End If
End Sub

Private Sub ShowPic( _
      dib As cAlphaDibSection, _
      scr As cScrollBars, _
      pic As PictureBox, _
      ByVal bUseAlphaChannel As Boolean _
   )
Dim left As Long
Dim top As Long
   If (dib.Width > 0) Then
      If (scr.Visible(efsHorizontal)) Then
         left = scr.Value(efsHorizontal)
      End If
      If (scr.Visible(efsVertical)) Then
         top = scr.Value(efsVertical)
      End If
      If (bUseAlphaChannel) Then
         dib.AlphaPaintPicture pic.hdc, 0, 0, pic.ScaleWidth, pic.ScaleHeight,
          left, top
      Else
         dib.PaintPicture pic.hdc, 0, 0, pic.ScaleWidth, pic.ScaleHeight, left,
          top
      End If
   End If
End Sub

Private Sub cmdAlpha_Click()
On Error GoTo ErrorHandler
   Dim c As New cCommonDialog
   Dim sFile As String
   If c.VBGetOpenFileName(sFile, Filter:="Picture Files
    (*.GIF;*.JPG;*.BMP)|*.GIF;*.JPG;*.BMP|All Files (*.*)|*.*",
    DefaultExt:="BMP", Owner:=Me.hwnd) Then
      Dim sPic As StdPicture
      Set sPic = LoadPicture(sFile)
      m_cAlphaCreator.AlphaChannel.CreateFromPicture sPic
      createResult
      setScrollBars m_scrAlpha, m_cAlphaCreator.AlphaChannel, picAlpha
      picAlpha.Refresh
   End If
   Exit Sub
ErrorHandler:
   MsgBox "Problem getting source image: [" & Err.Description & "]",
    vbExclamation
   Exit Sub
End Sub

Private Sub cmdSaveResult_Click()
On Error GoTo ErrorHandler
   Dim c As New cCommonDialog
   Dim sFile As String
   If c.VBGetSaveFileName(sFile, Filter:="Bitmaps (*.BMP)|*.BMP|All Files
    (*.*)|*.*", DefaultExt:="BMP", Owner:=Me.hwnd) Then
      If Not (m_cAlphaCreator.AlphaImage.SavePicture(sFile)) Then
         MsgBox "Failed to save the picture.", vbExclamation
      End If
   End If
   Exit Sub
ErrorHandler:
   MsgBox "Problem saving result image: [" & Err.Description & "]",
    vbExclamation
   Exit Sub
End Sub

Private Sub cmdSource_Click()
On Error GoTo ErrorHandler
   Dim c As New cCommonDialog
   Dim sFile As String
   If c.VBGetOpenFileName(sFile, Filter:="Picture Files
    (*.GIF;*.JPG;*.BMP)|*.GIF;*.JPG;*.BMP|All Files (*.*)|*.*",
    DefaultExt:="BMP", Owner:=Me.hwnd) Then
      Dim sPic As StdPicture
      Set sPic = LoadPicture(sFile)
      m_cAlphaCreator.Image.CreateFromPicture sPic
      createResult
      setScrollBars m_scrSource, m_cAlphaCreator.Image, picSource
      picSource.Refresh
   End If
   Exit Sub
ErrorHandler:
   MsgBox "Problem getting source image: [" & Err.Description & "]",
    vbExclamation
   Exit Sub
End Sub

Private Sub Form_Load()
   Set m_scrSource = New cScrollBars
   m_scrSource.Create picSource.hwnd
   Set m_scrAlpha = New cScrollBars
   m_scrAlpha.Create picAlpha.hwnd
   Set m_scrResult = New cScrollBars
   m_scrResult.Create picResult.hwnd
End Sub

Private Sub m_scrAlpha_Change(eBar As EFSScrollBarConstants)
   picAlpha.Refresh
End Sub

Private Sub m_scrAlpha_Scroll(eBar As EFSScrollBarConstants)
   picAlpha.Refresh
End Sub

Private Sub m_scrResult_Change(eBar As EFSScrollBarConstants)
   picResult.Refresh
End Sub

Private Sub m_scrResult_Scroll(eBar As EFSScrollBarConstants)
   picResult.Refresh
End Sub

Private Sub m_scrSource_Change(eBar As EFSScrollBarConstants)
   picSource.Refresh
End Sub

Private Sub m_scrSource_Scroll(eBar As EFSScrollBarConstants)
   picSource.Refresh
End Sub

Private Sub picAlpha_Paint()
   '
   ShowPic m_cAlphaCreator.AlphaChannel, m_scrAlpha, picAlpha, False
   '
End Sub

Private Sub picResult_Paint()
   '
   ShowPic m_cAlphaCreator.AlphaImage, m_scrResult, picResult, True
   '
End Sub

Private Sub picSource_Paint()
   '
   ShowPic m_cAlphaCreator.Image, m_scrSource, picSource, False
   '
End Sub