Приложение. Ферромагнетик в магнитном поле

 

Option Explicit

 

‘ Вся программа – это одна процедура, связанная с

‘ командной кнопкой

Private Sub Command1_Click()

Picture1.Cls

Dim n As Integer

Dim m As Integer

Dim nw As Single

Dim mw As Single

Dim i As Integer

Dim j As Integer

Dim h As Long

Dim w As Long

Dim z As Single

Dim t As Single

Dim y As Single

Dim y1 As Single

Dim f As Double

Dim ver As Single

Dim verr As Integer

Dim verb As Integer

 

h = Picture1.Height

w = Picture1.Width

‘ Число строк и столбцов в решётке

n = Text1

m = Text2

t = Text3

‘ Параметры решётки

nw = h / (n + 1)

mw = w / (m + 1)

‘ Рисование линий на решётке

For i = 0 To n

Picture1.Line (0, nw * i)-(w, nw * i)

Next

For i = 0 To m

Picture1.Line (mw * i, 0)-(mw * i, h)

Next

y = 0.5

y1 = 0.25

‘ начинает решаться уравнение f = 0 методом деления отрезка

f = y - (Exp(y / t) - Exp(-y / t)) / (Exp(y / t) + Exp(-y / t))

If t < 1 Then    ‘ t – параметр (приведённая температура)

While Abs(f) > 0.0000001

If f > 0 Then

y = y - y1

End If

If f < 0 Then

y = y + y1

End If

f = y - (Exp(y / t) - Exp(-y / t)) / (Exp(y / t) + Exp(-y / t))

y1 = y1 / 2

Wend

Text4 = y

ver = ((1 / y) + 1) / ((1 / y) - 1)

Text5 = ver '(Exp(y / t) - Exp(-y / t)) / (Exp(y / t) + Exp(-y / t))

ver = ((1 / y) + 1) / ((1 / y) - 1)

verr = CInt(ver) * n * m / (CInt(ver) + 1)

verb = n * m / (CInt(ver) + 1)

‘ Числа частиц с разными магнитными моментами

Text7 = verr

Text8 = verb

‘ Заполнение решётки атомами с разными магнитными

‘ моментами

For i = 1 To n

For j = 1 To m

z = Rnd * (verr + verb)

If z < verr Then

Picture1.FillColor = vbRed

Picture1.Circle (mw * j, nw * i), 100, vbRed

verr = verr - 1

Else

Picture1.FillColor = vbBlue

Picture1.Circle (mw * j, nw * i), 100, vbBlue

verb = verb - 1

End If

Next

Next

Else ‘ Температура выше точки Кюри

verr = n * m / 2

verb = n * m / 2

Text7 = verr

Text8 = verb

For i = 1 To n

For j = 1 To m

z = Rnd * (verr + verb)

If z < verr Then

Picture1.FillColor = vbRed

Picture1.Circle (mw * j, nw * i), 100, vbRed

verr = verr - 1

Else

Picture1.FillColor = vbBlue

Picture1.Circle (mw * j, nw * i), 100, vbBlue

verb = verb - 1

End If

Next

Next

End If

Text5 = n * m

End Sub