home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mdishe / ctl3d.bas < prev    next >
Encoding:
BASIC Source File  |  1994-12-26  |  2.6 KB  |  67 lines
  1. ' Ctl3D.Bas - Control 3D Start and End
  2. ' 94/08/11 Copyright 1994, Larry Rebich, The Bridge, Inc.
  3. ' Start by calling Ctl3D_Start
  4. ' End by calling   Ctl3D_End
  5. '--------------------------------------------------------
  6.  
  7.     Option Explicit
  8.     DefInt A-Z
  9.     
  10.     Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
  11.     Declare Function Ctl3DAutoSubclass Lib "Ctl3Dv2.DLL" (ByVal hInst As Integer) As Integer
  12.     Declare Function Ctl3DRegister Lib "Ctl3Dv2.DLL" (ByVal hInst As Integer) As Integer
  13.     Declare Function Ctl3DUnregister Lib "Ctl3Dv2.DLL" (ByVal hInst As Integer) As Integer
  14. '    Declare Function Ctl3DAutoSubclass Lib "Ctl3D.DLL" (ByVal hInst As Integer) As Integer
  15. '    Declare Function Ctl3DRegister Lib "Ctl3D.DLL" (ByVal hInst As Integer) As Integer
  16. '    Declare Function Ctl3DUnregister Lib "Ctl3D.DLL" (ByVal hInst As Integer) As Integer
  17.     
  18.     Const GWW_HINSTANCE = (-6)
  19.  
  20.     Dim Ctl3D_Open As Integer   'set to true if open
  21.  
  22. Sub Ctl3D_End ()
  23.     Dim inst, ret
  24.  
  25.     Rem This Sub is used to end the 3D effects
  26.     Rem IMPORTANT: you must end 3D effects before your app ends
  27.     If Not Ctl3D_Open Then Exit Sub 'not open, so forget it
  28.     inst = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word of Frm
  29.     ret = Ctl3DUnregister(inst)     ' Unregister the program.
  30.     Ctl3D_Open = False
  31. End Sub
  32.  
  33. Sub Ctl3D_Start ()
  34.     ' Use this to start the 3D dialogs
  35.     If Ctl3D_Open Then Exit Sub     'already registered
  36.     If Not DoesCtl3DExist() Then Exit Sub   'can't find it
  37.     If Forms.Count = 0 Then
  38.         Dim Msg As String
  39.         Msg = "There is no loaded form.  "
  40.         Msg = Msg & "To register your app with CTL3D "
  41.         Msg = Msg & "there must be at least one loaded form.  "
  42.         Msg = Msg & Chr$(13) & Chr$(13)
  43.         Msg = Msg & "Use the Load statement to load a form, "
  44.         Msg = Msg & "use Ctl3D_Start, then unload the form."
  45.         MsgBox Msg, 48, "No Form Loaded"
  46.         Exit Sub
  47.     End If
  48.     Dim inst, ret
  49.     inst = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE)  'Get the Word from Frm
  50.     ret = Ctl3DRegister(inst)       ' Register program w/ Ctl3d.
  51.     ret = Ctl3DAutoSubclass(inst)   ' Subclass the program.
  52.     Ctl3D_Open = True
  53. End Sub
  54.  
  55. Function DoesCtl3DExist ()
  56. ' Call this function to check for the existance of Ctl3Dv2.Dll on the user's system
  57.     Dim Fn As String
  58.     Fn = "Ctl3Dv2.Dll"      'can it be found?
  59.    'Fn = "Ctl3Dv2.Dlx"      'for testing, bad name
  60.     If Not bFileExists(Fn) Then
  61.         DoesCtl3DExist = True
  62.     Else
  63.         DoesCtl3DExist = False
  64.     End If
  65. End Function
  66.  
  67.