Graphics: Visual Basic Version
'*****************************************************************************
' *
' Graphics.frm *
' *
' This program demonstrates some of the Fastgraph for Windows graphics *
' primitive functions. *
' *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Dim hPal As Long
Dim hVB 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
hVB = fg_vballoc(vbWidth, vbHeight)
Call fg_vbopen(hVB)
Call fg_vbcolors
Call fg_setcolor(25)
Call fg_fillpage
End Sub
Private Sub Form_Paint()
Call Blit
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
'*****************************************************************************
' *
' Circles_Click() *
' *
' Draw a series of concentric circles. *
' *
'*****************************************************************************
Private Sub mnuCircles_Click()
Dim I As Long, Radius As Long
Call fg_setcolor(11)
Call fg_fillpage
' draw 25 concentric circles at the center of the virtual buffer
Call fg_move(vbWidth / 2, vbHeight / 2)
Radius = 4
Call fg_setcolor(25)
For I = 1 To 25
Call fg_circle(Radius)
Radius = Radius + 8
Next I
Call Blit
End Sub
'*****************************************************************************
' *
' Ellipses_Click() *
' *
' Draw a series of concentric ellipses. *
' *
'*****************************************************************************
Private Sub mnuEllipses_Click()
Dim I As Long
Dim Horiz As Long, Vert As Long
Call fg_setcolor(11)
Call fg_fillpage
' draw 80 concentric ellipses at the center of the virtual buffer
Call fg_move(vbWidth / 2, vbHeight / 2)
Horiz = 4
Vert = 1
Call fg_setcolor(25)
For I = 1 To 80
Call fg_ellipse(Horiz, Vert)
Horiz = Horiz + 3
Vert = Vert + 1
Next I
Call Blit
End Sub
'*****************************************************************************
' *
' Lines_Click() *
' *
' Draw a pattern of solid lines. *
' *
'*****************************************************************************
Private Sub mnuLines_Click()
Dim X As Long, Y As Long
Dim I As Long, X1 As Long, X2 As Long, Y1 As Long
Dim LineColor(7) As Long
LineColor(0) = 12: LineColor(1) = 11: LineColor(2) = 19: LineColor(3) = 21
LineColor(4) = 21: LineColor(5) = 19: LineColor(6) = 11: LineColor(7) = 12
Call fg_setcolor(25)
Call fg_fillpage
' draw horizontal lines
For Y = 0 To vbHeight - 40 Step 40
For I = 0 To 7
Call fg_setcolor(LineColor(I))
Y1 = Y + 3 * I
Call fg_move(0, Y1)
Call fg_draw(vbWidth - 1, Y1)
Next I
Next Y
' draw vertical lines
For X = 0 To vbWidth - 60 Step 60
For I = 0 To 7
Call fg_setcolor(LineColor(I))
X1 = X + 3 * I
Call fg_move(X1, 0)
Call fg_draw(X1, vbHeight - 1)
Next I
Next X
' draw red diagonal lines
Call fg_setcolor(22)
For X1 = -640 To 640 - 60 Step 60
X2 = X1 + vbHeight
Call fg_move(X1, 0)
Call fg_draw(X2, vbHeight)
Next X1
For X1 = 0 To 1280 - 60 Step 60
X2 = X1 - vbHeight
Call fg_move(X1, 0)
Call fg_draw(X2, vbHeight)
Next X1
Call Blit
End Sub
'*****************************************************************************
' *
' Paint_Click() *
' *
' Demonstrate region fill. *
' *
'*****************************************************************************
Private Sub mnuPaint_Click()
Dim X1 As Long, X2 As Long, Y1 As Long, Y2 As Long
Call fg_setcolor(25)
Call fg_fillpage
' draw a rectangle
X1 = 40
X2 = vbWidth - 40
Y1 = 20
Y2 = vbHeight - 20
Call fg_setcolor(21)
Call fg_rect(X1, X2, Y1, Y2)
' outline the rectangle
Call fg_setcolor(10)
Call fg_box(X1, X2, Y1, Y2)
' draw the circle
X1 = vbWidth / 2
Y1 = vbHeight / 2
Call fg_move(X1, Y1)
Call fg_circle(80)
' draw cross bars in the circle
Call fg_move(X1, Y1 - 80)
Call fg_draw(X1, Y1 + 80)
Call fg_move(X1 - 80, Y1)
Call fg_draw(X1 + 80, Y1)
' paint each quarter of the circle
Call fg_setcolor(11)
Call fg_paint(X1 - 6, Y1 - 6)
Call fg_setcolor(12)
Call fg_paint(X1 + 6, Y1 + 6)
Call fg_setcolor(13)
Call fg_paint(X1 + 6, Y1 - 6)
Call fg_setcolor(14)
Call fg_paint(X1 - 6, Y1 + 6)
' paint the area outside the box
Call fg_setcolor(24)
Call fg_paint(41, 21)
Call Blit
End Sub
'*****************************************************************************
' *
' Points_Click() *
' *
' Draw a pattern of points. *
' *
'*****************************************************************************
Private Sub mnuPoints_Click()
Dim X As Long, Y As Long
' fill the virtual buffer with yellow pixels
Call fg_setcolor(24)
Call fg_fillpage
' draw the patterns of points
Call fg_setcolor(19)
For X = 7 To vbWidth - 20 Step 20
For Y = 0 To vbHeight - 8 Step 8
Call fg_point(X, Y)
Next Y
Next X
Call fg_setcolor(22)
For X = 17 To vbWidth - 20 Step 20
For Y = 4 To vbHeight - 8 Step 8
Call fg_point(X, Y)
Next Y
Next X
Call Blit
End Sub
'*****************************************************************************
' *
' Polygons_Click() *
' *
' Draw a grid of filled polygons. *
' *
'*****************************************************************************
Private Sub mnuPolygons_Click()
Dim I As Long, J As Long
Dim xyDarkBlue(7) As Long
Dim xyLightBlue(7) As Long
Dim xyGreen(7) As Long
xyDarkBlue(0) = 0: xyDarkBlue(1) = 16
xyDarkBlue(2) = 24: xyDarkBlue(3) = 0
xyDarkBlue(4) = 24: xyDarkBlue(5) = 40
xyDarkBlue(6) = 0: xyDarkBlue(7) = 56
xyLightBlue(0) = 24: xyLightBlue(1) = 0
xyLightBlue(2) = 72: xyLightBlue(3) = 0
xyLightBlue(4) = 72: xyLightBlue(5) = 40
xyLightBlue(6) = 24: xyLightBlue(7) = 40
xyGreen(0) = 0: xyGreen(1) = 56: xyGreen(2) = 24: xyGreen(3) = 40
xyGreen(4) = 72: xyGreen(5) = 40: xyGreen(6) = 48: xyGreen(7) = 56
Call fg_setcolor(25)
Call fg_fillpage
' draw 225 filled polygons (15 rows of 15)
For J = 0 To 14
For I = 0 To 14
Call fg_polyoff(I * 72 - J * 24, J * 56 - I * 16)
Call fg_setcolor(11)
Call fg_polyfill(xyDarkBlue(0), Null, 4)
Call fg_setcolor(19)
Call fg_polyfill(xyLightBlue(0), Null, 4)
Call fg_setcolor(20)
Call fg_polyfill(xyGreen(0), Null, 4)
Next I
Next J
Call Blit
End Sub
'*****************************************************************************
' *
' Rectangles_Click() *
' *
' Draw a grid of filled rectangles. *
' *
'*****************************************************************************
Private Sub mnuRectangles_Click()
Dim I As Long, J As Long
Dim Color As Long
Dim X1 As Long, X2 As Long, Y1 As Long, Y2 As Long
Dim xInc As Long, yInc As Long
X1 = 0
xInc = vbWidth / 10
X2 = xInc - 1
Y1 = 0
yInc = vbHeight / 10
Y2 = yInc - 1
Color = 10
' draw 100 filled rectangles (10 rows of 10)
For I = 1 To 10
For J = 1 To 10
Call fg_setcolor(Color)
Call fg_rect(X1, X2, Y1, Y2)
Color = Color + 1
If (Color > 24) Then Color = 10
X1 = X1 + xInc
X2 = X2 + xInc
Next J
X1 = 0
X2 = xInc - 1
Y1 = Y1 + yInc
Y2 = Y2 + yInc
Next I
Call Blit
End Sub
'*****************************************************************************
Private Sub mnuExit_Click()
Unload Me
End Sub
'*****************************************************************************
' *
' Blit() *
' *
' Use fg_vbpaste() or fg_vbscale() to display the virtual buffer contents *
' in the client area, depending on the size of the client window. *
' *
'*****************************************************************************
Private Sub Blit()
If cxClient > vbWidth Or cyClient > vbHeight Then ' window larger than 640x480
Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
Else
Call fg_vbpaste(0, vbWidth - 1, 0, vbHeight - 1, 0, cyClient - 1)
End If
End Sub
|