vbAccelerator - Contents of code file: Form1.frm

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Alpha Is Simple?"
   ClientHeight    =   6495
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10410
   LinkTopic       =   "Form1"
   ScaleHeight     =   6495
   ScaleWidth      =   10410
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox chkUseSystem 
      Caption         =   "&Use System AlphaBlend"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   3420
      Value           =   1  'Checked
      Width           =   4515
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      LargeChange     =   25
      Left            =   120
      Max             =   255
      TabIndex        =   2
      Top             =   3120
      Value           =   128
      Width           =   4515
   End
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   3105
      Left            =   5400
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   3045
      ScaleWidth      =   4500
      TabIndex        =   1
      Top             =   3240
      Width           =   4560
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   3105
      Left            =   5400
      Picture         =   "Form1.frx":2102
      ScaleHeight     =   3045
      ScaleWidth      =   4500
      TabIndex        =   0
      Top             =   120
      Width           =   4560
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' System functions:
Private Type BLENDFUNCTION
  BlendOp As Byte
  BlendFlags As Byte
  sourceConstantAlpha As Byte
  AlphaFormat As Byte
End Type
' BlendOp:
Private Const AC_SRC_OVER = &H0
' AlphaFormat:
Private Const AC_SRC_ALPHA = &H1

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Declare Function AlphaBlend Lib "MSIMG32.dll" ( _
  ByVal hdcDest As Long, _
  ByVal nXOriginDest As Long, _
  ByVal nYOriginDest As Long, _
  ByVal nWidthDest As Long, _
  ByVal nHeightDest As Long, _
  ByVal hdcSrc As Long, _
  ByVal nXOriginSrc As Long, _
  ByVal nYOriginSrc As Long, _
  ByVal nWidthSrc As Long, _
  ByVal nHeightSrc As Long, _
  ByVal lBlendFunction As Long _
) As Long

' cAlphaDibSection functions:
Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr()
 As Any) As Long

Private m_cBack As cAlphaDibSection
Private m_cImage As cAlphaDibSection
Private m_cDraw As cAlphaDibSection

Private m_bUseSystem As Boolean

Private Sub Draw()
   If (m_bUseSystem) Then
      Dim lBlend As Long
      Dim bf As BLENDFUNCTION
   
      ' Draw the first picture:
      bf.BlendOp = AC_SRC_OVER
      bf.BlendFlags = 0
      bf.sourceConstantAlpha = 255
      bf.AlphaFormat = 0
      CopyMemory lBlend, bf, 4
      AlphaBlend Me.hdc, HScroll1.Left \ Screen.TwipsPerPixelX, 8, _
         Picture1.ScaleWidth \ Screen.TwipsPerPixelX, _
         Picture1.ScaleHeight \ Screen.TwipsPerPixelY, _
         Picture1.hdc, 0, 0, _
         Picture1.ScaleWidth \ Screen.TwipsPerPixelX, _
         Picture1.ScaleHeight \ Screen.TwipsPerPixelY, _
         lBlend
   
      ' Now draw the second picture with HScroll transparency over the top:
      bf.sourceConstantAlpha = HScroll1.Value
      CopyMemory lBlend, bf, 4
      AlphaBlend Me.hdc, HScroll1.Left \ Screen.TwipsPerPixelX, 8, _
         Picture2.ScaleWidth \ Screen.TwipsPerPixelX, _
         Picture2.ScaleHeight \ Screen.TwipsPerPixelY, _
         Picture2.hdc, 0, 0, _
         Picture2.ScaleWidth \ Screen.TwipsPerPixelX, _
         Picture2.ScaleHeight \ Screen.TwipsPerPixelY, _
         lBlend
      Me.Refresh
   Else
      m_cBack.PaintPicture m_cDraw.hdc
      CodeAlphaBlend m_cDraw, m_cImage, HScroll1.Value
      m_cDraw.PaintPicture Me.hdc, HScroll1.Left \ Screen.TwipsPerPixelX, 8, _
         m_cDraw.Width, _
         m_cDraw.Height
      Me.Refresh
   End If
End Sub

Private Sub CodeAlphaBlend( _
      cDst As cAlphaDibSection, _
      cSrc As cAlphaDibSection, _
      Optional ByVal sourceConstantAlpha As Long _
   )
   Dim tSASrc As SAFEARRAY2D
   Dim bDibSrc() As Byte
    ' Get the bits in the from DIB section:
    With tSASrc
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cSrc.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cSrc.BytesPerScanLine()
        .pvData = cSrc.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDibSrc()), VarPtr(tSASrc), 4
      
   Dim tSADst As SAFEARRAY2D
   Dim bDibDst() As Byte
    ' Get the bits in the from DIB section:
    With tSADst
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cDst.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cDst.BytesPerScanLine()
        .pvData = cDst.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDibDst()), VarPtr(tSADst), 4
      
   Dim x As Long, y As Long
   For x = 0 To cDst.BytesPerScanLine - 4 Step 4
      For y = 0 To cDst.Height - 1
         bDibDst(x, y) = bDibSrc(x, y) * sourceConstantAlpha / 255 + bDibDst(x,
          y) * (1 - sourceConstantAlpha / 255)
         bDibDst(x + 1, y) = bDibSrc(x + 1, y) * sourceConstantAlpha / 255 +
          bDibDst(x + 1, y) * (1 - sourceConstantAlpha / 255)
         bDibDst(x + 2, y) = bDibSrc(x + 2, y) * sourceConstantAlpha / 255 +
          bDibDst(x + 2, y) * (1 - sourceConstantAlpha / 255)
      Next y
   Next x
      
         
    CopyMemory ByVal VarPtrArray(bDibDst), 0&, 4
    CopyMemory ByVal VarPtrArray(bDibSrc), 0&, 4
      
End Sub

Private Sub chkUseSystem_Click()
   m_bUseSystem = (chkUseSystem.Value = vbChecked)
   Draw
End Sub

Private Sub Form_Load()
   m_bUseSystem = True
   Set m_cBack = New cAlphaDibSection
   Set m_cImage = New cAlphaDibSection
   m_cBack.Create Picture1.ScaleWidth \ Screen.TwipsPerPixelX,
    Picture1.ScaleHeight \ Screen.TwipsPerPixelY
   m_cBack.LoadPictureBlt Picture1.hdc
   m_cImage.Create Picture2.ScaleWidth \ Screen.TwipsPerPixelX,
    Picture2.ScaleHeight \ Screen.TwipsPerPixelY
   m_cImage.LoadPictureBlt Picture2.hdc
   Set m_cDraw = New cAlphaDibSection
   m_cDraw.Create m_cBack.Width, m_cBack.Height
End Sub

Private Sub Form_Resize()
   Draw
End Sub

Private Sub HScroll1_Change()
   Draw
End Sub

Private Sub HScroll1_Scroll()
   Draw
End Sub