• Home
 · 
• Graphics
 · 
• This piece of code that gives your forms a 3-d effect

This piece of code that gives your forms a 3-d effect

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





Rate This piece of code that gives your forms a 3-d effect

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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