home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
On Hand
/
On_Hand_From_Softbank_1994_Release_2_Disc_2_1994.iso
/
00202
/
s
/
disk1
/
ole2chld.fr_
/
ole2chld.bin
Wrap
Text File
|
1993-04-28
|
6KB
|
264 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
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
Else
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
Else
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