Visual Basic > Control Special Effects sample source codes

Visual Basic Code > How to get 3D Forms, MsgBoxes & CMDialogs using the CTL3D.DLL.

How to get 3D Forms, MsgBoxes & CMDialogs using the CTL3D.DLL.

'Note: This has only been tested with VB 3 & VB 4-16, if you convert

' The following code gives Forms, with Borderstyle = Fixed Double,
' that nice 3D appearance. Also included, is automatic subclassing
' for MsgBoxes, InPutBoxes and CMDialogs to give them the 3D look.

' ** Important Note:
' Although fully functional, using this code can cause AE's or GPF's
' if the program goes down prematurely due any other error.
' Best case scenario, program crashes. Worst case - Windows crashes!
' It is therefore, recommended that you only add this code to your app
' when it is near completion and is bug-free. ;)

' In a .BAS module at the following Constants, API's and  3 routines:
' Already declared in C:\VB\CTL3D.BAS

' Module Code:

Option Explicit

' CTL3D API calls
' All APIs on one single line.
Declare Function Ctl3dAutoSubclass% Lib "Ctl3D.DLL" (ByVal hInst%)
Declare Function Ctl3dRegister% Lib "Ctl3D.DLL" (ByVal hInst%)
Declare Function Ctl3dUnregister% Lib "Ctl3D.DLL" (ByVal hInst%)
Declare Function Ctl3dSubclassDlgEx% Lib "Ctl3D.DLL" (ByVal hWnd%, ByVal dFlags&)

' Other API Calls for the Forms.

Declare Function GetWindowLong& Lib "User" (ByVal hWnd%, ByVal nIndex%)
Declare Function GetWindowWord% Lib "User" (ByVal hWnd%, ByVal nIndex%)
Declare Function SetWindowLong& Lib "User" (ByVal hWnd%, ByVal nIndex%, 
ByVal dwNewLong&)

Global Const FIXED_DOUBLE = 3
Global Const DS_MODALFRAME = &H80&
Global Const GWL_STYLE = (-16)
Global Const GWW_HINSTANCE = (-6)
Global Const CTL3D_ALL = &HFFFF

' Menu APIs for adjusting the 3D Dialog box system menu
' All APIs on one single line.
Declare Function GetSystemMenu% Lib "User" (ByVal hWnd%, ByVal bRevert%)
Declare Function RemoveMenu% Lib "User" (ByVal hMenu%, ByVal nPosition%, 
ByVal wFlags%)

Global Const MF_BYPOSITION = &H400

' Colors
Global Const COLOR_BLACK = &H0&
Global Const COLOR_LIGHT_GRAY = &HC0C0C0
Global Const COLOR_DARK_GRAY = &H808080
Global Const COLOR_WHITE = &HFFFFFF

Sub DlgSysMenu (fm As Form)
'This procedure modifies the menu for the dialog box.
'The form musthave the MinButton and MaxButton set
'to false if you leave the ControlBox property set to true. 
'Otherwise, Restore, Maximize, and Minimize will stay on...

Dim hSysMenu%, suc%

' Obtain the handle to the forms System menu
   hSysMenu% = GetSystemMenu(fm.hWnd, False)

' Remove all but the MOVE and CLOSE options.
' The menu items must be removed starting with
' the last menu item.
  suc% = RemoveMenu(hSysMenu, 8, MF_BYPOSITION) 'Switch to
  suc% = RemoveMenu(hSysMenu, 7, MF_BYPOSITION) 'Separator
  suc% = RemoveMenu(hSysMenu, 5, MF_BYPOSITION) 'Separator
End Sub


Sub FormToDialog (frm As Form)
'This procedure makes the dialog box (Form) appear 3D.

    Dim hWnd As Integer
    Dim iResult As Integer
    Dim lStyle As Long

    hWnd = frm.hWnd
    If frm.BorderStyle = FIXED_DOUBLE Then
        frm.BackColor = COLOR_LIGHT_GRAY
        lStyle = GetWindowLong(hWnd, GWL_STYLE)
        lStyle = lStyle Or DS_MODALFRAME
        lStyle = SetWindowLong(hWnd, GWL_STYLE, lStyle)
        iResult = Ctl3dSubclassDlgEx(hWnd, &H0)
    End If

End Sub


Sub Make3DDlg (dlgfrm As Form)
'Call this procedure in a form's Form_Load event to
'register the form as a 3D Dialog. This procedure calls
'the appropriate subprocedures in making the Dialog 3D

'Set the dlg forms attributes for CTL3D.
   FormToDialog dlgfrm

'Now make the system menu for the form to
'show only Move and Close.
   DlgSysMenu dlgfrm

End Sub

' Form Code:

' Enter the following code in the Form that be the last one
' to get unloaded. In the main program form for example.

' ** Another Important Note:
' When running in the design environment, be sure to end
' the app by using the Control Box - Close menu item or
' a command that calls the Form_Unload event for the form
' containing this code...
' ** Do Not End The App With VB's 'End' Command! **
' ** This Will Cause An AE or GPF!! **

' Add these 2 routines to the form:

Sub Activate3D ()
  ' This procedure registers your application to CTL3D.
   Dim appInst%, suc%
  ' Get the application instance...
   appInst% = GetWindowWord(Me.hWnd, GWW_HINSTANCE)
  ' Now register the application
   suc% = Ctl3dRegister(appInst%)
  ' Did it register?
   If suc% = 0 Then
       MsgBox "The file CTL3D.DLL has not been found. Please insure that this 
file is installed in your Windows\System directory.", 16, APPNAME
       Exit Sub
   End If
  ' Now subclass all of the dialog and message boxes for 3D

   suc% = Ctl3dAutoSubclass(appInst%)
End Sub

Sub DeActivate3D ()
    'Unregister CTL3D.
    Dim appInst%, suc%
    'Get the application instance again
    appInst% = GetWindowWord(Me.hWnd, GWW_HINSTANCE)
    'Unregister Ctl3d
    suc% = Ctl3dUnregister(appInst%)
End Sub


Sub Form_Load ()

'Local Sub to register CTL3D
Activate3D

End Sub


Sub Form_Unload (Cancel As Integer)

'Local Sub to unregister CTL3D
DeActivate3D

End

End Sub

' Now, set the BorderStyle property to 3 - Fixed Double for
' the Form you wish to make 3D and a this code to that
' form's Form_Load event:

Sub Form_Load ()
' Register the form as a 3D Dialog.
Make3DDlg Me

End Sub