Ovo je metod koji iscrtava sadržaj grafičkog fajla (.bmp, .wmf, .emf, .cur, .ico, or .dib) na Formi, PictureBox ili Printer kontroli. Sintaksa je:
objekat.PaintPicture slika, x1, y1, sirina1, visina1, x2, y2, sirina2, visina2
Izgled forme za primer 8:
Primer 8.- Upotreba metoda PaintPicture nasuprot upotrebi kontrola :
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As
Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC
As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Dim lX(0 To 1) As Long, lY(0 To 1) As Long, lW(0 To 1) As Long, lH(0 To 1) As
Long
Private Sub RestoreBackgrounds()
Dim X As Long, Y As Long, W As Long
X = imgAir.Left \ Screen.TwipsPerPixelX
If X > lX(0) Then
BitBlt hDC, lX(0), lY(0), lW(0), lH(0), picBackGround.hDC, lX(0), lY(0),
vbSrcCopy
Else
Y = imgAir.Top \ Screen.TwipsPerPixelX
If Y < lY(0) Then
BitBlt hDC, lX(0), Y + lH(0), lW(0), lY(0) - Y, picBackGround.hDC, lX(0), Y +
lH(0), vbSrcCopy
Else
BitBlt hDC, lX(0), lY(0), lW(0), lY(0) - Y, picBackGround.hDC, lX(0), lY(0),
vbSrcCopy
End If
End If
X = imgCar.Left \ Screen.TwipsPerPixelX
If X > lX(1) Then
BitBlt hDC, lX(1), lY(1), lW(1), lH(1), picBackGround.hDC, lX(1), lY(1),
vbSrcCopy
Else
W = lX(1) - X
BitBlt hDC, X + lW(1), lY(1), W, lH(1), picBackGround.hDC, X + lW(1), lY(1),
vbSrcCopy
End If
End Sub
Private Sub SaveBackgrounds()
lX(0) = imgAir.Left \ Screen.TwipsPerPixelX
lY(0) = imgAir.Top \ Screen.TwipsPerPixelY
lX(1) = imgCar.Left \ Screen.TwipsPerPixelX
lY(1) = imgCar.Top \ Screen.TwipsPerPixelY
End Sub
Private Sub cmdControls_Click()
If tmrPaint.Enabled Then cmdPaint_Click
If tmrControls.Enabled Then
tmrControls.Enabled = False
imgAir.Visible = False
imgCar.Visible = False
lblControls.Visible = False
Exit Sub
End If
imgAir.Move Width, imgTree.Top
imgAir.Visible = True
imgCar.Move Width, imgTree.Top + imgTree.Height - imgCar.Height
imgCar.Visible = True
lblControls.Visible = True
tmrControls.Enabled = True
End Sub
Private Sub cmdControls_KeyPress(KeyAscii As Integer)
Form_KeyPress KeyAscii
End Sub
Private Sub cmdPaint_Click()
If tmrControls.Enabled Then cmdControls_Click
If tmrPaint.Enabled Then
RestoreBackgrounds
tmrPaint.Enabled = False
Cls
lblPaint.Visible = False
Exit Sub
End If
lblPaint.Visible = True
imgAir.Move Width, imgTree.Top
imgCar.Move Width, imgTree.Top + imgTree.Height - imgCar.Height
SaveBackgrounds
tmrPaint.Enabled = True
End Sub
Private Sub cmdPaint_KeyPress(KeyAscii As Integer)
Form_KeyPress KeyAscii
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case Asc("+")
If tmrControls.Interval > 10 Then tmrControls.Interval = tmrControls.Interval -
10
If tmrPaint.Interval > 10 Then tmrPaint.Interval = tmrPaint.Interval - 10
Case Asc("-")
tmrControls.Interval = tmrControls.Interval + 10
tmrPaint.Interval = tmrPaint.Interval + 10
End Select
End Sub
Private Sub Form_Load()
picWork(0).AutoRedraw = True
picWork(0).AutoSize = True
picWork(0).BackColor = BackColor
Load picWork(1)
picWork(0).Picture = imgAir.Picture
picWork(1).Move 0, 0, imgCar.Width, imgCar.Height
picCarMask.AutoRedraw = True
picTreeMask.AutoRedraw = True
lW(0) = imgAir.Width \ Screen.TwipsPerPixelX
lH(0) = imgAir.Height \ Screen.TwipsPerPixelY
lW(1) = imgCar.Width \ Screen.TwipsPerPixelX
lH(1) = imgCar.Height \ Screen.TwipsPerPixelY
AutoRedraw = True
lblPaint.Visible = True
BackColor = QBColor(15)
Show
AutoRedraw = False
picBackGround.Move 0, 0, Width, Height
picBackGroundMasked.Move 0, 0, Width, Height
picBackGround.AutoRedraw = True
picBackGroundMasked.AutoRedraw = True
BitBlt picBackGroundMasked.hDC, 0, 0, Width \ Screen.TwipsPerPixelX, Height \
Screen.TwipsPerPixelY, hDC, 0, 0, vbSrcCopy
BackColor = vbButtonFace
BitBlt picBackGround.hDC, 0, 0, Width \ Screen.TwipsPerPixelX, Height \
Screen.TwipsPerPixelY, hDC, 0, 0, vbSrcCopy
lblPaint.Visible = False
End Sub
Private Sub tmrControls_Timer()
Static lCount As Long, lDir As Long
imgAir.Left = imgAir.Left - Screen.TwipsPerPixelX * 4
If lCount Mod 5 = 0 Then
If Rnd > 0.5 Then lDir = 2 Else lDir = -2
lCount = 0
End If
lCount = lCount + 1
imgAir.Top = imgAir.Top - Screen.TwipsPerPixelY * lDir
imgCar.Left = imgCar.Left - Screen.TwipsPerPixelX * 16
If imgAir.Left + imgAir.Width < 0 Then imgAir.Move Width, imgTree.Top
If imgCar.Left + imgCar.Width < 0 Then imgCar.Left = Width
End Sub
Private Sub tmrPaint_Timer()
tmrControls_Timer
picWork(0).Cls
BitBlt picWork(0).hDC, 0, 0, lW(0), lH(0), picTreeMask.hDC, (imgAir.Left -
imgTree.Left) \ Screen.TwipsPerPixelX, (imgAir.Top - imgTree.Top) \
Screen.TwipsPerPixelY, vbMergePaint
BitBlt picWork(0).hDC, 0, 0, lW(0), lH(0), picBackGroundMasked.hDC, imgAir.Left
\ Screen.TwipsPerPixelX, imgAir.Top \ Screen.TwipsPerPixelY, vbSrcAnd
BitBlt picWork(1).hDC, 0, 0, lW(1), lH(1), picBackGround.hDC, imgCar.Left \
Screen.TwipsPerPixelX, imgCar.Top \ Screen.TwipsPerPixelY, vbSrcCopy
picWork(1).PaintPicture picCarMask.Picture, 0, 0, , , , , , , vbMergePaint
picWork(1).PaintPicture imgCar.Picture, 0, 0, , , , , , , vbSrcAnd
RestoreBackgrounds
SaveBackgrounds
BitBlt hDC, lX(0), lY(0), lW(0), lH(0), picWork(0).hDC, 0, 0, vbSrcCopy
BitBlt hDC, lX(1), lY(1), lW(1), lH(1), picWork(1).hDC, 0, 0, vbSrcCopy
End Sub