Выскажите своё мнение насчёт огня... Попрошу меня необижать
Модератор: Mikle


Option Explicit 
Private Const x As Long = 25 
Private Const y As Long = 60 
Dim disp1(x, y) As Long 
Dim disp2(x, y) As Long 
Dim fon(x, y) As Long 
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long 
Dim l As Long 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 
Private Sub Form_Activate() 
Do 
Timer 
DoEvents 
Loop 
End Sub 
Private Sub Timer() 
PSet (0, 0), 0 
Dim i As Integer 
Dim o As Integer 
Dim R1 As Integer 
Dim G1 As Integer 
Dim B1 As Integer 
For i = 1 To 2 
disp1(Rnd * x / 2 + x / 4, 1) = Rnd * 20000 
Next 
For i = 1 To x - 1 
For o = 1 To y - 2 
l = (disp1(i - 1, o - 1) + disp1(i, o - 1) + disp1(i + 1, o - 1) + disp1(i - 1, o) _ 
+ disp1(i + 1, o) + disp1(i - 1, o + 1) + disp1(i, o + 1) + disp1(i + 1, o + 1) + disp1(i, o)) / 9.5 
LongToColor l, R1, G1, B1 
Call SetPixel(Form1.hdc, i + 123, y - o + 32, RGB(R1, G1, B1)) 
disp2(i, o + 1) = l 
Next 
Next 
CopyMemory disp1(0, 0), disp2(0, 0), (x + 1) * (y + 1) * Len(disp2(0, 0)) 
End Sub 
Private Sub LongToColor(Index As Long, R As Integer, G As Integer, B As Integer) 
R = -((Index > 255) * 255 + (Index >= 0 And Index <= 255) * (Index Mod 256)) 
G = -((Index > 511) * 255 + (Index >= 256 And Index <= 511) * (Index Mod 256)) 
B = -((Index > 767) * 255 + (Index >= 512 And Index <= 767) * (Index Mod 256)) 
End Sub







Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6