GDIdemo: Visual Basic Version
'*****************************************************************************
' *
' GDIdemo.frm *
' *
' This program shows how to use Windows GDI functions to write to a virtual *
' buffer. It uses GDI functions to display a cross-hatched rectangle with a *
' border, something that would require construction from several graphics *
' primitives if using Fastgraph for Windows drawing functions only. *
' *
'*****************************************************************************
Const PS_SOLID = 0
Const HS_DIAGCROSS = 5
Private Declare Function CreateHatchBrush Lib "gdi32" _
(ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function Rectangle Lib "gdi32" _
(ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Dim hBrush As Long, hDIB As Long, hPen 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(320, 240)
Call fg_vbopen(hVB)
Call fg_vbcolors
' use FG to fill the virtual buffer with light green pixels
Call fg_setcolor(20)
Call fg_fillpage
' use Windows GDI functions to display a cross-hatched
' rectangle with blue border in the virtual buffer
hDIB = fg_getdc()
hPen = CreatePen(PS_SOLID, 3, RGB(0, 0, 255))
hBrush = CreateHatchBrush(HS_DIAGCROSS, RGB(255, 0, 0))
Call SelectObject(hDIB, hPen)
Call SelectObject(hDIB, hBrush)
Call Rectangle(hDIB, 20, 20, 50, 50)
Call DeleteObject(hPen)
Call DeleteObject(hBrush)
End Sub
Private Sub Form_Paint()
Call fg_vbscale(0, fg_getmaxx(), 0, fg_getmaxy(), 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
|