home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch13code / zoom.frm < prev    next >
Text File  |  1995-08-12  |  4KB  |  137 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3228
  5.    ClientLeft      =   1332
  6.    ClientTop       =   2076
  7.    ClientWidth     =   4572
  8.    Height          =   3780
  9.    Left            =   1284
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3228
  12.    ScaleWidth      =   4572
  13.    Top             =   1572
  14.    Width           =   4668
  15.    Begin VB.VScrollBar VScroll1 
  16.       Height          =   3252
  17.       Left            =   4320
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Width           =   252
  21.    End
  22.    Begin VB.OLE OLE1 
  23.       Height          =   3252
  24.       Left            =   0
  25.       SizeMode        =   3  'Zoom
  26.       TabIndex        =   1
  27.       Top             =   0
  28.       Width           =   4332
  29.    End
  30.    Begin VB.Menu mnuFile 
  31.       Caption         =   "&File"
  32.       NegotiatePosition=   1  'Left
  33.       Begin VB.Menu mnuNew 
  34.          Caption         =   "&New Object"
  35.       End
  36.       Begin VB.Menu mnuClose 
  37.          Caption         =   "&Close Object"
  38.       End
  39.       Begin VB.Menu mnuSep1 
  40.          Caption         =   "-"
  41.       End
  42.       Begin VB.Menu mnuExit 
  43.          Caption         =   "E&xit"
  44.       End
  45.    End
  46. End
  47. Attribute VB_Name = "Form1"
  48. Attribute VB_Creatable = False
  49. Attribute VB_Exposed = False
  50. Option Explicit
  51. Dim msHeightRatio As Single, msWidthRatio As Single
  52. Dim msIdealHeight As Single, msIdealWidth As Single
  53. Dim msActualHeight As Single, msActualWidth As Single
  54. Dim mResized As Boolean
  55. Private Sub Form_Load()
  56.     ' Keep control the same size.
  57.     OLE1.SizeMode = vbOLESizeZoom
  58.     ' Display the Insert Object dialog on startup.
  59.     OLE1.InsertObjDlg
  60. End Sub
  61.  
  62.  
  63. Private Sub Form_Resize()
  64.     ' Move scroll bar
  65.     AdjustScrollBars Me
  66.     ' Resize OLE object.
  67.     OLE1.Height = Me.Height
  68.     ' Allow resize action
  69.     mResized = False
  70.     OLE1.Width = Me.Width - VScroll1.Width
  71. End Sub
  72.  
  73.  
  74. Private Sub mnuClose_Click()
  75.     OLE1.Close
  76. End Sub
  77.  
  78. Private Sub mnuExit_Click()
  79.     End
  80. End Sub
  81.  
  82.  
  83. Private Sub mnuNew_Click()
  84.     mResized = False
  85.     OLE1.InsertObjDlg
  86. End Sub
  87.  
  88.  
  89.  
  90.  
  91. Private Sub OLE1_Resize(HeightNew As Single, WidthNew As Single)
  92.     ' Get the actual height and width of the object
  93.     ' from the application.
  94.     If Not mResized Then
  95.         ' Get the control size.
  96.         msActualHeight = OLE1.Height
  97.         msActualWidth = OLE1.Width
  98.         ' Temporarily switch SizeMode to get
  99.         ' the actual size.
  100.         OLE1.SizeMode = vbOLESizeAutoSize
  101.         ' Get the actual height and width of the object.
  102.         msIdealHeight = OLE1.Height
  103.         msIdealWidth = OLE1.Width
  104.         ' Reset size mode and height/width
  105.         OLE1.SizeMode = vbOLESizeZoom
  106.         OLE1.Height = msActualHeight
  107.         OLE1.Width = msActualWidth
  108.         ' Choose which ratio is greater.
  109.         msHeightRatio = OLE1.Height / msIdealHeight
  110.         msWidthRatio = OLE1.Width / msIdealWidth
  111.         ' Use the greater ratio for the scroll bar zoom.
  112.         If msHeightRatio >= msHeightRatio Then
  113.             ' Set the maxium value (400%)
  114.             VScroll1.MAX = msWidthRatio * 4
  115.        Else
  116.             ' Set the maxium value (400%)
  117.             VScroll1.MAX = msWidthRatio * 4
  118.        End If
  119.         ' Set the initial scrollbar position.
  120.         VScroll1.MIN = 1
  121.         VScroll1.VALUE = 1
  122.        ' Set module-level variable.
  123.        mResized = True
  124.     End If
  125. End Sub
  126.  
  127.  
  128.  
  129. ' Zoom OLE control.
  130. Private Sub VScroll1_Change()
  131.     ' Scale Height and Width.
  132.     OLE1.Height = msActualHeight * VScroll1.VALUE
  133.     OLE1.Width = msActualWidth * VScroll1.VALUE
  134. End Sub
  135.  
  136.  
  137.