Option Explicit
'Struktury momentowe
Const PI = 3.14159265358979
Private Sub Command1_Click()
Picture1.Picture = LoadPicture(Text1.Text)
Picture2.Picture = LoadPicture(Text1.Text)
End Sub
Private Sub Command2_Click()
Call Mechanika
End Sub
Private Sub Command3_Click()
List1.Clear
End Sub
Private Sub Mechanika()
'liczy momenty dla białego
'Raportuje na list1
Dim X, Y As Integer
Dim x0, y0 As Double
Dim F, Sx, Sy As Double
Dim Jx0, Jy0, Jx0y0, Jx, Jy, Jxy, Je_0, Jt_0 As Double
Dim alfa_e, alfa_t, alfa_e_deg, alfa_t_deg As Double
' obsługa punktów przecięcia
Dim x_s1, y_s1 As Integer
Dim x_s2, y_s2 As Integer
Dim x_s3, y_s3 As Integer
Dim x_s4, y_s4 As Integer
Dim wektor_cz(1 To 2) As Double ' wektory jednostkowe
Dim wektor_nieb(1 To 2) As Double
Dim i, zakres_szukania As Integer
Dim czarny As Boolean
Dim obraz_zrodlowy As Object
Dim obraz_generowany As Object
' wybór obrazu zródłowego
Set obraz_zrodlowy = Picture1
obraz_zrodlowy.Line (1, 1)-(obraz_zrodlowy.ScaleWidth - 1, obraz_zrodlowy.ScaleHeight - 1), vbRed, B
' wybór obrazu wizualizacji
Set obraz_generowany = Picture2
'Obliczenie środka cięzkosci i momentów
F = 0
Sx = 0
Sy = 0
Jx = 0
Jy = 0
Jxy = 0
czarny = False
For X = 0 To obraz_zrodlowy.ScaleWidth
For Y = 0 To obraz_zrodlowy.ScaleHeight
If obraz_zrodlowy.Point(X, Y) = vbWhite Then 'Całkowanie
F = F + 1
Sx = Sx + Y
Sy = Sy + X
Jx = Jx + Y ^ 2
Jy = Jy + X ^ 2
Jxy = Jxy + X * Y
End If
Next Y
Next X
'Obliczenia
If F = 0 Then
MsgBox ("Brak pikseli - w konsekwencji błąd interpretacji ")
Else
x0 = Sy / F
y0 = Sx / F
End If
'środek ciężkości
obraz_generowany.PSet (x0, y0), vbRed
List1.AddItem " x0= " + Str(x0)
List1.AddItem " y0= " + Str(y0)
List1.AddItem " F= " + Str(F)
'Struktury momentu bezwładności
Jx0 = Jx - F * y0 ^ 2
Jy0 = Jy - F * x0 ^ 2
Jx0y0 = Jxy - F * x0 * y0
Je_0 = (Jx0 + Jy0) / 2 + Sqr(0.25 * (Jy0 - Jx0) ^ 2 + Jx0y0 ^ 2)
Jt_0 = (Jx0 + Jy0) / 2 - Sqr(0.25 * (Jy0 - Jx0) ^ 2 + Jx0y0 ^ 2)
If (Jy0 <> Je_0) Then
alfa_e = Atn(Jx0y0 / (Jy0 - Je_0))
Else
alfa_e = PI / 2
End If
If (Jy0 <> Jt_0) Then
alfa_t = Atn(Jx0y0 / (Jy0 - Jt_0))
Else
alfa_t = PI / 2
End If
'oblicz wektory jednostkowe
wektor_cz(1) = Cos(alfa_e) ' składowa 1
wektor_cz(2) = Sin(alfa_e) ' składowa 2
wektor_nieb(1) = Cos(alfa_t)
wektor_nieb(2) = Sin(alfa_t)
'oblicz punkty przecięcia
zakres_szukania = 320 'uwaga ograniczenie niewystarczające dla dużych obrazów
i = 0
czarny = False
Do While (czarny <> True And i < zakres_szukania And i > -zakres_szukania)
If obraz_zrodlowy.Point(x0 + i * wektor_cz(1), y0 + i * wektor_cz(2)) = vbBlack Then
x_s1 = x0 + i * wektor_cz(1)
y_s1 = y0 + i * wektor_cz(2)
obraz_generowany.Circle (x_s1, y_s1), 5, vbRed
czarny = True
End If
i = i + 1
Loop
i = 0
czarny = False
Do While (czarny <> True And i < zakres_szukania And i > -zakres_szukania)
If obraz_zrodlowy.Point(x0 + i * wektor_cz(1), y0 + i * wektor_cz(2)) = vbBlack Then
x_s2 = x0 + i * wektor_cz(1)
y_s2 = y0 + i * wektor_cz(2)
obraz_generowany.Circle (x_s2, y_s2), 5, vbMagenta
czarny = True
End If
i = i - 1
Loop
i = 0
czarny = False
Do While (czarny <> True And i < zakres_szukania And i > -zakres_szukania)
If obraz_zrodlowy.Point(x0 + i * wektor_nieb(1), y0 + i * wektor_nieb(2)) = vbBlack Then
x_s3 = x0 + i * wektor_nieb(1)
y_s3 = y0 + i * wektor_nieb(2)
obraz_generowany.Circle (x_s3, y_s3), 5, vbCyan
czarny = True
End If
i = i + 1
Loop
i = 0
czarny = False
Do While (czarny <> True And i < zakres_szukania And i > -zakres_szukania)
If obraz_zrodlowy.Point(x0 + i * wektor_nieb(1), y0 + i * wektor_nieb(2)) = vbBlack Then
x_s4 = x0 + i * wektor_nieb(1)
y_s4 = y0 + i * wektor_nieb(2)
obraz_generowany.Circle (x_s4, y_s4), 5, vbYellow
czarny = True
End If
i = i - 1
Loop
'przeliczenie na stopnie - sin i cos używają miary radianów
alfa_e_deg = (alfa_e * 180) / PI
alfa_t_deg = (alfa_t * 180) / PI
List1.AddItem " Jy0 = " + Str(Jy0)
List1.AddItem " Je_0 = " + Str(Je_0)
List1.AddItem " Jt_0 = " + Str(Jt_0)
List1.AddItem "alfa_e_red = " + Str(alfa_e_deg)
List1.AddItem "alfa_t_blue = " + Str(alfa_t_deg)
List1.AddItem " "
'wizualizacja
obraz_generowany.Line (x0, y0)-(x0 + 120, y0), vbGreen
obraz_generowany.Circle (x0, y0), 5, vbGreen
obraz_generowany.Line (x0, y0)-(x0 + 100 * Cos(alfa_e), y0 + 100 * Sin(alfa_e)), vbRed
obraz_generowany.Line (x0, y0)-(x0 + 100 * Cos(alfa_t), y0 + 100 * Sin(alfa_t)), vbBlue
obraz_zrodlowy.Line (1, 1)-(obraz_zrodlowy.ScaleWidth - 1, obraz_zrodlowy.ScaleHeight - 1), vbBlack, B
End Sub
`--------------------------------------------------------------------------
Private Sub Command4_Click()
Zakres_obiektu
End Sub
Private Sub Zakres_obiektu()
'dla obiektu białego
Dim xmin, ymin, xmax, ymax, X, Y As Integer
xmin = 1000
ymin = 1000
xmax = 0
ymax = 0
'wizualizacja
End Sub
Mechan1_c
2