home *** CD-ROM | disk | FTP | other *** search
/ The Houseplan Collection / HRCD2005.ISO / data1.cab / Zusatz / 3DS / DATA2.Z / MainForm.frm < prev    next >
Text File  |  1999-09-22  |  5KB  |  163 lines
  1. VERSION 5.00
  2. Begin VB.Form MainForm 
  3.    Caption         =   "Texture Watcher"
  4.    ClientHeight    =   4470
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   6255
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   4470
  10.    ScaleWidth      =   6255
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.TextBox ColRGB 
  13.       Height          =   285
  14.       Left            =   4680
  15.       Locked          =   -1  'True
  16.       TabIndex        =   9
  17.       Top             =   3000
  18.       Width           =   1455
  19.    End
  20.    Begin VB.TextBox vSize 
  21.       Height          =   285
  22.       Left            =   4680
  23.       Locked          =   -1  'True
  24.       TabIndex        =   7
  25.       Top             =   1920
  26.       Width           =   1455
  27.    End
  28.    Begin VB.TextBox hSize 
  29.       Height          =   285
  30.       Left            =   4680
  31.       Locked          =   -1  'True
  32.       TabIndex        =   5
  33.       Top             =   840
  34.       Width           =   1455
  35.    End
  36.    Begin VB.TextBox TextureName 
  37.       Enabled         =   0   'False
  38.       Height          =   285
  39.       Left            =   840
  40.       Locked          =   -1  'True
  41.       TabIndex        =   3
  42.       Top             =   4080
  43.       Width           =   5295
  44.    End
  45.    Begin VB.PictureBox Display 
  46.       BackColor       =   &H000000C0&
  47.       Height          =   3495
  48.       Left            =   120
  49.       ScaleHeight     =   3435
  50.       ScaleWidth      =   4275
  51.       TabIndex        =   0
  52.       Top             =   480
  53.       Width           =   4335
  54.    End
  55.    Begin VB.Label Label5 
  56.       Caption         =   "Farbe:"
  57.       Height          =   255
  58.       Left            =   4680
  59.       TabIndex        =   8
  60.       Top             =   2760
  61.       Width           =   1335
  62.    End
  63.    Begin VB.Label Label4 
  64.       Caption         =   "H÷he [m]:"
  65.       Height          =   255
  66.       Left            =   4680
  67.       TabIndex        =   6
  68.       Top             =   1680
  69.       Width           =   1335
  70.    End
  71.    Begin VB.Label Label3 
  72.       Caption         =   "Breite [m]:"
  73.       Height          =   255
  74.       Left            =   4680
  75.       TabIndex        =   4
  76.       Top             =   600
  77.       Width           =   1335
  78.    End
  79.    Begin VB.Label Label2 
  80.       Caption         =   "Name:"
  81.       Height          =   255
  82.       Left            =   120
  83.       TabIndex        =   2
  84.       Top             =   4080
  85.       Width           =   615
  86.    End
  87.    Begin VB.Label Label1 
  88.       Caption         =   "Zuletzt gedroppte Textur:"
  89.       Height          =   255
  90.       Left            =   120
  91.       TabIndex        =   1
  92.       Top             =   120
  93.       Width           =   4335
  94.    End
  95. End
  96. Attribute VB_Name = "MainForm"
  97. Attribute VB_GlobalNameSpace = False
  98. Attribute VB_Creatable = False
  99. Attribute VB_PredeclaredId = True
  100. Attribute VB_Exposed = False
  101. Option Explicit
  102.  
  103. Private Declare Function PictureFromArConPicture Lib "MakroUtil" _
  104.     (ByRef picture As Variant) As StdPicture
  105.  
  106. Dim WithEvents exe As ArCon.ArCon
  107. Attribute exe.VB_VarHelpID = -1
  108.  
  109. Private Sub exe_ChangeNotify(ByVal obj As Object, ByVal events As Long)
  110.     If events And AC_CHANGE_TextureChanged = 0 Then Exit Sub
  111.     If Not TypeOf obj Is ArCon.WallSegment Then Exit Sub
  112.     
  113.     Dim w As ArCon.WallSegment
  114.     Set w = obj
  115.     ShowNewTexture w.Texture.Name
  116. End Sub
  117.  
  118. Private Sub exe_ProgramExit()
  119.     If Not exe Is Nothing Then
  120.         exe.EndMe
  121.         Set exe = Nothing
  122.     End If
  123.     Unload Me
  124. End Sub
  125.  
  126. Private Sub ShowNewTexture(ByVal newTexName As String)
  127.     Dim pic As Variant
  128.     Dim col As Long
  129.     Dim h As Single, w As Single
  130.     Dim isBmp As Boolean
  131.     
  132.     Display.picture = Nothing
  133.     Display.BackColor = RGB(0, 0, 0)
  134.     hSize.Text = ""
  135.     vSize.Text = ""
  136.     ColRGB.Text = ""
  137.     TextureName.Text = newTexName
  138.     If Not exe.TextureToPicture(newTexName, isBmp, col, pic, w, h) Then Exit Sub
  139.     hSize.Text = CStr(w)
  140.     vSize.Text = CStr(h)
  141.     If isBmp Then
  142.         Display.picture = PictureFromArConPicture(pic)
  143.     Else
  144.         ColRGB.Text = "0x00" & Hex(col)
  145.         Display.BackColor = col
  146.     End If
  147. End Sub
  148.  
  149. Private Sub Form_Load()
  150.     Dim oldMask As Long
  151.     Set exe = New ArCon.ArCon
  152.     exe.StartMe hWnd, ""
  153.     exe.ChangeTypeNotifyMask AC_OBJTYPE_WallSegment, AC_CHANGE_TextureChanged, 0, oldMask
  154.     ShowNewTexture ""
  155. End Sub
  156.  
  157. Private Sub Form_Unload(Cancel As Integer)
  158.     If Not exe Is Nothing Then
  159.         exe.EndMe
  160.         Set exe = Nothing
  161.     End If
  162. End Sub
  163.