Tools/WinSN5.0Ver.iso/PVb5.0/VB/SAMPLES/PGUIDE/OLECONT/OLECONT.BAS

BASIC Source File | 1997-01-30 | 4.2 KB | 134 lines

Attribute VB_Name = "ModOLECont"
Option Explicit

Public MDINew As Integer

Sub NewObject()
    MDINew = True
    NewOleForm
    If ParentForm.ActiveForm.OLE1.OLEType = vbOLENone Then
        Unload ParentForm.ActiveForm
    End If
End Sub

Sub DisplayInstructions()
    ' ╔∙├≈╛╓▓┐▒Σ┴┐
    Dim MsgText
    Dim PB
    ' │⌡╩╝╗»╢╬┬Σ▒Ω╝╟▒Σ┴┐
    PB = Chr(10) & Chr(13) & Chr(10) & Chr(13)
    ' ╧╘╩╛╓╕╡╝
    MsgText = "╥¬▓σ╚δ╥╗╕÷╨┬╢╘╧≤ú¼┤╙í░╬─╝■í▒▓╦╡Ñ╓╨╤í╘±í░╨┬╜¿í▒├ⁿ┴εú¼▓ó┤╙í░▓σ╚δ╢╘╧≤í▒╢╘╗░┐≥╓╨╤í╘±╥╗╕÷╢╘╧≤íú"
    MsgText = MsgText & PB & "╥╗╡⌐─·╙├í░┴φ┤µ╬¬í▒├ⁿ┴ε▒ú┤µ┴╦╥╗╕÷╥╤▓σ╚δ╡─╢╘╧≤ú¼─·┐╔╥╘╦µ║≤╩╣╙├í░╬─╝■í▒▓╦╡Ñ╓╨╡─í░┤≥┐¬í▒├ⁿ┴ε▓Θ┐┤╢╘╧≤íú"
    MsgText = MsgText & PB & "╥¬▒α╝¡╢╘╧≤ú¼╘≥╦½╗≈╕├╢╘╧≤ú¼┐╔╧╘╩╛│÷┤┤╜¿╢╘╧≤╡─╙ª╙├│╠╨≥╡─▒α╝¡╗╖╛│íú"
    MsgText = MsgText & PB & "╙├╩≤▒Ω╙╥╝ⁿ╡Ñ╗≈╢╘╧≤ú¼┐╔╥╘╧╘╩╛╕├╢╘╧≤╡─╬╜┤╩íú"
    MsgText = MsgText & PB & "╩╣╙├í░╕┤╓╞í▒íóí░╔╛│²í▒║═í░╤í╘±╨╘╒│╠∙í▒├ⁿ┴ε└┤╕┤╓╞íó╔╛│²║═╒│╠∙╢╘╧≤íú"
    MsgText = MsgText & PB & "╤í╘±í░╕ⁿ╨┬í▒├ⁿ┴ε└┤╕ⁿ╨┬┐╔▓σ╚δ╢╘╧≤╡──┌╚▌íú"
    MsgBox MsgText, 64, "OLE ╚▌╞≈┐╪╝■╤▌╩╛╓╕╡╝"
End Sub

Sub NewOleForm()
    Dim Newform As New ChildForm
    Newform.Show
    ' ╚τ╣√╙├╗º┤╙í░╬─╝■í▒▓╦╡Ñ╤í╘±í░╨┬╜¿í▒├ⁿ┴εú¼╓╗╧╘╩╛í░▓σ╚δ╢╘╧≤í▒╢╘╗░┐≥
    If MDINew Then
        ParentForm.ActiveForm.OLE1.InsertObjDlg
    End If

    UpdateCaption
End Sub

Sub OpenObject()
    MDINew = False
    NewOleForm
    OpenSave ("Open")
    If ParentForm.ActiveForm.OLE1.OLEType = vbOLENone Then
        Unload ParentForm.ActiveForm
    End If
End Sub

' ┤≥┐¬╨┬╬─╝■╜½╓╗╙δ░ⁿ║¼╙╨╨º OLE Automation ╢╘╧≤╡─╬─╝■╥╗╞≡╣ñ╫≈íú
' ╥¬┐┤╒Γ╕÷╣ñ╫≈ú¼╘┌╙ª╙├│╠╨≥╘╦╨╨╩▒░┤╧┬┴╨╣²│╠╜°╨╨
' 1) ┤╙í░╬─╝■í▒▓╦╡Ñú¼╤í╘±í░╨┬╜¿í▒▓ó╓╕╢¿╥╗╕÷╢╘╧≤
' 2) ▒α╝¡╢╘╧≤▓ó┤╙í░╬─╝■í▒▓╦╡Ñ╓╨╤í╘±í░┴φ┤µ╬¬í▒
' 3) ╡Ñ╗≈╢╘╧≤╡─í░▓╦╡Ñ┐╪╓╞í▒┐≥╣╪▒╒╦ⁿ
' 4) ┤╙í░╬─╝■í▒▓╦╡Ñú¼╤í╘±í░┤≥┐¬í▒▓ó╤í╘±╕╒╕╒▒ú┤µ╡─╬─╝■
Sub OpenSave(Action As String)
    Dim Filenum
    Filenum = FreeFile
    ' ╔Φ╓├╣½╣▓╢╘╗░┐≥╡─╤í╧ε║═╣²┬╦╞≈
    ParentForm.ActiveForm.CommonDialog1.Filter = _
      "┐╔▓σ╚δ╢╘╧≤ (*.OLE)|*.OLE|╦∙╙╨╬─╝■ (*.*)|*.*"
    ParentForm.ActiveForm.CommonDialog1.FilterIndex = 1

    ParentForm.ActiveForm.OLE1.FileNumber = Filenum

On Error Resume Next

    Select Case Action
        Case "Save"
            ' ╧╘╩╛í░┴φ┤µ╬¬í▒╢╘╗░┐≥
            ParentForm.ActiveForm.CommonDialog1.ShowSave
            If Err Then
                ' ╤í╘±í░╚í╧√í▒
                If Err = 32755 Then
                    Exit Sub
                Else
                    MsgBox "╩╣╙├í░┴φ┤µ╬¬í▒╢╘╗░┐≥╩▒│÷╧╓╬┤╓¬╡─┤φ╬≤íú"
                End If
            End If
            ' ┤≥┐¬▓ó▒ú┤µ╬─╝■
            Open ParentForm.ActiveForm.CommonDialog1.filename For Binary As Filenum
            If Err Then
                MsgBox (Error)
                    Exit Sub
            End If
                ParentForm.ActiveForm.OLE1.SaveToFile Filenum
            If Err Then MsgBox (Error)

        Case "Open"
            ' ╧╘╩╛í░┤≥┐¬╬─╝■í▒╢╘╗░┐≥
            ParentForm.ActiveForm.CommonDialog1.ShowOpen
            If Err Then
                ' ╤í╘±í░╚í╧√í▒
                If Err = 32755 Then
                    Exit Sub
                Else
                    MsgBox "╩╣╙├í░┤≥┐¬╬─╝■í▒╢╘╗░┐≥╩▒│÷╧╓╬┤╓¬╡─┤φ╬≤íú"
                End If
            End If
            ' ┤≥┐¬╬─╝■
            Open ParentForm.ActiveForm.CommonDialog1.filename For Binary As Filenum
            If Err Then
                Exit Sub
            End If
            ' ╧╘╩╛╔│┬⌐╣Γ▒Ω
            Screen.MousePointer = 11
            ParentForm.ActiveForm.OLE1.ReadFromFile Filenum
            If (Err) Then
                If Err = 30015 Then
                    MsgBox "╢╘╧≤╬▐╨º"
                Else
                    MsgBox Error$
                End If
                Unload ParentForm.ActiveForm
            End If
            ' ╚τ╣√┤≥┐¬╩▒╬┤╖ó╔·┤φ╬≤ú¼╘≥╝ñ╗ε╢╘╧≤
            ParentForm.ActiveForm.OLE1.DoVerb -1

        ' ╔Φ╓├┤░╠σ╩⌠╨╘ú¼OLE ╚▌╞≈┐╪╝■╡▒╟░░ⁿ║¼╥╗╕÷╢╘╧≤
        UpdateCaption
        ' ╗╓╕┤╣Γ▒Ω
        Screen.MousePointer = 0
    End Select

    Close Filenum
End Sub

Sub UpdateCaption()
    ' ╔Φ╓├┤░╠σ╩⌠╨╘ú¼╡▒╟░░ⁿ║¼╥╗╕÷╢╘╧≤
    ParentForm.ActiveForm.Caption = ParentForm.ActiveForm.OLE1.Class + " ╢╘╧≤"
    On Error Resume Next
End Sub