İmlecin Yanında Resim

 

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 NewX
Dim SCRWID

Private Sub Command1_Click()
Cls
MousePointer = vbDefault

Command1.Visible = False
Command2.Visible = False
Call Anim
End Sub

Private Sub ick()
If Command1.Visible = False Then Exit Sub
MousePointer = 2
Beep
End Sub

Private Sub Command2_Click()
Call ick

End Sub

Private Sub Form_Load()
NewX = -170
SCRWID = Screen.Width \ 15
yy = 80
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MousePointer = vbDefault Or Command1.Visible = False Then Exit Sub
Static asd As Boolean
Dim re As Long
Dim w As Long
Dim h As Long
Static xx
Static yy
w = PicUfo.ScaleWidth
h = PicUfo.ScaleHeight
If asd = True Then
re = BitBlt(AltBitBlt.hDC, xx, yy, w, h, Picture1.hDC, 0, 0, vbSrcCopy)
End If
re = BitBlt(Picture1.hDC, 0, 0, w, h, AltBitBlt.hDC, X, Y, vbSrcCopy)
re = BitBlt(AltBitBlt.hDC, X, Y, w, h, PicUfoMask.hDC, 0, 0, vbSrcAnd)
re = BitBlt(AltBitBlt.hDC, X, Y, w, h, PicUfo.hDC, 0, 0, vbSrcPaint)
AltBitBlt.Refresh
xx = X
yy = Y
asd = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Timer1_Timer()
PaintPicture PicUfoMask, NewX, 80, , , , , , , vbSrcAnd
PaintPicture PicUfo, NewX, 80, , , , , , , vbSrcPaint '(Or vbSrcInvert)
NewX = NewX + 5: If NewX > SCRWID Then NewX = -170
End Sub

Private Sub Anim()
Static asd As Boolean
Static yy
Dim re As Long
Dim w As Long
Dim h As Long
w = PicUfo.ScaleWidth
h = PicUfo.ScaleHeight
yy = 80
Do
If asd = True Then
re = BitBlt(AltBitBlt.hDC, NewX, yy, w, h, Picture1.hDC, 0, 0, vbSrcCopy)
End If

NewX = NewX + 5: If NewX > SCRWID Then NewX = -170
re = BitBlt(Picture1.hDC, 0, 0, w, h, AltBitBlt.hDC, NewX, yy, vbSrcCopy)
asd = True
re = BitBlt(AltBitBlt.hDC, NewX, yy, w, h, PicUfoMask.hDC, 0, 0, vbSrcAnd)
re = BitBlt(AltBitBlt.hDC, NewX, yy, w, h, PicUfo.hDC, 0, 0, vbSrcPaint)
AltBitBlt.Refresh
DoEvents
Loop

End Sub

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

� mlecin yanında resim