by Shadab Azeem Rahil (8 Submissions)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 6th July 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This piece of code that gives your forms a 3-d effect
API Declarations
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&)
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
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
Global Const COLOR_BLACK = &H0&
Global Const COLOR_LIGHT_GRAY = &HC0C0C0
Global Const COLOR_DARK_GRAY = &H808080
Global Const COLOR_WHITE = &HFFFFFF
VBcoders
Dim hSysMenu%, suc%
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)
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)
FormToDialog dlgfrm
DlgSysMenu dlgfrm
End Sub
Sub Activate3D ()
Dim appInst%, suc%
appInst% = GetWindowWord(Me.hWnd, GWW_HINSTANCE)
suc% = Ctl3dRegister(appInst%)
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
suc% = Ctl3dAutoSubclass(appInst%)
End Sub
Sub DeActivate3D ()
Dim appInst%, suc%
appInst% = GetWindowWord(Me.hWnd, GWW_HINSTANCE)
suc% = Ctl3dUnregister(appInst%)
End Sub
Sub Form_Load ()
Activate3D
End Sub
Sub Form_Unload (Cancel As Integer)
DeActivate3D
End
End Sub
Sub Form_Load ()
Make3DDlg Me
End Sub