home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F38412_frmVbCamera.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-10-16  |  6.9 KB  |  237 lines
  1. VERSION 5.00
  2. Begin VB.Form frmVbCamera 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "TurboCAD view"
  5.    ClientHeight    =   5640
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   8940
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   5640
  13.    ScaleWidth      =   8940
  14.    ShowInTaskbar   =   0   'False
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.CommandButton CmOrbit 
  17.       Caption         =   "Orbit"
  18.       Enabled         =   0   'False
  19.       Height          =   375
  20.       Left            =   7440
  21.       TabIndex        =   6
  22.       Top             =   2895
  23.       Width           =   1275
  24.    End
  25.    Begin VB.CommandButton cmZoomAll 
  26.       Caption         =   "Zoom Extents"
  27.       Height          =   375
  28.       Left            =   7440
  29.       TabIndex        =   4
  30.       Top             =   2190
  31.       Width           =   1275
  32.    End
  33.    Begin VB.CommandButton cmZoomOut 
  34.       Caption         =   "ZoomOut"
  35.       Height          =   375
  36.       Left            =   7440
  37.       TabIndex        =   3
  38.       Top             =   1575
  39.       Width           =   1275
  40.    End
  41.    Begin VB.CommandButton cmZoomIn 
  42.       Caption         =   "ZoomIn"
  43.       Height          =   375
  44.       Left            =   7440
  45.       TabIndex        =   2
  46.       Top             =   960
  47.       Width           =   1275
  48.    End
  49.    Begin VB.CommandButton cmOpen 
  50.       Caption         =   "Open"
  51.       Height          =   375
  52.       Left            =   7440
  53.       TabIndex        =   1
  54.       Top             =   375
  55.       Width           =   1275
  56.    End
  57.    Begin VB.PictureBox picPreview 
  58.       Height          =   4275
  59.       Left            =   450
  60.       ScaleHeight     =   4215
  61.       ScaleWidth      =   5745
  62.       TabIndex        =   0
  63.       Top             =   345
  64.       Width           =   5805
  65.       Begin VB.CommandButton cmSpaceMode 
  66.          Height          =   255
  67.          Left            =   0
  68.          TabIndex        =   5
  69.          TabStop         =   0   'False
  70.          Top             =   3975
  71.          Width           =   255
  72.       End
  73.    End
  74. Attribute VB_Name = "frmVbCamera"
  75. Attribute VB_GlobalNameSpace = False
  76. Attribute VB_Creatable = False
  77. Attribute VB_PredeclaredId = True
  78. Attribute VB_Exposed = False
  79. '******************************************************************'
  80. '*                                                                *'
  81. '*                      TurboCAD for Windows                      *'
  82. '*                   Copyright (c) 1993 - 2001                    *'
  83. '*             International Microcomputer Software, Inc.         *'
  84. '*                            (IMSI)                              *'
  85. '*                      All rights reserved.                      *'
  86. '*                                                                *'
  87. '******************************************************************'
  88. Option Explicit
  89. Const M_PI = 3.14159265358979
  90. Private Sub cmOpen_Click()
  91.     Dim fName As String
  92.     On Error Resume Next
  93.     Err.Clear
  94.     fName = ""
  95.     fName = gxApp.GetOpenFilename("TCW", "Select a file", False)
  96.     On Error GoTo ErrH
  97.     Err.Clear
  98.     If fName <> "" Then
  99.         Set gxDr = gxApp.Drawings.Open(fName)
  100.         Call AddPreview
  101. On Error Resume Next
  102.         Call Camera_Plan(gxView)
  103.         gxView.ZoomToExtents
  104. Err.Clear
  105.         Call EnableButtons
  106.         cmZoomAll.SetFocus
  107.     End If
  108.     Exit Sub
  109. ErrH:
  110.     MsgBox Err.Description
  111.     Err.Clear
  112. End Sub
  113. Private Sub AddPreview()
  114.     Set gxView = gxDr.Views.Add(picPreview.hWnd)
  115. Dim varVal As Integer
  116.     varVal = gxDr.Properties("TileMode")
  117.     If varVal = imsiModelSpace Then
  118.         gxView.SpaceMode = imsiModelSpace
  119.         cmSpaceMode.Caption = "M"
  120.         CmOrbit.Enabled = True
  121.     Else
  122.         gxView.SpaceMode = imsiPaperSpace
  123.         cmSpaceMode.Caption = "P"
  124.         CmOrbit.Enabled = False
  125.     End If
  126.     gxView.ZoomToExtents
  127. End Sub
  128. Private Sub CmOrbit_Click()
  129.     Dim Cam As XCamera
  130.     Dim i As Long
  131.     Dim angle As Double
  132. ' Note we only can manipulate camera object if currect view mode is model space
  133.     Set Cam = gxView.Camera
  134.     angle = 18
  135.     ' recalculate angle in radian
  136.     angle = angle * M_PI / 180
  137. MsgBox "Camera is moving along the orbit is in XY pane"
  138.     For i = 0 To 19
  139.         Cam.Orbit angle, False, 0, 0, 1
  140.         picPreview.Refresh
  141.         gxView.Refresh
  142.     Next i
  143. MsgBox "Camera is moving along the orbit in YZ pane"
  144.     For i = 0 To 19
  145.         Cam.Orbit angle, False, 1, 0, 0
  146.         picPreview.Refresh
  147.         gxView.Refresh
  148.     Next i
  149. MsgBox "Camera is moving along the orbit in XZ pane"
  150.     For i = 0 To 19
  151.         Cam.Orbit angle, False, 0, 1, 0
  152.         picPreview.Refresh
  153.         gxView.Refresh
  154.     Next i
  155.     Set Cam = Nothing
  156. End Sub
  157. Private Sub cmSpaceMode_Click()
  158.     If gxView.SpaceMode = imsiModelSpace Then
  159.         gxView.Drawing.Properties("TileMode") = imsiPaperSpace
  160.         gxView.SpaceMode = imsiPaperSpace
  161.         cmSpaceMode.Caption = "P"
  162.         CmOrbit.Enabled = False
  163.     Else
  164.         gxView.Drawing.Properties("TileMode") = imsiModelSpace
  165.         gxView.SpaceMode = imsiModelSpace
  166.         cmSpaceMode.Caption = "M"
  167.         CmOrbit.Enabled = True
  168.     End If
  169.     cmZoomAll.SetFocus
  170.     picPreview.Refresh
  171.     gxView.ZoomToExtents
  172. End Sub
  173. Private Sub cmZoomAll_Click()
  174.     picPreview.Refresh
  175.     gxView.ZoomToExtents
  176. End Sub
  177. Private Sub cmZoomIn_Click()
  178.     Call Zoom(0.8)
  179.     picPreview.Refresh
  180.     gxView.Refresh
  181. End Sub
  182. Private Sub cmZoomOut_Click()
  183.     Call Zoom(1.2)
  184.     picPreview.Refresh
  185.     gxView.Refresh
  186. End Sub
  187. Private Sub Form_Initialize()
  188.     Call DisableButtons
  189. End Sub
  190. Private Sub Form_Terminate()
  191.     On Error Resume Next
  192.     gxView.Delete
  193.     Set gxView = Nothing
  194.     gxDr.Close False
  195.     Set gxDr = Nothing
  196.     Set gxApp = Nothing
  197. End Sub
  198. Public Sub Zoom(factor As Double)
  199.     If (factor <> 0) Then
  200.         On Error GoTo VwZoom
  201.         gxView.Camera.Zoom factor
  202.         Exit Sub
  203.     Else
  204.         gxView.ZoomToExtents
  205.     End If
  206.     Exit Sub
  207. VwZoom:
  208.         Dim xC As Double
  209.         Dim yC As Double
  210.         
  211.         Dim w As Double
  212.         Dim h As Double
  213.         On Error GoTo Err
  214.         w = gxView.ViewWidth
  215.         h = gxView.ViewHeight
  216.         xC = gxView.ViewLeft + w / 2
  217.         yC = gxView.ViewTop - h / 2
  218.         w = w * factor
  219.         h = h * factor
  220.         gxView.Update = False
  221.         
  222.         gxView.ViewLeft = xC - w / 2
  223.         gxView.ViewTop = yC + h / 2
  224.         gxView.ViewWidth = w
  225.         gxView.ViewHeight = h
  226. End Sub
  227. Private Sub EnableButtons()
  228.     cmZoomIn.Enabled = True
  229.     cmZoomOut.Enabled = True
  230.     cmZoomAll.Enabled = True
  231. End Sub
  232. Private Sub DisableButtons()
  233.     cmZoomIn.Enabled = False
  234.     cmZoomOut.Enabled = False
  235.     cmZoomAll.Enabled = False
  236. End Sub
  237.