VBdemo: Visual Basic Version

'*****************************************************************************
' *
' VBdemo.frm *
' *
' This program demonstrates how to copy the contents of one virtual buffer *
' to another, with and without transparent colors. *
' *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Dim hPal As Long
Dim hVB1 As Long, hVB2 As Long
Dim cxClient As Long, cyClient As Long
Private Sub Form_Activate()
 Call fg_realize(hPal)
 Refresh
End Sub
Private Sub Form_Load()
 ScaleMode = 3
 Call fg_setdc(hDC)
 hPal = fg_defpal()
 Call fg_realize(hPal)
 Call fg_vbinit
 hVB2 = fg_vballoc(vbWidth, vbHeight)
 Call fg_vbopen(hVB2)
 Call fg_vbcolors
 hVB1 = fg_vballoc(vbWidth, vbHeight)
 Call fg_vbopen(hVB1)
 Call fg_vbcolors
 Call fg_setcolor(25)
 Call fg_fillpage
 Call fg_setcolor(20)
 Call fg_rect(vbWidth / 4, vbWidth * 3 / 4, vbHeight / 4, vbHeight * 3 / 4)
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(hVB1)
 Call fg_vbfree(hVB2)
 Call fg_vbfin
End Sub
Private Sub mnuCut_Click()
 Call fg_vbcopy(0, vbWidth - 1, 0, vbHeight - 1, 0, vbHeight - 1, hVB1, hVB2)
 Call fg_erase
 Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
 mnuPaste.Enabled = True
End Sub
Private Sub mnuPaste_Click()
 Call fg_tcdefine(25, 1)
 Call fg_vbtccopy(0, vbWidth - 1, 0, vbHeight - 1, 0, vbHeight - 1, hVB2, hVB1)
 Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub mnuExit_Click()
 Unload Me
End Sub