MyDesign | Kod Arşivi - Anasayfaya Dön   No banner in farm
Anasayfa Araştır Forum Gelişmiş Arama Siteniz İçin En Hit İçerikler RSS İçerik Ekle Scriptler Destekleyenler Kadromuz Reklam İletişim Giriş Sayfası Yap  Sık Kullanılanlara Ekle
Bu Kategorinin En Yeni Kodları:


Bu Kategorinin En Çok Görüntülenen Kodları:






Arama:
Gelişmiş Arama


No banner in farm



En Çok Görüntülenen Kodlar:


Üye Girişi:
 Üye Ol



Anasayfa > VisualBasic > Kodlar

3 Boyutlu Olarak Dalgalanan Çizgiler

3 boyutlu olarak dalgalanan çizgi ve resimler

Kategori : VisualBasic
Gönderen : LonG
Telif :
Tarih : 30 Mayıs 2005
Örnek Dosya : Bulunmamakta
Okunma Sayısı : 15324
Puan
: 7,5 / 10 (14 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
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(pic 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.
    pic.Cls
    ThePicture.Draw pic, EyeR
    pic.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
 
 

3 Boyutlu Olarak Dalgalanan Çizgiler için yazılan yorumlar

Henüz yorum eklenmedi.

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > 3 Boyutlu Olarak Dalgalanan Çizgiler
Kategoriler:


Forum:



Bağlantılar:


En Son Yorumlanan İçerikler:


Murat Yavuz | Site Haritası | Gizlilik Bildirimi | 54.225.47.124 | 0,12 Saniye
© Copyright 2004-2017 MyDesign | Kod Arşivi. Tüm Hakları Saklıdır.
MyDesign | Kod Arşivi, en iyi görünüm için, 1024x768 ve üzeri çözünürlük tavsiye eder.