Опытный
Профиль
Группа: Участник
Сообщений: 554
Регистрация: 15.11.2006
Где: Новосибирск
Репутация: 2
Всего: 5
|
День добрый! Задача была такая: рассчитать поле и потенциал, создаваемые системой зарядов. Идея ввода информации по распределению заряда в пространстве такая: есть 32 картинки размером 32*32. Соответственно (X,Y на картинке) = (X,Y в пространстве), номер_картинки = Z-координата в пространстве. Величина заряда высчитывается как | Код |
Public Function ColorMod(Color As Long) As Double
'Считает "модуль" цвета (интенсивность)
Dim R As Double 'Red
Dim G As Double 'Green
Dim B As Double 'Blue
B = Int(Color / (256 ^ 2))
G = Int((Color - B * 256 ^ 2) / (256))
R = Int(Color - B * 256 ^ 2 - G * 256)
'ColorMod = Sqr((R - B) * (R - B))
ColorMod = R - B
End Function
|
Т.е. чем больше красного, тем "положительней" заряд. И наоборот для синего. Собственно вопрос: как считывать цвета точек из картинки (пробовал кидать картинку на форму, а потом считывать там: Что-то не выходит) Полный текст программы: | Код |
Const N = 35
Const Nx = N 'Количество точек по оси X
Const Ny = N 'Количество точек по оси Y
Const Nz = N 'Количество точек по оси Z
'Dim Nx As Integer 'Количество точек по оси X
'Dim Ny As Integer 'Количество точек по оси Y
'Dim Nz As Integer 'Количество точек по оси Z
Const strProduct = "ГишаSoft - Экспотенциальные поверхности" 'Строка продукта
Dim Phi(Nx, Ny, Nz) As Double 'Для потенциала
Const MaxQ = 33 ^ 4 'Максимальное количество зарядов в системе
Dim CountQ As Long
'Количество зарядов в системе
Dim Q(MaxQ) As Double 'Для зарядов
Dim Qx(MaxQ) As Double 'Для зарядов X
Dim Qy(MaxQ) As Double 'Для зарядов Y
Dim Qz(MaxQ) As Double 'Для зарядов Z
Dim Ex(Nx, Ny, Nz) As Double 'Для напряженности
Dim Ey(Nx, Ny, Nz) As Double 'Для напряженности
Dim Ez(Nx, Ny, Nz) As Double 'Для напряженности
Private Sub Form_Load()
Me.Caption = strProduct 'Строку продукта - в заголовок
'mnuStart_Click
Dim strText As String
Dim L As Long
Dim a, t, x, y, c As Variant
'Ввод в программу систему распределения зарядов из файла Q.ini
strText = ReadAllFile(Replace(App.Path + "\", "\\", "\") + "Q.ini")
a = Split(strText, vbCrLf)
L = UBound(a) - LBound(a)
CountQ = L
Me.Caption = "(Количество зарядов = " + CStr(L + 1) + ") " + strProduct
For i = 0 To L
t = Split(a(i), vbTab)
Qx(i) = Val(t(0))
Qy(i) = Val(t(1))
Qz(i) = Val(t(2))
Q(i) = Val(t(3))
Next i
'Ввод в программу систему распределения зарядов из файла Q.ini
'Nx = 20
'Ny = 20
'Nz = 20
End Sub
Private Sub INputBMP()
Dim Zpic As Integer
ss = ""
s = ""
iii = -1
'Ввод в программу систему распределения зарядов из файла Q.bmp
iii = 0
For Zpic = 1 To 32
Me.Picture = LoadPicture(App.Path + "\Q\" + Trim(CStr(Zpic)) + ".bmp")
Me.Caption = "(Загружена картинка - " + App.Path + "\Q\" + Trim(CStr(Zpic)) + ".bmp" + ") " + strProduct
Me.Refresh
PicMaxX = Me.Picture.Width \ Screen.TwipsPerPixelX - 24
'MsgBox "PicMaxX=" + CStr(PicMaxX)
PicMaxY = Me.Picture.Height \ Screen.TwipsPerPixelY - 24
'MsgBox "PicMaxY=" + CStr(PicMaxY)
For i = 1 To PicMaxX
For ii = 1 To PicMaxY
Qi = ColorMod(Form1.Point(i, ii))
''If Qi <> 0 Then 'Если заряд есть, то добавляем его
' MsgBox CStr(i) + " " + CStr(ii) + " " + CStr(Zpic) + " " + CStr(Qi)
'End If
Qx(iii) = i
Qy(iii) = ii
Qz(iii) = Zpic
Q(iii) = Qi
iii = iii + 1
s = s + CStr(i) + vbTab + CStr(ii) + vbTab + CStr(Zpic) + vbTab + CStr(CInt(Q(iii - 1))) + vbCrLf
'End If
Next ii
Next i
ss = ss + s
s = ""
CountQ = iii
Me.Caption = "(Количество зарядов = " + CStr(iii) + ") " + strProduct
'Ввод в программу систему распределения зарядов из файла Q.bmp
Next Zpic
'Nx = PicMaxX * 2
'Ny = PicMaxY * 2
'Nz = 20
ss = "ZONE I=" + CStr(PicMaxX) + ", J=" + CStr(PicMaxY) + ", K=" + CStr(32) + "F=POINT" + vbCrLf + ss
ss = "VARIABLES= " + Chr(34) + "x" + Chr(34) + " " + Chr(34) + "y" + Chr(34) + " " + Chr(34) + "z" + Chr(34) + " " + Chr(34) + "Q" + Chr(34) + vbCrLf + ss
'
'
WriteStr2File ss, Replace(App.Path + "\", "\\", "\") + "Q.dat"
Me.Caption = "(S) " + strProduct
End Sub
Public Function Rad(ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Double
'Считает длину вектора по 6 координатам
Rad = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1) + (z2 - z1) * (z2 - z1))
End Function
Public Function ColorMod(Color As Long) As Double
'Считает "модуль" цвета (интенсивность)
Dim R As Double 'Red
Dim G As Double 'Green
Dim B As Double 'Blue
B = Int(Color / (256 ^ 2))
G = Int((Color - B * 256 ^ 2) / (256))
R = Int(Color - B * 256 ^ 2 - G * 256)
'ColorMod = Sqr((R - B) * (R - B))
ColorMod = R - B
End Function
Private Sub mnuLoadPicture_Click()
INputBMP
End Sub
Private Sub mnuStart_Click()
'Процедура счёта потенциала
Dim ix, iy, iz As Integer 'Вспомогательные индексы для цикла
Dim R As Double 'Для длины радиус-вектора
For iq = 0 To CountQ
Me.Caption = "Расчёт " + CStr(iq) + "/" + CStr(CountQ) + " " + strProduct
For ix = 0 To Nx - 1
For iy = 0 To Ny - 1
For iz = 0 To Nz - 1
R = Rad(ix, iy, iz, Qx(iq), Qy(iq), Qz(iq))
If R <> 0 Then
Phi(ix, iy, iz) = Phi(ix, iy, iz) + Q(iq) / R
Ex(ix, iy, iz) = Ex(ix, iy, iz) + (Qx(iq) - ix) * Q(iq) / (R * R * R)
Ey(ix, iy, iz) = Ey(ix, iy, iz) + (Qy(iq) - iy) * Q(iq) / (R * R * R)
Ez(ix, iy, iz) = Ez(ix, iy, iz) + (Qz(iq) - iz) * Q(iq) / (R * R * R)
End If
DoEvents
Next iz
Next iy
Next ix
Next iq
Beep
Dim ss, s As String
s = ""
ss = ""
For ix = 0 To Nx - 1
'Запись в файл
Me.Caption = "Формирование файла " + CStr(ix) + "/" + CStr(Nx - 1) + " " + strProduct
For iy = 0 To Ny - 1
For iz = 0 To Nz - 1
s = s + CStr(ix) + vbTab + CStr(iy) + vbTab + CStr(iz) + vbTab + CStr(CInt(10 * Ex(ix, iy, iz))) + vbTab + CStr(CInt(10 * Ey(ix, iy, iz))) + vbTab + CStr(CInt(10 * Ez(ix, iy, iz))) + vbTab + CStr(CInt(1 * Phi(ix, iy, iz))) + vbCrLf
DoEvents
Next
Next
ss = ss + s
s = ""
Next
ss = "ZONE I=" + CStr(Nx) + ", J=" + CStr(Ny) + ", K=" + CStr(Nz) + "F=POINT" + vbCrLf + ss
ss = "VARIABLES= " + Chr(34) + "x" + Chr(34) + " " + Chr(34) + "y" + Chr(34) + " " + Chr(34) + "z" + Chr(34) + " " + Chr(34) + "Ex" + Chr(34) + " " + Chr(34) + "Ey" + Chr(34) + " " + Chr(34) + "Ez" + Chr(34) + " " + Chr(34) + "Phi" + Chr(34) + vbCrLf + ss
'
'
WriteStr2File ss, Replace(App.Path + "\", "\\", "\") + "Phi.dat"
Me.Caption = "(S) " + strProduct
End
End Sub
Private Sub mnuStartQ_Click()
'Процедура вывода распледеления зарядов
Dim ix, iy, iz As Integer 'Вспомогательные индексы для цикла
For i = 0 To CountQ - 1
'Запись в файл
Me.Caption = "Формирование файла " + CStr(ix) + "/" + CStr(Nx - 1) + " " + strProduct
ss = ss + CStr(Qx(i)) + vbTab + CStr(Qy(i)) + vbTab + CStr(Qz(i)) + vbTab + CStr(CInt(1 * Q(i))) + vbCrLf
DoEvents
Next
'ss = "ZONE I=" + CStr(Nx) + ", J=" + CStr(Ny) + ", K=" + CStr(Nz) + "F=POINT" + vbCrLf + ss
ss = "VARIABLES= " + Chr(34) + "x" + Chr(34) + " " + Chr(34) + "y" + Chr(34) + " " + Chr(34) + "z" + Chr(34) + " " + Chr(34) + "Q" + Chr(34) + vbCrLf + ss
'
'
WriteStr2File ss, Replace(App.Path + "\", "\\", "\") + "Q.dat"
Me.Caption = "(S) " + strProduct
End Sub
|
Выходной файл - для программы techplot (Полный проект в аттаче)
Присоединённый файл ( Кол-во скачиваний: 2 )
Phi_Const.zip 450,69 Kb |
Работа с картинкой попиксельно 
Загрузка ...
Дата 16.5.2009, 06:13 (
Дата 19.6.2009, 22:10 (
