home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l406 / 3.ddi / OLEDEMO.BA_ / OLEDEMO.bin
Encoding:
Text File  |  1992-10-21  |  4.4 KB  |  155 lines
  1. Type Rectangle
  2.     Left As Integer
  3.     Top As Integer
  4.     Right As Integer
  5.     Bottom As Integer
  6. End Type
  7. Global OleRect As Rectangle
  8.  
  9. Declare Function OleQueryBounds Lib "OLECLI" (ByVal LpOleObject As Long, aRect As Rectangle) As Integer
  10.  
  11. '---------------------------------------
  12. ' Global Flags and Variables
  13. '---------------------------------------
  14. Global Save As Integer
  15. Global ContainsObject As Integer
  16. Global LinkFlag As Integer
  17. Global CancelFlag As Integer
  18. Global ClassDisplay As String
  19. Global RegIndex As Integer
  20.  
  21. '---------------------------------------
  22. ' Global Constants
  23. '---------------------------------------
  24. 'Action
  25. Global Const OLE_CREATE_NEW = 0
  26. Global Const OLE_CREATE_FROM_FILE = 1
  27. Global Const OLE_COPY = 4
  28. Global Const OLE_PASTE = 5
  29. Global Const OLE_UPDATE = 6
  30. Global Const OLE_ACTIVATE = 7
  31. Global Const OLE_EXECUTE = 8
  32. Global Const OLE_CLOSE = 9
  33. Global Const OLE_DELETE = 10
  34. Global Const OLE_SAVE_TO_FILE = 11
  35. Global Const OLE_READ_FROM_FILE = 12
  36. Global Const OLE_CONVERT_TO_TYPE = 13
  37.  
  38. 'ServerType
  39. Global Const OLE_LINKED = 0
  40. Global Const OLE_EMBEDDED = 1
  41. Global Const OLE_STATIC = 2
  42.  
  43. 'UpdateOptions
  44. Global Const OLE_AUTOMATIC = 0
  45. Global Const OLE_FROZEN = 1
  46. Global Const OLE_MANUAL = 2
  47.  
  48. 'Update Event Constants
  49. Global Const OLE_CHANGED = 0
  50. Global Const OLE_SAVED = 1
  51. Global Const OLE_CLOSED = 2
  52. Global Const OLE_RELEASE = 3
  53.  
  54. Sub CenterForm (frmParent As Form, frmChild As Form)
  55. ' This procedure centers a child form over a parent form.
  56. ' Calling this routine loads the dialog. Use the Show method
  57. ' to display the dialog after calling this routine ( ie MyFrm.Show 1)
  58.  
  59.   ' get left offset
  60.   l = frmParent.Left + ((frmParent.Width - frmChild.Width) / 2)
  61.   If (l + frmChild.Width > Screen.Width) Then
  62.     l = Screen.Width - frmChild.Width
  63.   End If
  64.  
  65.   ' get top offset
  66.   t = frmParent.Top + ((frmParent.Height - frmChild.Height) / 2)
  67.   If (t + frmChild.Height > Screen.Height) Then
  68.     t = Screen.Height - frmChild.Height
  69.   End If
  70.  
  71.   ' center the child formfv
  72.   frmChild.Move l, t
  73.  
  74. End Sub
  75.  
  76. Function FindDisplayName (ByVal S$) As String
  77.   ' This function searches the registration database until it
  78.   ' locates the specified class name. The function returns the
  79.   ' class display name associated with the class name.
  80.   
  81.   Dim I As Integer
  82.   Dim count As Integer
  83.  
  84.   count = frmMain.OleClient1.ServerClassCount - 1
  85.   
  86.   For I = 0 To count
  87.     If (frmMain.OleClient1.ServerClasses(I) = S$) Then
  88.       Exit For
  89.     End If
  90.   Next I
  91.     'set Global variable for future queries into reg database
  92.     RegIndex = I
  93.     FindDisplayName = frmMain.OleClient1.ServerClassesDisplay(RegIndex)
  94. End Function
  95.  
  96. Sub HighLightTextBox ()
  97.  
  98.     FileForm.txtFileName.SelStart = 0
  99.     FileForm.txtFileName.SelLength = Len(FileForm.txtFileName.Text)
  100.     FileForm.txtFileName.SetFocus
  101.  
  102. End Sub
  103.  
  104. Sub InitEditObjectMenu ()
  105.   ' This procedure sets up the edit object menu.
  106.   ' It should be called each time a new object
  107.   ' is displayed (insert, paste, paste link, open)
  108.  
  109.   frmMain.OleClient1.ServerClass = frmMain.OleClient1.Class
  110.   Class$ = frmMain.OleClient1.ServerClassesDisplay(RegIndex)
  111.   
  112.   ' If more than one verb supported
  113.   If frmMain.OleClient1.ServerVerbsCount > 1 Then
  114.     frmMain.mnuEditObject(0).Caption = Class$ + "&Object"
  115.     frmMain.mnuEditObject(0).Visible = -1
  116.     frmMain.mnuEditObject(1).Visible = 0
  117.     Call InitVerbsMenu
  118.   
  119.   Else
  120.     ' one or less verbs supported
  121.     ' get object's primary verb
  122.     objVerb$ = frmMain.OleClient1.ServerVerbs(0)
  123.     If objVerb$ <> "" Then
  124.       objVerb$ = objVerb$ + " "
  125.     End If
  126.     frmMain.mnuEditObject(1).Caption = objVerb$ + Class$
  127.     frmMain.mnuEditObject(1).Visible = -1
  128.     frmMain.mnuEditObject(0).Visible = 0
  129.   End If
  130. End Sub
  131.  
  132. Sub InitVerbsMenu ()
  133.   Dim I As Integer
  134.   Dim vCount As Integer
  135.  
  136.   On Error Resume Next
  137.   For I = 10 To 1 Step -1
  138.     Unload frmMain.mnuEditObjVerb(I)
  139.   Next I
  140.   frmMain.OleClient1.ServerClass = frmMain.OleClient1.Class
  141.   vCount = frmMain.OleClient1.ServerVerbsCount
  142.   If (vCount) Then
  143.     frmMain.mnuEditObjVerb(0).Caption = frmMain.OleClient1.ServerVerbs(0)
  144.     For I = 1 To vCount - 1
  145.       Load frmMain.mnuEditObjVerb(I)
  146.       frmMain.mnuEditObjVerb(I).Caption = frmMain.OleClient1.ServerVerbs(I)
  147.       frmMain.mnuEditObjVerb(I).Visible = -1
  148.     Next I
  149.   Else
  150.     'if no verbs are supported
  151.     frmMain.mnuEditObjVerb(0).Caption = "Edit"
  152.   End If
  153. End Sub
  154.  
  155.