| Вопрос: Взаимодействие частиц. Гравитация. | Добавлено: 24.05.07 15:14 |
Автор вопроса:  ZagZag | ICQ: 295002202 |
|
Решил вот написать такую программу, которая просчитывает действие гравитации между частицами (атомы, планеты... неважно)
Форма (PictureBox = picField, cmdStart, cmdStop = CommandButton) Option Explicit
Private Type ATOM dblX As Double dblY As Double dblXspeed As Double dblYspeed As Double dblMass As Double lngColorR As Long lngColorG As Long lngColorB As Long End Type Private arAtoms() As ATOM Private arPixels() As Byte Private Const ATOMS_COUNT As Long = 150 Private bi24BitInfo As BITMAPINFO Private PIXELS_COUNT As Long Private bolStop As Boolean Private Sub cmdStart_Click() cmdStart.Enabled = False cmdStop.Enabled = True cmdStop.Default = True Do Until bolStop = True MoveAtoms DrawAtoms DoEvents Loop bolStop = False End Sub Private Sub cmdStop_Click() cmdStart.Enabled = True cmdStop.Enabled = False cmdStart.Default = True bolStop = True End Sub Private Sub Form_Load() Dim lngIndex As Long cmdStop.Enabled = False cmdStart.Default = True ReDim arAtoms(1 To ATOMS_COUNT) Randomize Timer For lngIndex = 1 To ATOMS_COUNT With arAtoms(lngIndex) .dblMass = (Rnd * 255) .dblX = picField.ScaleWidth / 2 + Rnd * 100 - 50 .dblY = picField.ScaleHeight / 2 + Rnd * 100 - 50 .dblXspeed = Rnd * 20 - 10 .dblYspeed = Rnd * 20 - 10 .lngColorR = IIf(CLng(.dblMass) > 200, 255, 0) .lngColorG = IIf(CLng(.dblMass) > 200, 255, .dblMass) .lngColorB = IIf(CLng(.dblMass) > 200, 255, 0) End With Next With bi24BitInfo.bmiHeader .biBitCount = 32 .biCompression = BI_RGB .biPlanes = 1 .biSize = Len(bi24BitInfo.bmiHeader) .biWidth = picField.ScaleWidth .biHeight = picField.ScaleHeight End With ReDim arPixels(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 4) PIXELS_COUNT = UBound(arPixels) End Sub Private Sub DrawAtoms() Dim lngIndex As Long Dim iBitmap As Long, iDC As Long Dim lngPixelPosInArray As Long iDC = CreateCompatibleDC(picField.hdc) iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&) SelectObject iDC, iBitmap GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, arPixels(1), bi24BitInfo, DIB_RGB_COLORS For lngIndex = 1 To ATOMS_COUNT With arAtoms(lngIndex) If CLng(.dblX) > 0 And CLng(.dblY) > 0 And CLng(.dblX) < bi24BitInfo.bmiHeader.biWidth And CLng(.dblY) < bi24BitInfo.bmiHeader.biHeight Then lngPixelPosInArray = (bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 1 arPixels(lngPixelPosInArray + 2) = arPixels(lngPixelPosInArray + 2) Or .lngColorR arPixels(lngPixelPosInArray + 1) = arPixels(lngPixelPosInArray + 1) Or .lngColorG arPixels(lngPixelPosInArray) = arPixels(lngPixelPosInArray) Or .lngColorB End If End With Next SetDIBitsToDevice picField.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, arPixels(1), bi24BitInfo, DIB_RGB_COLORS DeleteDC iDC DeleteObject iBitmap End Sub Public Sub MoveAtoms() Dim lngIndex As Long, lngIndex2 As Long Dim dblXC As Double, dblYC As Double Dim u As Double, F As Double For lngIndex = 1 To ATOMS_COUNT With arAtoms(lngIndex) If CLng(.dblX) > 0 And CLng(.dblY) > 0 And CLng(.dblX) < bi24BitInfo.bmiHeader.biWidth And CLng(.dblY) < bi24BitInfo.bmiHeader.biHeight Then arPixels((bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 3) = 0 arPixels((bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 2) = 0 arPixels((bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 1) = 0 End If .dblX = .dblX + .dblXspeed .dblY = .dblY + .dblYspeed For lngIndex2 = 1 To ATOMS_COUNT If lngIndex <> lngIndex2 Then dblXC = .dblX - arAtoms(lngIndex2).dblX dblYC = .dblY - arAtoms(lngIndex2).dblY ' F = .dblMass * arAtoms(lngIndex2).dblMass / (Sqr(.dblX ^ 2 + .dblY ^ 2) + 1) F = Sqr((.dblX - arAtoms(lngIndex2).dblX) ^ 2 + (.dblY - arAtoms(lngIndex2).dblY) ^ 2) ' .dblXspeed = .dblXspeed + F * Cos(dblXC) / arAtoms(lngIndex2).dblMass ' .dblYspeed = .dblYspeed + F * Sin(dblYC) / arAtoms(lngIndex2).dblMass .dblXspeed = F * Cos(dblXC) / arAtoms(lngIndex2).dblMass .dblYspeed = F * Sin(dblYC) / arAtoms(lngIndex2).dblMass End If Next End With Next End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) End End Sub Модуль basGraphics Option Explicit
Public Const BI_RGB = 0& Public Const DIB_RGB_COLORS = 0 ' color table in RGBs Public Type BITMAPINFOHEADER '40 bytes biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Public Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Public Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long Public Declare Function BitBlt Lib "gdi32.dll" (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 Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long 'Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long Public Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long Проблема с физикой, естественно. Частицы между собой взаимодейсвуют очень странно. Очень хорошо бы переписать код так чтобы частица имела координаты, скорость и угол поворота. Но проблема в том что я совсем незнаю как вычисляется угол поворота, как изменяется скорость (хотя... изменяется ли она вообще?) В любом случае - зацените примерчик. Мне нравится. Из графических фич: очень высокая отрисовка, все тормоза проги только из-за матчасти. И частицы не перекрывают друг-друга при отрисовке в одной точке, их цвета дополняются. PS Извините что дублирую тему (из оффтопа "Скорость света vs гравитация"). Но вопрос меня очень интересует, а там никто ответа не дал (скорее всего из-за того что никто не увидел вопроса.) |
| Ответы | Всего ответов: 14 |
|
Номер ответа: 1 Автор ответа:  -АлександР- Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #1 | Добавлено: 24.05.07 18:23 |
|
я вижу только черный экран(точнее пикчер) и все
|
||
|
Номер ответа: 2 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #2 | Добавлено: 24.05.07 23:52 |
|
Сорри, важну вещь забыл.
В Form_Load picField.ScaleMode = vbPixels |
||
|
Номер ответа: 3 Автор ответа: Страшный Сон Вопросов: 46 Ответов: 848 |
Профиль | | #3 | Добавлено: 25.05.07 01:29 |
|
По сабжу. Код у тебя откровенно ламерский... но притяжение я сделал. Вот пропатченные процедуры.
Private Sub Form_Load()
Dim lngIndex As Long cmdStop.Enabled = False cmdStart.Default = True ReDim arAtoms(1 To ATOMS_COUNT) Randomize Timer For lngIndex = 1 To ATOMS_COUNT With arAtoms(lngIndex) .dblMass = (Rnd * 255) .dblX = picField.ScaleWidth / 2 + Rnd * 100 - 50 .dblY = picField.ScaleHeight / 2 + Rnd * 100 - 50 .dblXspeed = 0 .dblYspeed = 0 .lngColorR = IIf(CLng(.dblMass) > 200, 255, 0) .lngColorG = IIf(CLng(.dblMass) > 200, 255, .dblMass) .lngColorB = IIf(CLng(.dblMass) > 200, 255, 0) End With Next With bi24BitInfo.bmiHeader .biBitCount = 32 .biCompression = BI_RGB .biPlanes = 1 .biSize = Len(bi24BitInfo.bmiHeader) .biWidth = picField.ScaleWidth .biHeight = picField.ScaleHeight End With ReDim arPixels(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 4) PIXELS_COUNT = UBound(arPixels) End Sub Public Sub MoveAtoms()
Dim lngIndex As Long, lngIndex2 As Long Dim dblXC As Double, dblYC As Double Dim u As Double, F As Double For lngIndex = 1 To ATOMS_COUNT With arAtoms(lngIndex) If CLng(.dblX) > 0 And CLng(.dblY) > 0 And CLng(.dblX) < bi24BitInfo.bmiHeader.biWidth And CLng(.dblY) < bi24BitInfo.bmiHeader.biHeight Then arPixels((bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 3) = 0 arPixels((bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 2) = 0 arPixels((bi24BitInfo.bmiHeader.biWidth * CLng(.dblY) + CLng(.dblX)) * 4 + 1) = 0 End If .dblX = .dblX + .dblXspeed .dblY = .dblY + .dblYspeed For lngIndex2 = 1 To ATOMS_COUNT If lngIndex <> lngIndex2 Then dblXC = .dblX - arAtoms(lngIndex2).dblX dblYC = .dblY - arAtoms(lngIndex2).dblY F = Sqr((.dblX - arAtoms(lngIndex2).dblX) * (.dblX - arAtoms(lngIndex2).dblX) + (.dblY - arAtoms(lngIndex2).dblY) * (.dblY - arAtoms(lngIndex2).dblY)) .dblXspeed = .dblXspeed + dblXC / F * arAtoms(lngIndex2).dblMass * -0.0000001 .dblYspeed = .dblYspeed + dblYC / F * arAtoms(lngIndex2).dblMass * -0.0000001 End If Next End With Next End Sub |
||
|
Номер ответа: 4 Автор ответа: Страшный СонВопросов: 46 Ответов: 848 |
Профиль | | #4 | Добавлено: 25.05.07 01:32 |
| Но это не гравитация, это немного другое притяжение. | ||
|
Номер ответа: 5 Автор ответа: Страшный СонВопросов: 46 Ответов: 848 |
Профиль | | #5 | Добавлено: 25.05.07 02:37 |
| Слушай если интересно можешь скачать вариации на тему частиц-глюкоидов на http://lezsite.narod.ru/ice24.htm , архивы D, E и G только сейчас залил. Тоже не гравитация, но симпатично... | ||
|
Номер ответа: 6 Автор ответа:  User UnknownВечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302 |
Профиль | | #6 | Добавлено: 25.05.07 10:05 |
|
fixed.
Сорри, важну вещь забыл. ZagZag.Skulls += 1 |
||
|
Номер ответа: 7 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #7 | Добавлено: 25.05.07 13:38 |
Спасибо UU за ZagZag.Skulls--; А посты-то остались! Надо бы их обновить (не обнулить  ) чтобы все по-честному было.
По теме: Страшный сон, в чем ламероидность моего кода кроме реализации физики? Я ведь и задавал вопрос как физику реализовать. Спасибо что написал как это делается (пусть даже "немного другое притяжение", как ты говоришь). Надо конечно почитать по теме. С физикой у меня нелады =( |
||
|
Номер ответа: 8 Автор ответа: Страшный СонВопросов: 46 Ответов: 848 |
Профиль | | #8 | Добавлено: 25.05.07 13:46 |
|
Страшный сон, в чем ламероидность моего кода кроме реализации физики?
Не, с кодом всё нормально... имелось в виду всякое там применение работающих с углами функнций Cos/Sin на векторных величинах и т. п... |
||
|
Номер ответа: 9 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #9 | Добавлено: 25.05.07 15:09 |
|
Я переводил пример с дельфи. А там такие заморочки... вот исходничек:
for i := 0 to pCount-1 do
begin pt.x := pt.x + pt.kx; pt.y := pt.y + pt.ky; for j := 0 to pCount-1 do if (i <> j)and pt.mv then begin cx := pt.x - pt[j].x; cy := pt.y - pt[j].y; if (abs(round(cx)) < 0.00001) and (abs(round(cy)) < 0.00001 ) then else begin u := ArcTan2(cy,cx); p := sqrt( cx*cx + cy*cy ); p := p + 1; F := 0.005*pt.m*pt[j].m/p; pt.kx := pt.kx - F*cos(u)/pt.m; pt.ky := pt.ky - F*sin(u)/pt.m; end; end; end; Вообще не пойму что делает ArcTan2(cy,cx) И вот это тоже не пойму: round - ведь округление, так зачем его с 0.00001 сравнивать? Видать допереводился, что сам запутался что к чему. |
||
|
Номер ответа: 10 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #10 | Добавлено: 25.05.07 15:43 |
|
Вообще-то pt - это массив, из-за BBCode исчезли квадратные скобки.
for i := 0 to pCount-1 do
begin pt[i].x := pt[i].x + pt[i].kx; pt[i].y := pt[i].y + pt[i].ky; for j := 0 to pCount-1 do if (i <> j)and pt[i].mv then begin cx := pt[i].x - pt[j].x; cy := pt[i].y - pt[j].y; if (abs(round(cx)) < 0.00001) and (abs(round(cy)) < 0.00001 ) then else begin u := ArcTan2(cy,cx); p := sqrt( cx*cx + cy*cy ); p := p + 1; F := 0.005*pt[i].m*pt[j].m/p; pt[i].kx := pt[i].kx - F*cos(u)/pt[i].m; pt[i].ky := pt[i].ky - F*sin(u)/pt[i].m; end; end; end; |
||
|
Номер ответа: 11 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #11 | Добавлено: 25.05.07 18:31 |
|
http://lezsite.narod.ru/ice24.htm, только что скачал. Сижу втыкаю на частицы. Как такое возможно? Клево, слов нет.
|
||
|
Номер ответа: 12 Автор ответа: Страшный СонВопросов: 46 Ответов: 848 |
Профиль | | #12 | Добавлено: 25.05.07 22:00 |
|
ArcTan2 (арктангенс частного) переводит 2D-вектор в угловую величину. Функция для двойного вектора (отрезка) вот:
Function AngleD(ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double) As Double
Dim X As Double, Y As Double X = X2 - X1 Y = Y2 - Y1 If X = 0 Then If Y >= 0 Then AngleD = pi Else AngleD = 0 Else If X > 0 Then AngleD = Atn(Y / X) + pi * 0.5 ElseIf Y >= 0 Then AngleD = Atn(Y / X) + pi * 1.5 Else AngleD = Atn(Y / X) - pi * 0.5 End If End If End Function Поставив в качестве аргументов Y и X, получим arctan2. |
||
|
Номер ответа: 13 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #13 | Добавлено: 26.05.07 12:36 |
|
В любом случае - зацените примерчик. Мне нравится. прикольно, мне нравится, я вообще люблю звездное небо
вот только ничего не понял, что там происходит: просто точки двигаются, зачем для этого было битмап юзать, а не обычный pset? может оно бы и было красиво, если бы крупнее а так еще тймер рандомайз - иногда этого перемещения вообще не видно Ну вообще молодец конечно |
||
|
Номер ответа: 14 Автор ответа: ZagZagICQ: 295002202 Вопросов: 87 Ответов: 1684 |
Профиль | | #14 | Добавлено: 26.05.07 13:23 |
|
Да я и не старался красиво сделать, я старался сделать быстро. Pset - самый медленный способ (не считая circle конечно).
А вообще, если хочешь чтоб было красиво, то тебе сюда http://lezsite.narod.ru/ice24.htm |
||
Страница: 1 |