Senin, 12 Maret 2012

Efek laser pada pictur box di VB 6

Buat :
1 Form
1 PictureBox dan msukan gambarnya
lalu masukan Scip Code di bwah ini dan lalu copas ke dalam Project mu

Option Explicit
Dim XPos, YPos As Integer
Dim Color As Long

Dim vLeft As Boolean, hLeft As Boolean
Private Enum LaserDrawModes
LaserCorner
PrinterScan
WierdDraw
WierdDrawSlow
End Enum

Private Sub LaserDraw(PictureToDraw As PictureBox, DrawSurface As Object, Optional LaserOriginX = -1, Optional LaserOriginY = -1, Optional BackColor As ColorConstants = -1, Optional LaserDrawMode As LaserDrawModes = LaserCorner)
DrawSurface.ScaleMode = vbPixels
If BackColor <> -1 Then
DrawSurface.BackColor = BackColor
End If

PictureToDraw.ScaleMode = vbPixels
PictureToDraw.AutoRedraw = True
PictureToDraw.Visible = False

If LaserOriginX = -1 Then
LaserOriginX = PictureToDraw.ScaleWidth
End If
If LaserOriginY = -1 Then
LaserOriginY = PictureToDraw.ScaleHeight
End If

For XPos = 0 To PictureToDraw.ScaleWidth
DoEvents
For YPos = 0 To PictureToDraw.ScaleHeight
Color = PictureToDraw.Point(XPos, YPos)
If LaserDrawMode = LaserCorner Then
DrawSurface.Line (XPos, YPos)-(LaserOriginX, LaserOriginY), Color
ElseIf LaserDrawMode = PrinterScan Then
DrawSurface.Line (XPos, YPos)-(LaserOriginX, YPos), Color
DrawSurface.Line (XPos + 1, YPos - 1)-(LaserOriginX, YPos - 1), BackColor
DoEvents
ElseIf LaserDrawMode = WierdDrawSlow Then
DrawSurface.Line (XPos, YPos)-(LaserOriginX, YPos), Color
DoEvents
Else
DrawSurface.Line (XPos, YPos)-(LaserOriginX, YPos), Color
End If
Next
Next
End Sub

Private Sub Form_Load()
Me.Show
LaserDraw Picture1, Me, Me.ScaleWidth, Me.ScaleHeight, vbBlack, WierdDraw
End Sub

0 comments:

Posting Komentar

 
Design by Wordpress Theme Template Blog Free | Bloggerized by Free Blogger Templates | coupon codes