Liren Large Software Subsidy 10/10.iso/l/l407/1.ddi/OLE2CHLD.FR_/OLE2CHLD.bin

Visual Basic Form | 1993-04-28 | 6.1 KB | 231 lines

VERSION 2.00
Begin Form frmOLE
   Caption         =   "OLE Object Container"
   ClientHeight    =   2280
   ClientLeft      =   2010
   ClientTop       =   3735
   ClientWidth     =   4440
   Height          =   2970
   Left            =   1950
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   2280
   ScaleWidth      =   4440
   Top             =   3105
   Width           =   4560
   Begin CommonDialog CMDialog1
      Left            =   15
      Top             =   15
   End
   Begin OLE Ole1
      fFFHk           =   -1  'True
      Height          =   2295
      Left            =   -135
      SizeMode        =   2  'AutoSize
      TabIndex        =   0
      Top             =   -15
      Width           =   4455
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFileNew
         Caption         =   "&New..."
      End
      Begin Menu mnuSave
         Caption         =   "&Save As..."
      End
      Begin Menu mnuOpen
         Caption         =   "&Open"
      End
      Begin Menu sep1
         Caption         =   "-"
      End
      Begin Menu mnuExit
         Caption         =   "E&xit"
      End
      Begin Menu sep2
         Caption         =   "-"
      End
      Begin Menu mnuAbout
         Caption         =   "A&bout..."
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      Begin Menu mnuObject
         Caption         =   "&Object"
         Begin Menu mnuVerbs
            Caption         =   "verb"
            Index           =   0
         End
      End
      Begin Menu esup1
         Caption         =   "-"
      End
      Begin Menu mnuCut
         Caption         =   "Cu&t"
      End
      Begin Menu mnuCopy
         Caption         =   "&Copy"
      End
      Begin Menu mnuPaste
         Caption         =   "&Paste"
      End
      Begin Menu mnuSpecial
         Caption         =   "Paste &Special..."
      End
      Begin Menu mnuDelete
         Caption         =   "&Delete"
      End
      Begin Menu esep2
         Caption         =   "-"
      End
      Begin Menu mnuUpdate
         Caption         =   "&Update "
      End
   End
   Begin Menu mnuWindow
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin Menu mnuCascade
         Caption         =   "&Cascade"
      End
      Begin Menu mnuTile
         Caption         =   "&Tile"
      End
      Begin Menu mnuArrange
         Caption         =   "&Arrange Icons"
      End
   End
Option Explicit
Sub Form_Load ()
On Error Resume Next
Ole1.Move 0, 0
' Only display Insert Object dialog if File New was selected.
If MDINew Then
  Ole1.Action = OLE_INSERT_OBJ_DLG
  Ole1.Height = Me.Height
  Ole1.Width = Me.Width
End If
Ole1.HostName = "OLE 2.0 Demo"
End Sub
Sub Form_Resize ()
  Ole1.SizeMode = OLE_SIZE_STRETCH
  Ole1.Height = Me.ScaleHeight
  Ole1.Width = Me.ScaleWidth
End Sub
Sub mnuAbout_Click ()
  AboutBox.Show
End Sub
Sub mnuArrange_Click ()
  MDIfrm.Arrange ARRANGE_ICONS
End Sub
Sub mnuCascade_Click ()
  MDIfrm.Arrange CASCADE
End Sub
Sub mnuCopy_Click ()
  If Ole1.OLEType <> OLE_NONE Then  ' If the control contains a valid object.
    ' Display hourglass
    Screen.MousePointer = 11
    If Ole1.AppIsRunning Then
      Ole1.Action = OLE_COPY          ' Copy object to the Clipboard.
    Else
      ' Set Verb to activate hidden
      Ole1.Verb = VERB_HIDE
      Ole1.Action = OLE_ACTIVATE
      Ole1.Action = OLE_COPY          ' Copy object to the Clipboard.
      ' Set verb back to default.
      Ole1.Verb = VERB_PRIMARY
    End If
    ' Restore mouse cursor.
    Screen.MousePointer = 0
  End If
End Sub
Sub mnuCut_Click ()
  mnuCopy_Click   ' Copy object to the clipboard.
  mnuDelete_Click ' Delete object and unload the form.
End Sub
Sub mnuDelete_Click ()
If Ole1.OLEType <> OLE_NONE Then  ' If OLE control contains a valid object.
    Ole1.Action = OLE_DELETE      ' Delete the object, then unload the form.
End If
  Unload Me
End Sub
Sub mnuEdit_Click ()
Dim Verb
Dim LargestCurrentVerb As Integer
Ole1.Action = OLE_FETCH_VERBS
LargestCurrentVerb = Ole1.ObjectVerbsCount - 1
If MDIfrm.ActiveForm.Ole1.OLEType <> OLE_NONE Then
  For Verb = 1 To LargestCurrentVerb
    mnuVerbs(Verb).Caption = Ole1.ObjectVerbs(Verb)
    mnuVerbs(Verb).Visible = True
  Next Verb
  For Verb = LargestCurrentVerb + 1 To VerbMax
     mnuVerbs(Verb).Visible = False
  Next Verb
End If
If MDIfrm.ActiveForm.Ole1.PasteOK Then
  MDIfrm.ActiveForm.mnuPaste.Enabled = True
  MDIfrm.ActiveForm.mnuSpecial.Enabled = True
  MDIfrm.ActiveForm.mnuPaste.Enabled = False
  MDIfrm.ActiveForm.mnuSpecial.Enabled = False
End If
End Sub
Sub mnuExit_Click ()
    End
End Sub
Sub mnuFileNew_Click ()
  NewObject
End Sub
Sub mnuOpen_Click ()
  OpenObject
End Sub
Sub mnuPaste_Click ()
  If Ole1.PasteOK Then
    MDINew = False
    ' Display new form.
    ' NewOleForm
    ' Paste Clipboard contents.
    Ole1.Action = OLE_PASTE
    ' Set form properties.
    UpdateCaption
  Else
    MsgBox "Can't Paste"
  End If
End Sub
Sub mnuSave_Click ()
    OpenSave ("Save")
End Sub
Sub mnuSpecial_Click ()
If Ole1.PasteOK Then
  MDINew = False
  Ole1.Action = OLE_PASTE_SPECIAL_DLG
  Screen.MousePointer = 11
  UpdateCaption
  Screen.MousePointer = 0
End If
End Sub
Sub mnuTile_Click ()
  MDIfrm.Arrange TILE_HORIZONTAL
End Sub
Sub mnuUpdate_Click ()
  Screen.MousePointer = 11
  Ole1.Action = OLE_UPDATE
  Screen.MousePointer = 0
End Sub
Sub mnuVerbs_Click (index As Integer)
Ole1.Verb = index
Ole1.Action = OLE_ACTIVATE
End Sub
Sub ole1_Resize (heightnew As Single, widthnew As Single)
'This routine relies on the fact that the form is in TWIPS
'such that ScaleHeight/ScaleWidth for the form are comparable
'with the dimensions of the OLE control
Me.Height = Me.Height + (heightnew - Me.ScaleHeight)
Me.Width = Me.Width + (widthnew - Me.ScaleWidth)
End Sub
Sub Ole1_Updated (Code As Integer)
  Ole1.SizeMode = OLE_SIZE_AUTOSIZE
End Sub