Blend: Visual Basic Version

'*****************************************************************************
'                                                                            *
'  Blend.frm                                                                 *
'                                                                            *
'  This program illustrates some of the Fastgraph for Windows alpha blending *
'  functions.                                                                *
'                                                                            *
'  Press F1 to view the foreground image.                                    *
'  Press F2 to view the background image.                                    *
'  Press F3 to create and view a 50% blended image.                          *
'  Press F4 to create and view a variable blended image.                     *
'                                                                            *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Const vbDepth = 16
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Option Base 0
' direct color bitmap containing the foreground image
Dim Foreground(CLng(vbWidth) * CLng(vbHeight) * (vbDepth / 8)) As Byte
' direct color bitmap containing the background image
Dim Background(CLng(vbWidth) * CLng(vbHeight) * (vbDepth / 8)) As Byte
' direct color bitmap containing the resulting blended image
Dim Blended(CLng(vbWidth) * CLng(vbHeight) * (vbDepth / 8)) As Byte
' 256-color bitmap containing variable opacity values
Dim Opacity(CLng(vbWidth) * CLng(vbHeight)) As Byte
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   If Shift > 0 Then Exit Sub
   Select Case KeyCode
      ' display foreground image
      Case vbKeyF1
         Call fg_move(0, vbHeight - 1)
         Call fg_putdcb(Foreground(0), vbWidth, vbHeight)
         Call fg_vbscale(0, vbWidth-1, 0, vbHeight-1, 0, cxClient-1, 0, cyClient-1)
         Caption = "Alpha Blending: Foreground Image"
      ' display background image
      Case vbKeyF2
         Call fg_move(0, vbHeight - 1)
         Call fg_putdcb(Background(0), vbWidth, vbHeight)
         Call fg_vbscale(0, vbWidth-1, 0, vbHeight-1, 0, cxClient-1, 0, cyClient-1)
         Caption = "Alpha Blending: Background Image"
      ' display blended image with constant 50% foreground opacity
      Case vbKeyF3
         Screen.MousePointer = 11
         Call fg_opacity(128)
         Call fg_blenddcb(Foreground(0), Background(0), Blended(0),
            CLng(vbWidth) * CLng(vbHeight))
         Call fg_move(0, vbHeight - 1)
         Call fg_putdcb(Blended(0), vbWidth, vbHeight)
         Call fg_vbscale(0, vbWidth-1, 0, vbHeight-1, 0, cxClient-1, 0, cyClient-1)
         Caption = "Alpha Blending: 50% Blended Image"
         Screen.MousePointer = 0
      ' display blended image with variable foreground opacity
      Case vbKeyF4
         Screen.MousePointer = 11
         Call fg_blendvar(Foreground(0), Background(0), Opacity(0), Blended(0),
            CLng(vbWidth) * CLng(vbHeight))
         Call fg_move(0, vbHeight - 1)
         Call fg_putdcb(Blended(0), vbWidth, vbHeight)
         Call fg_vbscale(0, vbWidth-1, 0, vbHeight-1, 0, cxClient-1, 0, cyClient-1)
         Caption = "Alpha Blending: Variable Blended Image"
         Screen.MousePointer = 0
   End Select
End Sub
Private Sub Form_Load()
   ScaleMode = 3
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   Call fg_vbdepth(vbDepth)
   hVB = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   ' get background image from the CAT.BMP file
   Call fg_showbmp(App.Path & "\CAT.BMP", 0)
   Call fg_move(0, vbHeight - 1)
   Call fg_getdcb(Background(0), vbWidth, vbHeight)
   ' get foreground image from the PORCH.BMP file
   Call fg_showbmp(App.Path & "\PORCH.BMP", 0)
   Call fg_move(0, vbHeight - 1)
   Call fg_getdcb(Foreground(0), vbWidth, vbHeight)
   ' calcluate variable opacity bitmap
   Call MakeOpacityBitmap
End Sub
Private Sub Form_Paint()
   Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
   cxClient = ScaleWidth
   cyClient = ScaleHeight
   Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
'*****************************************************************************
'                                                                            *
'  MakeOpacityBitmap()                                                       *
'                                                                            *
'  Define a 256-color bitmap with varying opacity values. The foregound      *
'  opacities will be zero at the image center and will gradually increase    *
'  as we move farther from the center.                                       *
'                                                                            *
'*****************************************************************************
Private Sub MakeOpacityBitmap()
   Dim I As Long, X As Long, Y As Long
   Dim OpacityValue As Long
   Dim yTerm As Long
   I = 0
   For Y = 0 To vbHeight - 1
      yTerm = Abs(Y - vbHeight / 2)
      For X = 0 To vbWidth - 1
         OpacityValue = Abs(X - vbWidth / 2) + yTerm
         If (OpacityValue > 255) Then
            Opacity(I) = 255
         Else
            Opacity(I) = OpacityValue
         End If
         I = I + 1
      Next X
   Next Y
End Sub