Skins (52K)
VB5 NeoCaption Demonstration (114K)
VB5 NeoCaption DLL (74K)
VB5 NeoCaption Full Source (239K)
VB6 NeoCaption Demonstration (127K)
VB6 NeoCaption DLL (74K)
VB6 NeoCaption Full Source (253K)
Bugs: 3 / 3
Issues: 1 / 1
Questions: 0 / 0
21 Feb 2002
Release of Version 2.0.
Fixes for support of different sized skinning parts.
New cSkinConfiguration object for setting up the skin, which includes XML serialization and deserialization
Colour customisation using HLS and RGB added.
Transparent colour now added.
Three new skins included.
Subclassing Without The Crashes
vbAccelerator - Contents of code file: frmCustomCaption.frm
VERSION 5.00
Begin VB.Form frmCustomCaption
BackColor = &H00000000&
Caption = ">> N e o C a p t i o n"
ClientHeight = 5715
ClientLeft = 3090
ClientTop = 3675
ClientWidth = 6900
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmCustomCaption.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5715
ScaleWidth = 6900
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 780
Index = 9
Left = 2520
Picture = "frmCustomCaption.frx":1272
ScaleHeight = 780
ScaleWidth = 2730
TabIndex = 10
TabStop = 0 'False
Top = 4320
Visible = 0 'False
Width = 2730
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Index = 8
Left = 120
Picture = "frmCustomCaption.frx":8204
ScaleHeight = 600
ScaleWidth = 7500
TabIndex = 9
TabStop = 0 'False
Top = 4380
Visible = 0 'False
Width = 7500
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 660
Index = 7
Left = 3060
Picture = "frmCustomCaption.frx":16CA6
ScaleHeight = 660
ScaleWidth = 2310
TabIndex = 8
TabStop = 0 'False
Top = 1140
Visible = 0 'False
Width = 2310
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 570
Index = 6
Left = 0
Picture = "frmCustomCaption.frx":1BCA8
ScaleHeight = 570
ScaleWidth = 3030
TabIndex = 7
TabStop = 0 'False
Top = 1140
Visible = 0 'False
Width = 3030
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Index = 5
Left = 0
Picture = "frmCustomCaption.frx":2172A
ScaleHeight = 600
ScaleWidth = 2100
TabIndex = 6
TabStop = 0 'False
Top = 420
Visible = 0 'False
Width = 2100
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Index = 4
Left = 0
Picture = "frmCustomCaption.frx":2590C
ScaleHeight = 420
ScaleWidth = 6135
TabIndex = 5
TabStop = 0 'False
Top = 0
Visible = 0 'False
Width = 6135
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 720
Index = 2
Left = 120
Picture = "frmCustomCaption.frx":2DF9E
ScaleHeight = 720
ScaleWidth = 9180
TabIndex = 4
TabStop = 0 'False
Top = 3180
Visible = 0 'False
Width = 9180
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 150
Index = 3
Left = 540
Picture = "frmCustomCaption.frx":2F83E
ScaleHeight = 150
ScaleWidth = 1050
TabIndex = 3
TabStop = 0 'False
Top = 3960
Visible = 0 'False
Width = 1050
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 150
Index = 1
Left = 540
Picture = "frmCustomCaption.frx":2FC80
ScaleHeight = 150
ScaleWidth = 1050
TabIndex = 2
TabStop = 0 'False
Top = 2940
Visible = 0 'False
Width = 1050
End
Begin VB.PictureBox picResource
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 720
Index = 0
Left = 60
Picture = "frmCustomCaption.frx":301DC
ScaleHeight = 720
ScaleWidth = 9600
TabIndex = 1
TabStop = 0 'False
Top = 2160
Visible = 0 'False
Width = 9600
End
Begin VB.TextBox txtDemo
BackColor = &H00000000&
BorderStyle = 0 'None
BeginProperty Font
Name = "Lucida Console"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000C000&
Height = 5235
Left = 120
MultiLine = -1 'True
TabIndex = 0
Text = "frmCustomCaption.frx":31E05
Top = 120
Width = 6675
End
Begin VB.Menu mnuFileTOP
Caption = "&File"
Begin VB.Menu mnuFile
Caption = "&New"
Index = 0
Shortcut = ^N
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 1
End
Begin VB.Menu mnuFile
Caption = "&Open..."
Index = 2
Shortcut = ^O
End
Begin VB.Menu mnuFile
Caption = "&Save"
Index = 3
Shortcut = ^S
End
Begin VB.Menu mnuFile
Caption = "Save &As..."
Enabled = 0 'False
Index = 4
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 5
End
Begin VB.Menu mnuFile
Caption = "&Print"
Index = 6
Shortcut = ^P
End
Begin VB.Menu mnuFile
Caption = "Print Pre&view"
Index = 7
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 8
End
Begin VB.Menu mnuFile
Caption = "P&roperties"
Index = 9
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 10
End
Begin VB.Menu mnuFile
Caption = ""
Index = 12
Visible = 0 'False
End
Begin VB.Menu mnuFile
Caption = ""
Index = 13
Visible = 0 'False
End
Begin VB.Menu mnuFile
Caption = ""
Index = 14
Visible = 0 'False
End
Begin VB.Menu mnuFile
Caption = ""
Index = 15
Visible = 0 'False
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 16
Visible = 0 'False
End
Begin VB.Menu mnuFile
Caption = "E&xit"
Index = 17
End
End
Begin VB.Menu mnuViewTOP
Caption = "&Skin"
Begin VB.Menu mnuView
Caption = "&None"
Index = 0
End
Begin VB.Menu mnuView
Caption = "-"
Index = 1
End
Begin VB.Menu mnuView
Caption = "&Dark Metal "
Checked = -1 'True
Index = 2
End
Begin VB.Menu mnuView
Caption = "&Neo-vbAccelerator"
Index = 3
End
Begin VB.Menu mnuView
Caption = "&Metro"
Index = 4
End
Begin VB.Menu mnuView
Caption = "&Xcursion"
Index = 5
End
Begin VB.Menu mnuView
Caption = "&Blue Media"
Index = 6
End
Begin VB.Menu mnuView
Caption = "-"
Index = 7
End
Begin VB.Menu mnuView
Caption = "&Customise..."
Index = 8
End
End
Begin VB.Menu mnuHelpTOP
Caption = "&Help"
Begin VB.Menu mnuHelp
Caption = "&vbAccelerator on the Web..."
Index = 0
Shortcut = {F1}
End
Begin VB.Menu mnuHelp
Caption = "-"
Index = 1
End
Begin VB.Menu mnuHelp
Caption = "&Links"
Index = 2
Begin VB.Menu mnuLinks
Caption = "&1) Link 1"
Enabled = 0 'False
Index = 0
End
Begin VB.Menu mnuLinks
Caption = "&2) Link 2"
Enabled = 0 'False
Index = 1
End
Begin VB.Menu mnuLinks
Caption = "&3) Link 3"
Enabled = 0 'False
Index = 2
End
Begin VB.Menu mnuLinks
Caption = "&4) Link 4"
Enabled = 0 'False
Index = 3
End
End
Begin VB.Menu mnuHelp
Caption = "-"
Index = 3
End
Begin VB.Menu mnuHelp
Caption = "&About..."
Index = 4
End
End
End
Attribute VB_Name = "frmCustomCaption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_cN As cNeoCaption
Private m_cSkin As cSkinConfiguration
Private m_iIndex As Long
Private Sub setColors()
If (m_cSkin Is Nothing) Then
Me.BackColor = vbButtonFace
txtDemo.BackColor = vbWindowBackground
txtDemo.ForeColor = vbWindowText
Else
Me.BackColor = m_cN.MenuBackgroundColor
txtDemo.BackColor = m_cN.MenuBackgroundColor
txtDemo.ForeColor = m_cN.ActiveMenuColorOver
End If
End Sub
Private Function ReadFileText(ByVal sFile As String, ByRef sText As String) As
Boolean
On Error GoTo ErrorHandler
Dim iFile As Integer
iFile = FreeFile
Open sFile For Binary Access Read Lock Write As #iFile
sText = Space$(LOF(iFile))
Get #iFile, , sText
Close #iFile
ReadFileText = True
Exit Function
ErrorHandler:
' suppress error in this example.
End Function
Public Sub TestStore()
Dim i As Long
Dim sXml As String
For i = 2 To 6
SelectNewSkin i
sXml = m_cSkin.Store()
Debug.Print sXml
Next i
End Sub
Public Sub TestRestore()
Dim sXmlFile As String
Dim sXml As String
sXmlFile = App.Path & "/home/VB/Code/Controls/Skins/SkinsDark_Metalskin.xml"
If ReadFileText(sXmlFile, sXml) Then
m_cSkin.Restore sXml, picResource(2).Picture, picResource(3).Picture
m_cN.Attach2 Me, m_cSkin
Else
MsgBox "Couldn't load " & sXmlFile, vbInformation
End If
End Sub
Private Sub Form_Load()
Dim sText As String
Set m_cN = New cNeoCaption
mnuView_Click 2
If ReadFileText(App.Path & "/home/VB/Code/Controls/Skins/MGSim.txt", sText) Then
txtDemo.Text = sText
txtDemo.SelStart = Len(sText)
Me.Show
txtDemo.SetFocus
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
txtDemo.Move 0, 0, Me.ScaleWidth - Screen.TwipsPerPixelX, Me.ScaleHeight -
Screen.TwipsPerPixelY
End Sub
Private Sub mnuFile_Click(Index As Integer)
Select Case Index
Case 0
' New
Dim f As New frmCustomCaption
f.Show
Case 2
MsgBox "Open: Todo", vbInformation
Case 3
MsgBox "Save: Todo", vbInformation
Case 4
MsgBox "SaveAs: Todo", vbInformation
Case 6
MsgBox "Print: Todo", vbInformation
Case 7
MsgBox "PrintPreview: Todo", vbInformation
Case 9
MsgBox "Properties: Todo", vbInformation
Case 17
Unload Me
End Select
End Sub
Private Sub mnuHelp_Click(Index As Integer)
Select Case Index
Case 0
'.
Case 2
'.
Case 4
Dim f As New frmAbout
f.Owner = Me
f.Show vbModal, Me
End Select
End Sub
Private Sub mnuView_Click(Index As Integer)
Dim i As Long
For i = 0 To 6
If (i <> 1) Then
mnuView(i).Checked = (Index = i)
End If
Next i
' can't customise the default
mnuView(8).Enabled = Not (mnuView(0).Checked)
Select Case Index
Case 0
m_cN.Detach
Set m_cSkin = Nothing
setColors
Form_Resize
Case 2 To 6
SelectNewSkin Index
m_cN.Attach2 Me, m_cSkin
setColors
If Index = 5 Then
txtDemo.BackColor = RGB(140, 139, 139)
End If
Form_Resize
Case 8
CustomiseSkin
End Select
End Sub
Public Sub SelectNewSkin(ByVal iIndex As Long)
Dim sFont As New StdFont
Set m_cSkin = New cSkinConfiguration
With m_cSkin
Select Case iIndex
Case 2
.Name = "Dark Metal"
.ActiveCaptionColor = &HFFFFFF
.InActiveCaptionColor = &H999999
.ActiveMenuColor = RGB(57, 183, 103)
.ActiveMenuColorOver = RGB(138, 219, 167)
.InActiveMenuColor = &H999999
.MenuBackgroundColor = &H0&
Set .CaptionFont = Me.Font
Set .MenuFont = Me.Font
Set .Caption = picResource(2).Picture
Set .Borders = picResource(3).Picture
.ButtonWidth = 13
.ButtonHeight = 14
.ActiveLeftEnd = 90
.ActiveRightStart = 142
.ActiveRightEnd = 240
.InactiveOffset = 372
Case 3
.Name = "Neo vbAccelerator"
.ActiveCaptionColor = &HFFFFFF
.InActiveCaptionColor = RGB(47, 122, 151)
.ActiveMenuColor = &H0&
.ActiveMenuColorOver = &HFFFFFF
.InActiveMenuColor = RGB(47, 122, 151)
.MenuBackgroundColor = RGB(123, 189, 214)
Set .CaptionFont = Me.Font
Set .MenuFont = Me.Font
Set .Caption = picResource(0).Picture
Set .Borders = picResource(1).Picture
.ButtonWidth = 19
.ButtonHeight = 20
.ActiveLeftEnd = 90
.ActiveRightStart = 140
.ActiveRightEnd = 240
.InactiveOffset = 400
Case 4
.Name = "Metro"
sFont.Name = "Tahoma"
sFont.Size = 7
.ActiveCaptionColor = &HFFFFFF
.InActiveCaptionColor = &HCCCCCC
Set .CaptionFont = sFont
.ActiveMenuColor = &H666666
.ActiveMenuColorOver = &H0
.InActiveMenuColor = &H333333
.MenuBackgroundColor = &HFFFFFF
Set .MenuFont = sFont
Set .Caption = picResource(4).Picture
Set .Borders = picResource(5).Picture
.BorderHasInactiveVersion = True
.ButtonHeight = 13
.ButtonWidth = 14
.ActiveLeftEnd = 68
.ActiveRightStart = 81
.ActiveRightEnd = 143
.InactiveOffset = 210
.LeftBorderWidth = 8
.RightBorderWidth = 8
.ControlButtonHasInactiveVersion = True
.CustomControlButtonPosition = True
.ControlButtonOffsetX = -6
.ControlButtonOffsetY = 6
.TitleStartOffsetY = 3
.BottomSizingBorderHeight = 2
.TopSizingBorderHeight = 2
.MenuStartOffsetY = 0
.DrawTitle = False
Case 5
.Name = "Xcursion"
sFont.Name = "Tahoma"
sFont.Size = 7
.ActiveCaptionColor = &H666666
.InActiveCaptionColor = &H999999
.ActiveMenuColor = &H0&
.ActiveMenuColorOver = &H336666
.InActiveMenuColor = &H0&
.MenuBackgroundColor = &HFFFFFF
Set .CaptionFont = sFont
Set .MenuFont = sFont
Set .Caption = picResource(6).Picture
Set .Borders = picResource(7).Picture
.BorderHasInactiveVersion = True
.ButtonHeight = 8
.ButtonWidth = 9
.ActiveLeftEnd = 13
.ActiveRightStart = 30
.ActiveRightEnd = 65
.InactiveOffset = 101
.LeftBorderWidth = 8
.RightBorderWidth = 8
.ControlButtonHasInactiveVersion = True
.CustomControlButtonPosition = True
.ControlButtonOffsetX = -14
.ControlButtonOffsetY = 7
.TitleStartOffsetY = 3
.BottomSizingBorderHeight = 2
.TopSizingBorderHeight = 2
.MenuStartOffsetY = 18
.TransparentColor = RGB(140, 139, 139)
Case 6
.Name = "Blue Media"
sFont.Name = "Tahoma"
sFont.Size = 8
.ActiveCaptionColor = &H666666
.InActiveCaptionColor = &H999999
.ActiveMenuColor = RGB(136, 178, 255)
.ActiveMenuColorOver = &HFFFFFF
.InActiveMenuColor = RGB(136, 178, 255)
.MenuBackgroundColor = RGB(33, 59, 122)
Set .CaptionFont = sFont
Set .MenuFont = sFont
Set .Caption = picResource(8).Picture
Set .Borders = picResource(9).Picture
.BorderHasInactiveVersion = True
.ButtonHeight = 14
.ButtonWidth = 11
.ActiveLeftEnd = 39
.ActiveRightStart = 96
.ActiveRightEnd = 180
.InactiveOffset = 250
.LeftBorderWidth = 8
.RightBorderWidth = 8
.ControlButtonHasInactiveVersion = True
.CustomControlButtonPosition = True
.ControlButtonOffsetX = -10
.ControlButtonOffsetY = 3
.TitleStartOffsetY = 3
.BottomSizingBorderHeight = 2
.TopSizingBorderHeight = 2
.MenuStartOffsetY = 17
.MenuStartOffsetX = 30
.TransparentColor = RGB(0, 78, 152)
End Select
End With
End Sub
Private Sub CustomiseSkin()
Dim f As New frmCustomiseSkin
f.Owner = Me
Dim i As Long
Dim sName As String
For i = 2 To 6
If (mnuView(i).Checked) Then
sName = mnuView(i).Caption
Exit For
End If
Next i
f.Show vbModal, Me
If Not (f.Cancelled) Then
Set m_cSkin = f.SkinConfiguration
m_cN.Attach2 Me, m_cSkin
setColors
End If
End Sub
Public Property Get SkinConfiguration() As cSkinConfiguration
Set SkinConfiguration = m_cSkin
End Property