|
Option Explicit
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public 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
Global Const SRCCOPY = &HCC0020
Global Const SRCAND = &H8800C6
Sub KreisBlende(ByVal ziel_bild As Long, ByVal quell_bild _
As Long, ByVal breite As Integer, ByVal hoehe As Integer, _
ByVal raster As Integer, ByVal zeit As Long, _
ByVal maxzeit As Long)
On Error GoTo err_log
Dim i As Integer, k As Integer
Dim startzeit As Long
Dim startzeit2 As Long
Dim stufen As Long
Dim stufenzeit As Long
Dim start_x As Integer, start_y As Integer
Dim ziel_x As Integer, ziel_y As Integer
Dim akt_x As Integer, akt_y As Integer
Dim int_x As Integer, int_y As Integer
Dim b1 As String, b2 As String
ReDim stelle(5 + breite / raster, 5 + hoehe / raster) As Integer
startzeit = GetTickCount()
stufen = (2 * hoehe + 2 * breite) / raster
stufenzeit = zeit / stufen
For i = 0 To 5 + breite / raster
For k = 0 To 5 + hoehe / raster
stelle(i, k) = 0
Next k
Next i
start_x = (breite / raster) / 2
start_y = (hoehe / raster) / 2
ziel_y = 0
For ziel_x = (breite / raster) / 2 To (breite / raster)
If GetTickCount() - startzeit > maxzeit Then
Err = 10
End If
While GetTickCount() < startzeit + ziel_x * stufenzeit
Wend
For k = 0 To hoehe / 2
int_x = start_x + (ziel_x - start_x) * k / (hoehe / 2)
int_y = start_y + (ziel_y - start_y) * k / (hoehe / 2)
If stelle(int_x, int_y) <> 1 Then
BitBlt ziel_bild, int_x * raster, int_y * raster, _
raster, raster, quell_bild, int_x * raster, _
int_y * raster, SRCCOPY
stelle(int_x, int_y) = 1
End If
Next k
Next ziel_x
start_x = (breite / raster) / 2
start_y = (hoehe / raster) / 2
ziel_x = (breite / raster)
startzeit2 = GetTickCount()
For ziel_y = 0 To (hoehe / raster)
If GetTickCount() - startzeit > maxzeit Then Err = 10
While GetTickCount() < startzeit2 + ziel_y * stufenzeit
Wend
For k = 0 To breite / 2
int_x = start_x + (ziel_x - start_x) * k / (breite / 2)
int_y = start_y + (ziel_y - start_y) * k / (breite / 2)
If stelle(int_x, int_y) <> 1 Then
BitBlt ziel_bild, int_x * raster, int_y * raster, _
raster, raster, quell_bild, int_x * raster, _
int_y * raster, SRCCOPY
stelle(int_x, int_y) = 1
End If
Next k
Next ziel_y
start_x = (breite / raster) / 2
start_y = (hoehe / raster) / 2
ziel_y = (hoehe / raster)
startzeit2 = GetTickCount()
For ziel_x = (breite / raster) To 0 Step -1
If GetTickCount() - startzeit > maxzeit Then Error 10
While GetTickCount() < _
startzeit2 + ((breite / raster) - ziel_x) * stufenzeit
Wend
For k = 0 To hoehe / 2
int_x = start_x + (ziel_x - start_x) * k / (hoehe / 2)
int_y = start_y + (ziel_y - start_y) * k / (hoehe / 2)
If stelle(int_x, int_y) <> 1 Then
BitBlt ziel_bild, int_x * raster, int_y * raster, _
raster, raster, quell_bild, int_x * raster, _
int_y * raster, SRCCOPY
stelle(int_x, int_y) = 1
End If
Next k
Next ziel_x
start_x = (breite / raster) / 2
start_y = (hoehe / raster) / 2
ziel_x = 0
startzeit2 = GetTickCount()
For ziel_y = (hoehe / raster) To 0 Step -1
If GetTickCount() - startzeit > maxzeit Then Err = 10
While GetTickCount() < _
startzeit2 + ((hoehe / raster) - ziel_y) * stufenzeit
Wend
For k = 0 To breite / 2
int_x = start_x + (ziel_x - start_x) * k / (breite / 2)
int_y = start_y + (ziel_y - start_y) * k / (breite / 2)
If stelle(int_x, int_y) <> 1 Then
BitBlt ziel_bild, int_x * raster, int_y * raster, _
raster, raster, quell_bild, int_x * raster, _
int_y * raster, SRCCOPY
stelle(int_x, int_y) = 1
End If
Next k
Next ziel_y
start_x = (breite / raster) / 2
start_y = (hoehe / raster) / 2
ziel_y = 0
startzeit2 = GetTickCount()
For ziel_x = 0 To (breite / raster) / 2
If GetTickCount() - startzeit > maxzeit Then Err = 10
While GetTickCount() < startzeit2 + ziel_x * stufenzeit
Wend
For k = 0 To hoehe / 2
int_x = start_x + (ziel_x - start_x) * k / (hoehe / 2)
int_y = start_y + (ziel_y - start_y) * k / (hoehe / 2)
If stelle(int_x, int_y) <> 1 Then
BitBlt ziel_bild, int_x * raster, int_y * raster, _
raster, raster, quell_bild, int_x * raster, _
int_y * raster, SRCCOPY
stelle(int_x, int_y) = 1
End If
Next k
Next ziel_x
Exit Sub
err_log:
BitBlt ziel_bild, 0, 0, breite, hoehe, quell_bild, 0, 0, SRCCOPY
End Sub
Sub ZufallsBlende(ByVal ziel_bild As Long, ByVal quell_bild _
As Long, ByVal breite As Integer, ByVal hoehe As Integer, _
ByVal raster As Integer, ByVal zeit As Long, _
ByVal maxzeit As Long)
On Error GoTo raus
Dim i As Integer, k As Integer
Dim zaehler As Integer
Dim int_x As Integer, int_y As Integer
Dim max As Integer
ReDim stelle(5 + breite / raster, 5 + hoehe / raster) As Integer
Dim startzeit As Long
Dim stufen As Long
Dim stufenzeit As Long
startzeit = GetTickCount()
stufen = hoehe / raster
stufenzeit = zeit / stufen
For i = 0 To 5 + breite / raster
For k = 0 To 5 + hoehe / raster
stelle(i, k) = 0
Next k
Next i
If breite > hoehe Then max = breite
If hoehe > breite Then max = hoehe
Randomize
For i = 0 To hoehe / raster
If GetTickCount() - startzeit > maxzeit Then Err = 10
While GetTickCount() < startzeit + i * stufenzeit
Wend
For k = 0 To breite / raster
int_x = k
int_y = Int(Rnd * (hoehe / raster))
zaehler = 0
While stelle(int_x, int_y) = 1
int_y = int_y + 1
If int_y > hoehe / raster Then int_y = 0
zaehler = zaehler + 1
If zaehler > hoehe / raster Then Err = 10
Wend
BitBlt ziel_bild, int_x * raster, int_y * raster, _
raster, raster, quell_bild, int_x * raster, _
int_y * raster, SRCCOPY
stelle(int_x, int_y) = 1
Next k
Next i
Exit Sub
raus:
BitBlt ziel_bild, 0, 0, breite, hoehe, quell_bild, 0, 0, SRCCOPY
End Sub
|
|