home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Houseplan Collection
/
HRCD2005.ISO
/
data1.cab
/
Zusatz
/
3DS
/
DATA2.Z
/
TerrainDemo.frm
< prev
next >
Wrap
Text File
|
1999-05-27
|
4KB
|
145 lines
VERSION 5.00
Begin VB.Form TerrainDemo
Caption = "Terrains"
ClientHeight = 4245
ClientLeft = 60
ClientTop = 345
ClientWidth = 5490
LinkTopic = "Form1"
ScaleHeight = 4245
ScaleWidth = 5490
StartUpPosition = 3 'Windows Default
Begin VB.ListBox Koordinaten
Height = 2595
Left = 120
TabIndex = 5
Top = 1560
Width = 5175
End
Begin VB.ComboBox Bereiche
Height = 315
Left = 1680
Style = 2 'Dropdown List
TabIndex = 3
Top = 600
Width = 3735
End
Begin VB.ComboBox Grundstuecke
Height = 315
Left = 1680
Style = 2 'Dropdown List
TabIndex = 1
Top = 120
Width = 3735
End
Begin VB.Label Label3
Caption = "Koordinaten:"
Height = 255
Left = 120
TabIndex = 4
Top = 1200
Width = 5295
End
Begin VB.Label Label2
Caption = "Bereich:"
Height = 255
Left = 120
TabIndex = 2
Top = 600
Width = 1215
End
Begin VB.Label Label1
Caption = "Grundstⁿck:"
Height = 255
Left = 120
TabIndex = 0
Top = 120
Width = 1215
End
End
Attribute VB_Name = "TerrainDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents exe As ArCon.ArCon
Attribute exe.VB_VarHelpID = -1
' Alles initialisieren
Private Sub Form_Load()
Set exe = New ArCon.ArCon
exe.StartMe hWnd, ""
ListTerrains
End Sub
' Das Programm wird beendet - Verbindung zu ArCon abbauen
Private Sub Form_Unload(Cancel As Integer)
exe.EndMe
Set exe = Nothing
End Sub
' Liste alle Grundstⁿcke, merke den Listenindex des Grundstⁿckes, auf dem
' das aktuelle GebΣude steht
Private Sub ListTerrains()
Grundstuecke.Clear
Bereiche.Clear
Koordinaten.Clear
If exe.Mode = AC_NoMode Then Exit Sub
Dim t As ArCon.Terrain, b As ArCon.Building, curBuilding As ArCon.Building
Dim i As Long, cur As Long
i = 1
cur = -1
Set curBuilding = exe.CurrentBuilding
For Each t In exe.Terrains
If t.Type = AC_TerrainEstate Then
Grundstuecke.AddItem t.Name
Grundstuecke.ItemData(Grundstuecke.NewIndex) = i
If cur < 0 Then
For Each b In t.Buildings
If b Is curBuilding Then
cur = Grundstuecke.NewIndex
End If
Next
End If
End If
i = i + 1
Next
Grundstuecke.ListIndex = cur
End Sub
' Das gewΣhlte Grundstⁿck hat gewechselt - alle Bereiche des Grundstⁿcks
' auflisten
Private Sub Grundstuecke_Click()
Dim t As ArCon.Terrain, b As ArCon.Terrain, i As Long
Set t = exe.Terrains(Grundstuecke.ItemData(Grundstuecke.ListIndex))
Bereiche.Clear
Koordinaten.Clear
i = 1
For Each b In t.Terrains
Bereiche.AddItem b.Name
Bereiche.ItemData(Bereiche.NewIndex) = i
i = i + 1
Next
If i > 1 Then
Bereiche.ListIndex = 0
End If
End Sub
Private Sub Bereiche_Click()
Dim t As ArCon.Terrain, b As ArCon.Terrain, p As Point2D
Set t = exe.Terrains(Grundstuecke.ItemData(Grundstuecke.ListIndex))
Set b = t.Terrains(Bereiche.ItemData(Bereiche.ListIndex))
Koordinaten.Clear
For Each p In b.GetPolygon
Koordinaten.AddItem "(" & p.x & "/" & p.y & ")"
Next
End Sub