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 Note: This has only been tested with VB 3 & VB 4-16, if you convert this for use with other versions please let me know.-Burt Abreu 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: |