Vb Kod Arka Plan Efekt

MnyTirith: ● Admin ●; Doğum tarihi : 20/06/90

Post n°1

Vb Kod Arka Plan Efekt

tarafından MnyTirith Cuma Mart 12, 2010 9:29 pm

private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Dim bRunning As Boolean 'Running?
Dim iMainX As Integer, iMainY As Integer 'Main Coordinates
Dim iColorOp As Integer 'Render Color Option (1 - 10)
Dim FRMHDC As Long 'Var For Forms DC
Const O_Top = 1 'Hit Bottom Side Come Out Top
Const O_Right = 2'Hit Left Side Come Out Right
Const O_Bottom = 3 'Hit Bottom Side Come Out Top
Const O_Left = 4'Hit Right Side Come Out Left
Const Max_Score = 5 'See DoPixelTest

Sub Init()
Randomize 'Initializes the random-number generator
iColorOp = Int(Rnd * 10) 'Choose Random Color Option
bRunning = True 'Running?... uh-huh.
iMainX = Int(Rnd * Form1.ScaleHeight) 'Pick a random X value
iMainY = Int(Rnd * Form1.ScaleWidth) 'Pick a random Y value

Form1.AutoRedraw = True 'Does this need a comment?

Form1.ScaleMode = 3 '3 = Pixel

Form1.BackColor = &H0 'Set Back Color to Black
FRMHDC = GetDC(Form1.hwnd) 'Grab the forms DC

Form1.Show 'Make sure the form shows up...
End Sub

Sub InitOpposite(iOption As Integer)

Select Case iOption
Case O_Top 'Hit Bottom Side Come Out Top
iMainY = 0
Case O_Bottom 'Hit Top Side Come Out Bottom
iMainY = Form1.ScaleHeight - 1
Case O_Left 'Hit Right Side Come Out Left
iMainX = Form1.ScaleWidth - 1
Case O_Right 'Hit Left Side Come Out Right
iMainX = 0
End Select
End Sub

Function FindColor(ColorOption As Integer)

Select Case ColorOption
Case 1
FindColor = RndColor_Red 'See RndColor_Red
Case 2
FindColor = RndColor_Green 'See RndColor_Green
Case 3
FindColor = RndColor_Blue 'See RndColor_Blue
Case 4
FindColor = RndColor_Gray 'See RndColor_Gray
Case 5
FindColor = RndColor_Cyan 'See RndColor_Cyan
Case 6
FindColor = RndColor_Yellow 'See RndColor_Yellow
Case 7
FindColor = RndColor_Fire 'See RndColor_Fire
Case 8
FindColor = RndColor_DrkGreen 'See RndColor_DrkGreen
Case 9
FindColor = RndColor_Ice 'See RndColor_Ice
Case Else 'Everything on the Palette
FindColor = Rnd * &HFFFFFF
End Select
End Function

Function DoPixelTest()
'Test 5 Random Pixels For Color.
'If None are Black, Clear the
'form and Start over...
Static TestScore As Integer, ColorCheck As Long 'Temporary Vars
TestScore = 0

For i = 1 To Max_Score
VBA.Interaction.DoEvents
' \/ Grab Color of Random Pixel \/
ColorCheck = GetPixel(FRMHDC, Int(Rnd * Form1.ScaleWidth), Int(Rnd * Form1.ScaleHeight))
' \/ If the color isn't black add to the
' score \/
If Not ColorCheck = &H0 Then TestScore = TestScore + 1
Next
' \/ Report Grade \/
If TestScore = Max_Score Then Form1.Cls: Init
End Function

Function FindNext()
iMainX = RndRange(iMainX - 2, iMainX + 2) 'See RndRange
iMainY = RndRange(iMainY - 2, iMainY + 2)
' \/ Test for Wall Collision \/
If iMainX > Form1.ScaleWidth Then InitOpposite O_Right
If iMainX < 0 Then InitOpposite O_Left
If iMainY > Form1.ScaleHeight Then InitOpposite O_Top
If iMainY < 0 Then InitOpposite O_Bottom
End Function

Sub RenderResults() 'Render
Call SetPixel(FRMHDC, iMainX, iMainY, FindColor(iColorOp))
End Sub

Public Function RndRange(ByVal intMin As Integer, ByVal intMax As Integer)
'This Function Generates a Random number
' between 2 numbers.
RndRange = Int(Rnd * (intMax - intMin + 1)) + intMin
End Function

Public Function RndColor_Red() 'Random Black to Red
RndColor_Red = Rnd * &HFF
End Function

Public Function RndColor_Green() 'Random Black to Green
RndColor_Green = RGB(0, Int(Rnd * 255), 0)
End Function

Public Function RndColor_DrkGreen() 'Random Black to DarkGreen
RndColor_DrkGreen = RGB(0, Int(Rnd * 150), 0)
End Function

Public Function RndColor_Blue() 'Random Black to Blue
RndColor_Blue = RGB(0, 0, Int(Rnd * 255))
End Function

Public Function RndColor_Gray() 'Random Black to White
Static GShade As Integer
GShade = Int(Rnd * 255)
RndColor_Gray = RGB(GShade, GShade, GShade)
End Function

Public Function RndColor_Fire() 'Random Red & Green
RndColor_Fire = RGB(Int(Rnd * 255), Int(Rnd * 255), 0)
End Function

Public Function RndColor_Yellow() 'Random Black to Yellow
Static GShade As Integer
GShade = Int(Rnd * 255)
RndColor_Yellow = RGB(GShade, GShade, 0)
End Function

Public Function RndColor_Ice() 'Random Green & Blue
RndColor_Ice = RGB(0, Int(Rnd * 255), Int(Rnd * 255))
End Function

Public Function RndColor_Cyan() 'Random Black to Cyan
Static GShade As Integer'Similar to ICE
GShade = Int(Rnd * 255)
RndColor_Cyan = RGB(0, GShade, GShade)
End Function

Private Sub Form_Load()
Init 'Initialize Everything

Do While bRunning = True 'Loop
VBA.Interaction.DoEvents
FindNext 'See FindNext
RenderResults 'See RenderResults

DoPixelTest 'See DoPixelTest
Loop
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then
Unload Me 'Unload on LeftClick
Else

Form1.Cls: Init 'Restart on RightClick
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
bRunning = False 'End Loop
End 'Terminate Application
End Sub

Vb Kod Arka Plan Efekt

Vb Kod Arka Plan Efekt

Similar topics

Similar topics