3 boyutlu dalgalanan çizgiler

Redinq* · 28 Tem 2008

Option Explicit
Const EyeR = 10#
Const EyeTheta = PI * 0.2
Const EyePhi = PI * 0.1
Const FocusX = 0#
Const FocusY = 0#
Const FocusZ = 0#
Dim Projector(1 To 4, 1 To 4) As Single
Dim ThePicture As objPicture
Dim TheGrid As ObjGrid3D
Dim Running As Integer
' Draw the surface.
Private Sub DrawData(*** As Object)
Dim x As Single
Dim y As Single
Dim z As Single
Dim S(1 To 4, 1 To 4) As Single
Dim t(1 To 4, 1 To 4) As Single
Dim ST(1 To 4, 1 To 4) As Single
Dim PST(1 To 4, 1 To 4) As Single
On Error Resume Next
' Scale and translate so it looks OK in pixels.
m3Scale S, 35, -35, 1
m3Translate t, 230, 175, 0
m3MatMultiplyFull ST, S, t
m3MatMultiplyFull PST, Projector, ST
' Transform the points.
ThePicture.ApplyFull PST
' Display the data.
***.Cls
ThePicture.Draw ***, EyeR
***.Refresh
End Sub
Private Sub CmdDisplay_Click()
Pict.Visible = True
If Running Then
cmdDisplay.Caption = "Stopped"
cmdDisplay.Enabled = False
Running = False
Else
Running = True
cmdDisplay.Caption = "Stop"
ShowFrames
cmdDisplay.Caption = "Run"
cmdDisplay.Enabled = True
End If
End Sub
Private Sub cmdExit_Click()
If cmdDisplay.Caption = "Stop" Then
MsgBox "Stop the Function first !", vbInformation, "Waves"
Exit Sub
Else
Unload Me
End If
End Sub
Private Sub Form_Load()
Dim i As Integer
'center
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
' Initialize the projection transformation.
m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
' Load empty image controls for later reproduction of saved image transformation
For i = 2 To 20
Load SurfaceImage(i)
Next i
cmdDisplay.Enabled = False
End Sub
Sub CmdCreate_click()
cmdDisplay.Enabled = True
lblCounter.Visible = True
txtCounter.Visible = True
Pict.Visible = False
Const PI_10 = PI / 10
Const xmin = -5
Const Zmin = -5
Const dx = 0.3
Const dz = 0.3
Const NumX = -2 * xmin / dx
Const NumZ = -2 * Zmin / dz
Const Amp = 0.25
Dim num As Integer
Dim offset As Single
Dim i As Integer
Dim j As Integer
Dim x As Single
Dim y As Single
Dim z As Single
Dim D As Single
MousePointer = vbHourglass
Refresh
'Save 20 positions of grid(net) as images
For num = 1 To 20
Dim count As Integer
count = (20 - num) \ 2
lblCounter.Caption = vbCrLf & "Loading ... "
txtCounter.Text = count
Set ThePicture = New objPicture
Set TheGrid = New ObjGrid3D
TheGrid.SetBounds xmin, dx, NumX, Zmin, dz, NumZ
ThePicture.objects.Add TheGrid
offset = num * PI_10
x = xmin
For i = 1 To NumX
z = Zmin
For j = 1 To NumZ
D = Sqr(x * x + z * z)
'This is a Function that can be modified , You can test various
'formulas and even ,( I think it is possible ) to get data from Db and
'set the function to show graphical ( 3D ) report.
'If you perform testing , take care about OVERFLOW error
y = Amp * Sin(3 * D - offset)
TheGrid.SetValue x, y, z
z = z + dz
Next j
x = x + dx
Next i
' Display the data.
DrawData Pict
' Save the bitmap for later.
SurfaceImage(num).Picture = Pict.Image
DoEvents
Next num
txtCounter.Visible = False
lblCounter.Visible = False
Pict.Visible = True
cmdCreate.Enabled = False
cmdDisplay.Enabled = True
cmdDisplay.Default = True
MousePointer = vbDefault
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
' Show the images.
Private Sub ShowFrames()
Const ms_per_frame = 50
Static num As Integer
Dim next_time As Long
Do While Running
num = num + 1
If num > 20 Then num = 1
next_time = GetTickCount() + ms_per_frame
Pict.Picture = SurfaceImage(num).Picture
DoEvents
WaitTill next_time
Loop
End Sub

imati · 22 Haz 2010

pylsm ıcın saol denıcem

3 boyutlu dalgalanan çizgiler

Redinq*

Üye

imati

Katılımcı Üye

Sosyal medya sayfalarımız