by T-REX Software (14 Submissions)
Category: Windows API Call/Explanation
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Originally Published: Wed 24th March 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Ever wanted to use CTL3D.DLL in your Visual Basic applications, well now it's possible !
VBcoders
Option Explicit
'CTL3D API calls... If you don't have CTL3DV2.DLL, you can delete the V2 and it should
'still work properly.
Declare Function Ctl3dAutoSubclass Lib "Ctl3DV2.DLL" (ByVal hInst As Integer) As Integer
Declare Function Ctl3dRegister Lib "Ctl3DV2.DLL" (ByVal hInst As Integer) As Integer
Declare Function Ctl3dUnregister Lib "Ctl3DV2.DLL" (ByVal hInst As Integer) As Integer
Declare Function Ctl3dSubclassDlgEx Lib "Ctl3DV2.DLL" (ByVal hWnd As Integer, ByVal dFlags As Long) As Integer
Declare Function Ctl3dSubclassCtlEx Lib "Ctl3DV2.DLL" (ByVal hWnd As Integer, ByVal cFlags As Integer) As Integer
Declare Function Ctl3dUnsubclassCtl Lib "Ctl3DV2.DLL" (ByVal hWnd As Integer) As Integer
Declare Function Ctl3DGetVer Lib "Ctl3DV2.DLL" () As Integer
'Other API Calls for the Forms...
Declare Function GetModuleHandle Lib "Kernel" (ByVal ModuleName As String) As Integer
Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Long
Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
Declare Function SetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long
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 API's for adjusting the 3D Dialog box system menu...
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
'Some colors for us to use...
Global Const COLOR_BLACK = &H0&
Global Const COLOR_LIGHT_GRAY = &HC0C0C0
Global Const COLOR_DARK_GRAY = &H808080
Global Const COLOR_WHITE = &HFFFFFF
'/* Ctl3d Control ID */
Global Const CTL3D_BUTTON_CTL = 0
Global Const CTL3D_LISTBOX_CTL = 1
Global Const CTL3D_EDIT_CTL = 2
Global Const CTL3D_COMBO_CTL = 3
Global Const CTL3D_STATIC_CTL = 4
'Global Variables to allow for SubClassing Ctrls in our form...
Global gSubClassCtls As Integer
Global gCTL3DMajorVersion As Integer
Global gCTL3DMinorVersion As Integer
'This procedure does a couple of things.
'First, it will attempt to register your application to the CTL3D Program.
'Second, it will attempt to tell you if the system can register 3D Controls
'Only CTL3D Version 2.63 or greater can be used to make VB controls appear 3D
'
'
Function App3DRegister() As Integer
Dim appInst%, suc%
'Really just needed if we can get the CTL3D or CTL3DV2 dll's
On Error GoTo AppRegError
'Do version checking. This will also let us know if we can't get the dll's
suc% = Ctl3DGetVer()
'If we get a version number then pass check it for control subclass capability
If suc% > 0 Then
gCTL3DMajorVersion = (suc% And 65100) \ (2 ^ 8)
gCTL3DMinorVersion = suc% And 255
If (gCTL3DMajorVersion > 1) And (gCTL3DMinorVersion > 12) Then gSubClassCtls = True
End If
'Get the application instance...
appInst% = GetModuleHandle(App.EXEName)
'Now register the application
suc% = Ctl3dRegister(appInst%)
'Did it register?
If suc% = 0 Then Exit Function
'Now subclass all of the dialog and message boxes for 3D, should work with VB
suc% = Ctl3dAutoSubclass(appInst%)
'We had not problems so tell the app we registered with CTL3D
App3DRegister = True
'In case an error occurred
AppRegError:
End Function
'Before you exit your application, give this procedure a call..
'In this case, I have a procedure called ExitProgram() that allows
'me to do all of my cleanup functions. This procedure is in there.
'
Sub App3DUnregister()
'Call this just before your application exits..
Dim appInst%, suc%
'Get the application instance again..
appInst% = GetModuleHandle(App.EXEName)
'Now unregister us...
suc% = Ctl3dUnregister(appInst%)
End Sub
'
' ControlIn3D paints a 3D-border around the control given in ctrlTarget.
' nBevel controls the the deepness, nSpace the distance between the control
' and the 3D-border and bInset sets the border to be drawn inset or outset.
'
' Parts of this code are taken from the VB Tips & Tricks help file.
' Original code written by Matej Nastran.
'
'
Sub ComboBoxIn3D(ctrlCombo As Control, nBevel As Integer)
Dim PixelX As Integer, PixelY As Integer
Dim CTop As Integer, CRight As Integer, CBottom As Integer
' Just put "No 3D" in the Tag property and your ComboBox keeps 2D
If InStr(UCase(ctrlCombo.Tag), "NO 3D") = 0 Then
ControlIn3D ctrlCombo, nBevel, 0, True
If ctrlCombo.Style = 0 Then 'Remove white space only
PixelX = Screen.TwipsPerPixelX 'if it is a Dropdown ComboBox
PixelY = Screen.TwipsPerPixelY
CTop = ctrlCombo.Top
CRight = ctrlCombo.Left + ctrlCombo.Width
CBottom = ctrlCombo.Top + ctrlCombo.Height
ctrlCombo.Parent.Line (CRight - PixelX * 24, CTop)-(CRight - PixelX * 18, CBottom - PixelY), COLOR_LIGHT_GRAY, BF
End If
End If
End Sub
'
'
' ControlIn3D paints a 3D-border around the control given in ctrlTarget.
' nBevel controls the the deepness, nSpace the distance between the control
' and the 3D-border and bInset sets the border to be drawn inset or outset.
'
' Parts of this code are taken from the VB Tips & Tricks help file.
' Original code written by Matej Nastran.
'
Sub ControlIn3D(ctrlTarget As Control, nBevel As Integer, nSpace As Integer, bInset As Integer)
Dim CTop As Integer, CLeft As Integer, CRight As Integer, CBottom As Integer
Dim PixelX As Integer, PixelY As Integer, AddX As Integer, AddY As Integer
Dim i As Integer
' Just put "No 3D" in the Tag property and your control keeps 2D
If InStr(UCase(ctrlTarget.Tag), "NO 3D") = 0 Then
PixelX = Screen.TwipsPerPixelX
PixelY = Screen.TwipsPerPixelY
CTop = ctrlTarget.Top - PixelY
CLeft = ctrlTarget.Left - PixelX
CRight = ctrlTarget.Left + ctrlTarget.Width
CBottom = ctrlTarget.Top + ctrlTarget.Height
If bInset Then ' Draw border inset
For i = nSpace To (nBevel + nSpace - 1)
AddX = i * PixelX: AddY = i * PixelY
ctrlTarget.Parent.Line (CLeft - AddX, CTop - AddY)-(CRight + AddX, CTop - AddY), COLOR_DARK_GRAY
ctrlTarget.Parent.Line (CLeft - AddX, CTop - AddY)-(CLeft - AddX, CBottom + AddY), COLOR_DARK_GRAY
ctrlTarget.Parent.Line (CLeft - AddX, CBottom + AddY)-(CRight + AddX + PixelX, CBottom + AddY), COLOR_WHITE
ctrlTarget.Parent.Line (CRight + AddX, CTop - AddY)-(CRight + AddX, CBottom + AddY), COLOR_WHITE
Next i
Else ' Draw border outset
For i = nSpace To (nBevel + nSpace - 1)
AddX = i * PixelX: AddY = i * PixelY
ctrlTarget.Parent.Line (CRight + AddX, CBottom + AddY)-(CRight + AddX, CTop - AddY), COLOR_DARK_GRAY
ctrlTarget.Parent.Line (CRight + AddX, CBottom + AddY)-(CLeft - AddX, CBottom + AddY), COLOR_DARK_GRAY
ctrlTarget.Parent.Line (CRight + AddX, CTop - AddY)-(CLeft - AddX - PixelX, CTop - AddY), COLOR_WHITE
ctrlTarget.Parent.Line (CLeft - AddX, CBottom + AddY)-(CLeft - AddX, CTop - AddY), COLOR_WHITE
Next i
End If
End If
End Sub
'This procedure modifies the menu for the dialog box.
'In order for this to work correctly, the form must have the MinButton and MaxButton set
'to false if you leave the ControlBox property set to true. Otherwise, Restore, Maximize, and
'Minimize will stay on...
'
Sub DlgSysMenu(fm As Form)
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
'
' FormIn3D paints a 3D-border around controls on the given Form frmTarget.
' nBevel controls the the deepness of the 3D-border.
'
' Controls that are affected:
' TextBox ListBox ComboBox
' DriveListBox DirListBox FileListBox
' Line
' ... (list can be easly expanded)
'
' Just put "No 3D" in the Tag property of a specific control or the form
' itself and it is not painted in 3D.
'
' Call this function from your forms Paint-event.
'
' Parts of this code are taken from the VB Tips & Tricks help file.
' Original code written by Matej Nastran.
'
' Modifications from original source: bBlaster was removed because it wasn't
' necessary for this file.
'
Sub FormIn3D(frmTarget As Form, nBevel As Integer)
Dim DrawWidthOld As Integer, ScaleModeOld As Integer
Dim i As Integer, Ret As Integer
Dim ctrlTarget As Control
Static bBusy As Integer
If bBusy Then Exit Sub 'Got some DoEvents. Just in case...
bBusy = True
DrawWidthOld = frmTarget.DrawWidth
frmTarget.DrawWidth = 1
ScaleModeOld = frmTarget.ScaleMode
frmTarget.ScaleMode = 1 'Twips
DoEvents
'Loop controls
For i = 0 To (frmTarget.Controls.Count - 1)
Set ctrlTarget = frmTarget.Controls(i)
If TypeOf ctrlTarget Is TextBox Then ControlIn3D ctrlTarget, nBevel, 0, True
If TypeOf ctrlTarget Is ListBox Then ControlIn3D ctrlTarget, nBevel, 0, True
If TypeOf ctrlTarget Is ComboBox Then 'ComboBoxes are special
ComboBoxIn3D ctrlTarget, nBevel
End If
If TypeOf ctrlTarget Is DriveListBox Then ControlIn3D ctrlTarget, nBevel, 0, True
If TypeOf ctrlTarget Is DirListBox Then ControlIn3D ctrlTarget, nBevel, 0, True
If TypeOf ctrlTarget Is FileListBox Then ControlIn3D ctrlTarget, nBevel, 0, True
If TypeOf ctrlTarget Is Line Then 'Lines are also special
LineIn3D ctrlTarget
End If
If TypeOf ctrlTarget Is Label Then ControlIn3D ctrlTarget, nBevel, 0, True
Next i
frmTarget.DrawWidth = DrawWidthOld 'Always restore what you change
frmTarget.ScaleMode = ScaleModeOld
bBusy = False
End Sub
'This procedure makes my dialog box appear 3D.
'
'This snippet of code was taken by a submission from
'RANDRIAMBOLOLONA Roland H. - Compuserve ID - 100331,2516
'
'He says he got some of it from the MARCH '95 VBPJ Code Listing - TIPS.TXT
'
'This procedure was not commented, I am just telling you where I got the source
'for this because it works very well...
'
'This procedure modifies the menu for the dialog box.
' This procedure makes the VB form appear as a dialog box for CTL3D to read
' and paint it...
'
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
'
' LineIn3D paints the given Line-control ctrlLine in 3D.
' frmTarget is the Form containing that Line.
'
' Parts of this code are taken from the VB Tips & Tricks help file.
' Original code written by Matej Nastran.
'
Sub LineIn3D(ctrlLine As Control)
If InStr(UCase(ctrlLine.Tag), "NO 3D") = 0 Then
ctrlLine.BorderColor = COLOR_DARK_GRAY
'Check if line is vertical or horizontal
If Abs(ctrlLine.X2 - ctrlLine.X1) > Abs(ctrlLine.Y2 - ctrlLine.Y1) Then
ctrlLine.Parent.Line (ctrlLine.X1, ctrlLine.Y1 + Screen.TwipsPerPixelY)-(ctrlLine.X2, ctrlLine.Y2 + Screen.TwipsPerPixelY), COLOR_WHITE
Else
ctrlLine.Parent.Line (ctrlLine.X1 + Screen.TwipsPerPixelX, ctrlLine.Y1)-(ctrlLine.X2 + Screen.TwipsPerPixelX, ctrlLine.Y2), COLOR_WHITE
End If
End If
End Sub
'Make3DDlg
'Call this procedure in a forms Form_Load event to register the form
'as a 3D Dialog. This procedure calls the appropriate subprocedures
'in making the Dialog 3D
'
Sub Make3DDlg(dlgfrm As Form)
'Set the dlg forms attributes for CTL3D to paint it..
FormToDialog dlgfrm
'Now make the system menu for the form to show only Move and Close.
'NOTE: You must set the MinButton and MaxButton properties to False.
'The ControlBox property being set to False will have no effect on
'this procedure.
DlgSysMenu dlgfrm
'Turn all of the controls 3D. If you have the wrong version, MakeDlgCtrls will not
'register the controls because the API call isn't there.
'If the CTL3D is too old, then place the following code in each dialogs Form_Paint event
' FormIn3D Me, 1
'
If gSubClassCtls Then MakeDlgCtrls3D dlgfrm
End Sub
' This procedure cycles through the controls in the form and then
' attempts to subclass them for 3D effects. Because the controls in VB
' are all class Thunder, CTL3D can't see them as they are so we force
' it to say "Hey, Paint me 3D!"
'
' You can add other controls to this list as long as they match the
' specification on them.
'
'
'
'
Sub MakeDlgCtrls3D(dlgfrm As Form)
Dim i As Integer
Dim ctrl As Control
If Not gSubClassCtls Then Exit Sub
For i = 0 To (dlgfrm.Controls.Count - 1)
Set ctrl = dlgfrm.Controls(i)
If TypeOf ctrl Is TextBox Then Reg3DCtrl ctrl, CTL3D_EDIT_CTL
If TypeOf ctrl Is ListBox Then Reg3DCtrl ctrl, CTL3D_LISTBOX_CTL
If TypeOf ctrl Is ComboBox Then Reg3DCtrl ctrl, CTL3D_COMBO_CTL
If TypeOf ctrl Is DriveListBox Then Reg3DCtrl ctrl, CTL3D_COMBO_CTL
If TypeOf ctrl Is DirListBox Then Reg3DCtrl ctrl, CTL3D_LISTBOX_CTL
If TypeOf ctrl Is FileListBox Then Reg3DCtrl ctrl, CTL3D_LISTBOX_CTL
If TypeOf ctrl Is CheckBox Then Reg3DCtrl ctrl, CTL3D_BUTTON_CTL
If TypeOf ctrl Is OptionButton Then Reg3DCtrl ctrl, CTL3D_BUTTON_CTL
Next i
dlgfrm.Refresh
End Sub
' Used to register a control for 3D by CTL3D. Does not have to be
' a dialog form to have it painted 3D
'
'
Sub Reg3DCtrl(ctrl As Control, ctrltype As Integer)
Dim suc%
suc% = Ctl3dSubclassCtlEx(ctrl.hWnd, ctrltype)
End Sub
' This unregisters controls from the dialog or whatever form. Use this
' as a cleanup method so as not to corrupt CTL3D or waste resources.
' Called from the Form_Unload procedure
'
Sub Undo3DCtrls(frm As Form)
Dim i As Integer
Dim ctrl As Control
If Not gSubClassCtls Then Exit Sub
For i = 0 To (frm.Controls.Count - 1)
Set ctrl = frm.Controls(i)
If TypeOf ctrl Is TextBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is ListBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is ComboBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is DriveListBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is DirListBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is FileListBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is CheckBox Then UnReg3DCtrl ctrl
If TypeOf ctrl Is OptionButton Then UnReg3DCtrl ctrl
Next i
End Sub
' Call this procedure to unregister your controls
' If you call the Reg3DCtrl procedure, call this one
' in the Form_Unload event for the form.
'
'
Sub UnReg3DCtrl(ctrl As Control)
Dim suc%
suc% = Ctl3dUnsubclassCtl(ctrl.hWnd)
End Sub
No comments have been posted about Ever wanted to use CTL3D.DLL in your Visual Basic applications, well now it's possible !. Why not be the first to post a comment about Ever wanted to use CTL3D.DLL in your Visual Basic applications, well now it's possible !.
