ソースコードの続き。
'Matrix for transformation from flat to sphere
Private Sub transMat()
Dim f As Double
Dim ch As Integer
For i As Integer = 0 To H - 1
y(i) = H / Math.PI * Math.Acos(1 - 2 * i / H)
For j As Integer = 0 To H - 1
x(j, i) = H + 1
ch = Math.Sqrt*1
If ch < H / 2 Then
f = (1 - 2 * j / H) / Math.Sin(y(i) * Math.PI / H)
If f > 0.99 Then f = 0.99
If f < -1 Then f = -1
x(j, i) = H / Math.PI * Math.Acos(f)
End If
Next
Next
End Sub
'Image of sphere
Private Sub Sphere()
Dim canvas1 As New Bitmap(W, H)
Dim canvas2 As New Bitmap(H, H)
canvas1 = mixImage
Dim xt As Integer
Dim c As Color
Dim kk As Integer
kk = keido / 360 * W
For i As Integer = 0 To H - 1
For j As Integer = 0 To H - 1
If x(j, i) >= 0 And x(j, i) Then
xt = x(j, i) - kk
If xt < 0 Then xt = xt + W
c = canvas1.GetPixel(xt, y(i))
Else
c = Color.Black
End If
canvas2.SetPixel(j, i, c)
Next
Next
PictureBox2.Image = canvas2
End Sub
'Map of shadow(Day & Night)
Private Sub shadow()
Dim aSeason As Double
Dim pSeason As Double
Dim sTime As Double
Dim yDay(W - 1) As Integer
Dim canvas1 As New Bitmap(W, H)
Dim canvas2 As New Bitmap(W, H)
Dim canvas3 As New Bitmap(W, H)
canvas1 = LoadImage
canvas2 = LoadImage2
pSeason = TextBox3.Text
aSeason = Math.Tan*2 / 180 * Math.PI)
sTime = TextBox6.Text
sTime = sTime * 360
For j As Integer = 0 To W - 1
yDay(j) = Math.Atan(aSeason * Math.Cos*3 / Math.PI * H + H / 2
Next
Dim c As Color
Dim c1 As Color
Dim c2 As Color
Dim cR As Byte
Dim cG As Byte
Dim cB As Byte
Dim cA As Byte
Dim jkk As Integer
Dim ikk As Integer
Dim DorN(W - 1, H - 1) As Integer ' 1 = Day , 0 = Night
Dim Dsum As Integer
Dim Eve As Integer = W / 24 * 2
Dim Eve2 As Integer
For j As Integer = 0 To W - 1
For i As Integer = 0 To H - 1
c1 = canvas1.GetPixel(j, i)
c2 = canvas2.GetPixel(j, i)
If pSeason < Math.PI Then
If i > yDay(j) Then
DorN(j, i) = 1
c = c1
Else
DorN(j, i) = 0
c = c2
End If
Else
If i > yDay(j) Then
DorN(j, i) = 0
c = c2
Else
DorN(j, i) = 1
c = c1
End If
End If
canvas3.SetPixel(j, i, c)
Next
Next
For j As Integer = 0 To W - 1
For i As Integer = 0 To H - 1
c1 = canvas1.GetPixel(j, i)
c2 = canvas2.GetPixel(j, i)
Dsum = 0
For jk As Integer = 0 To Eve
For ik As Integer = 0 To Eve
jkk = j + jk - Eve / 2
If jkk < 0 Then jkk = jkk + W
If jkk > W - 1 Then jkk = jkk - W
ikk = i + ik - Eve / 2
If ikk < 0 Then
ikk = -ikk
jkk = jkk + W / 2
End If
If ikk > H - 1 Then
ikk = (H - 1) + (H - 1 - ikk)
jkk = jkk + W / 2
End If
If jkk > W - 1 Then jkk = jkk - W
Dsum = Dsum + DorN(jkk, ikk)
Next
Next
Eve2 = (Eve + 1) * (Eve + 1)
If Dsum > 0 And Dsum < Eve2 Then
cR = c2.R / Eve2 * (Eve2 - Dsum) + c1.R / Eve2 * Dsum
cG = c2.G / Eve2 * (Eve2 - Dsum) + c1.G / Eve2 * Dsum
cB = c2.B / Eve2 * (Eve2 - Dsum) + c1.B / Eve2 * Dsum
cA = c2.A / Eve2 * (Eve2 - Dsum) + c1.A / Eve2 * Dsum
c = Color.FromArgb(cA, cR, cG, cB)
canvas3.SetPixel(j, i, c)
End If
Next
Next
PictureBox4.SizeMode = PictureBoxSizeMode.StretchImage
mixImage = canvas3
PictureBox4.Image = mixImage
End Sub
