ctltabs.ctl

这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写的,数据库采用MSSQL的.

VERSION 5.00
Begin VB.UserControl ctlTabs 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   ClientHeight    =   2085
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2970
   ControlContainer=   -1  'True
   EditAtDesignTime=   -1  'True
   MouseIcon       =   "ctlTabs.ctx":0000
   PropertyPages   =   "ctlTabs.ctx":0152
   ScaleHeight     =   139
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   198
End
Attribute VB_Name = "ctlTabs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Option Explicit
'----------------------------------------------------------
' Tabs Controller (TabStrip Replacement)
'----------------------------------------------------------
' Author : Nick Gisburne
' Email  : [e-mail]
' Web    : www.gisburne.com / www.karaokebuilder.com
'----------------------------------------------------------
' Purpose:
' Replacement for much of the functionality of the
' standard TabStrip control
'----------------------------------------------------------
' Limitations:
' I didn't set out to create an all-singing all-dancing
' tabs control. This is a simple control which displays
' tabs in a particular way, and is flexible enough for
' many purposes. If you want more, extend it yourself!
'----------------------------------------------------------
' Using the TabStrip supplied by Microsoft, I soon realised
' I wasn't getting much value for the 1-Mb overhead needed
' by the common controls ActiveX.  I also wanted the look
' and feel you see here, which I couldn't find elsewhere.
' I looked at other replacements for TabStrip, but they
' used quite a lot of resources (images, text boxes, etc)
' which all put a drain on Windows. This control just uses
' a totally empty control and draws on it. It's as simple
' as I could make it.
'
' I also added a PropertyPage - I've not used them before
' but it was surprisingly straightforward. Very useful
' for administering the various tabs and their captions.
'
'----------------------------------------------------------
' This control will be used in my commercial software, so
' if I think it's good enough I hope you do too! Enjoy!
'----------------------------------------------------------


'----------------------------------------------------------
' API Functions
'----------------------------------------------------------
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Integer
Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, lpRect As RECT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'----------------------------------------------------------
' API Constants and Types
'----------------------------------------------------------
Const BDR_RAISEDOUTER = &H1
Const BDR_SUNKENOUTER = &H2
Const BDR_RAISEDINNER = &H4
Const BDR_SUNKENINNER = &H8

Const BDR_OUTER = &H3
Const BDR_INNER = &HC
Const BDR_RAISED = &H5
Const BDR_SUNKEN = &HA

Const BF_LEFT = &H1
Const BF_TOP = &H2
Const BF_RIGHT = &H4
Const BF_BOTTOM = &H8
Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

'----------------------------------------------------------
' Enums for control properties
'----------------------------------------------------------
Public Enum ctlTabs_TabStyles
    [Top Left] = 0
    [Top Right] = 1
    [Bottom Left] = 2
    [Bottom Right] = 3
    [Left Top] = 4
    [Right Top] = 5
    [Left Bottom] = 6
    [Right Bottom] = 7
End Enum

Public Enum ctlTabs_CaptionStyle
    [cTop Left] = 0
    [cTop Center] = 1
    [cTop Right] = 2
    [cMiddle Left] = 3
    [cMiddle Center] = 4
    [cMiddle Right] = 5
    [cBottom Left] = 6
    [cBottom Center] = 7
    [cBottom Right] = 8
End Enum

'----------------------------------------------------------
' Variables used to store the control's properties
'----------------------------------------------------------
Dim propTabWide As Long
Dim propTabHigh As Long
Dim propTabSelected As Integer
Dim propTabCount As Integer
Dim propStyle As Integer
Dim propCaptionStyle As Integer
Dim propFocusRect As Boolean
Dim propCaption() As String
Dim propTabFont As StdFont
Dim propTabFontActive As StdFont
Dim propTabColor As OLE_COLOR
Dim propTabColorActive As OLE_COLOR
Dim propTextColor As OLE_COLOR
Dim propTextColorActive As OLE_COLOR

'----------------------------------------------------------
' Variables used for other purposes
'----------------------------------------------------------
Dim hasFocus As Boolean
Dim ClickZone() As RECT

'----------------------------------------------------------
' Event Declaration
'----------------------------------------------------------
Public Event TabClick(OldTab As Integer, NewTab As Integer)
Attribute TabClick.VB_Description = "Event raised when the user clicks on a tab"


'----------------------------------------------------------
' Properties Code (Get/Let/Set functions)
'----------------------------------------------------------

'----------------------------------------------------------
' ScaleMode / hDC
' Not really necessary but I had use for them
'----------------------------------------------------------
Public Property Get ScaleMode() As Long
Attribute ScaleMode.VB_Description = "ScaleMode always returns 1 (Twips) on this control"
    ScaleMode = vbTwips     'Force to twips (it's actually set to pixels)
End Property

Public Property Get hDC() As Long
    hDC = UserControl.hDC
End Property


'----------------------------------------------------------
' TextColor / TextColorActive
' Color of text on the Inactive/Active tabs
'----------------------------------------------------------
Public Property Get TextColor() As OLE_COLOR
Attribute TextColor.VB_Description = "Returns/sets the text color of all inactive tabs"
    TextColor = propTextColor
End Property

Public Property Let TextColor(ByVal newVal As OLE_COLOR)
    propTextColor = newVal
    PropertyChanged "TEXTCOLOR"
    DrawTabs
End Property

Public Property Get TextColorActive() As OLE_COLOR
Attribute TextColorActive.VB_Description = "Returns/sets the text color of the active tab"
    TextColorActive = propTextColorActive
End Property

Public Property Let TextColorActive(ByVal newVal As OLE_COLOR)
    propTextColorActive = newVal
    PropertyChanged "TEXTCOLORACTIVE"
    DrawTabs
End Property


'----------------------------------------------------------
' TabColor / TabColorActive
' Background Color of the Inactive/Active tabs
'----------------------------------------------------------
Public Property Get TabColor() As OLE_COLOR
Attribute TabColor.VB_Description = "Returns/sets the background color of all inactive tabs"
    TabColor = propTabColor
End Property

Public Property Let TabColor(ByVal newVal As OLE_COLOR)
    propTabColor = newVal
    PropertyChanged "TABCOLOR"
    DrawTabs
End Property

Public Property Get TabColorActive() As OLE_COLOR
Attribute TabColorActive.VB_Description = "Returns/sets the background color of the active tab and the container area of the control"
    TabColorActive = propTabColorActive
End Property

Public Property Let TabColorActive(ByVal newVal As OLE_COLOR)
    propTabColorActive = newVal
    PropertyChanged "TABCOLORACTIVE"
    DrawTabs
End Property


'----------------------------------------------------------
' TabFont / TabFontActive
' Font attributes of the Inactive/Active tabs
'----------------------------------------------------------
Public Property Get TabFont() As StdFont
Attribute TabFont.VB_Description = "Returns/sets the font attributes of all inactive tabs"
    Set TabFont = propTabFont
End Property

Public Property Set TabFont(ByVal newVal As StdFont)
    AssignFont propTabFont, newVal
    PropertyChanged "TABFONT"
    DrawTabs
End Property


Public Property Get TabFontActive() As StdFont
Attribute TabFontActive.VB_Description = "Returns/sets the font attributes of the active tab"
    Set TabFontActive = propTabFontActive
End Property

Public Property Set TabFontActive(ByVal newVal As StdFont)
    AssignFont propTabFontActive, newVal
    PropertyChanged "TABFONTACTIVE"
    DrawTabs
End Property


'----------------------------------------------------------
' Caption
' Tab captions
'----------------------------------------------------------
Public Property Get Caption(ByVal Index As Integer) As String
Attribute Caption.VB_Description = "Returns/Sets captions for each tab"
    Caption = propCaption(Index)
End Property

Public Property Let Caption(ByVal Index As Integer, ByVal newVal As String)
    propCaption(Index) = newVal
    PropertyChanged "TABCAPTION" & Index
    DrawTabs
End Property


'----------------------------------------------------------
' Style
' Where the tabs are displayed on the control
'----------------------------------------------------------
Public Property Get Style() As ctlTabs_TabStyles
Attribute Style.VB_Description = "Returns/sets the position of the tabs on the control"
    Style = propStyle
End Property

Public Property Let Style(ByVal newVal As ctlTabs_TabStyles)
    If newVal >= 0 And newVal <= 7 Then
        propStyle = newVal
        PropertyChanged "TABSTYLE"
        DrawTabs
    End If
End Property


'----------------------------------------------------------
' CaptionAlignment
' Where the captions are displayed on the tabs
'----------------------------------------------------------
Public Property Get CaptionAlignment() As ctlTabs_CaptionStyle
Attribute CaptionAlignment.VB_Description = "Returns/sets the position of captions within the tabs"
    CaptionAlignment = propCaptionStyle
End Property

Public Property Let CaptionAlignment(ByVal newVal As ctlTabs_CaptionStyle)
    If newVal >= 0 And newVal <= 8 Then
        propCaptionStyle = newVal
        PropertyChanged "CAPTIONSTYLE"
        DrawTabs
    End If
End Property


'----------------------------------------------------------
' TabsWidth / TabsHeight
' Dimensions of each tab (in pixels)
'----------------------------------------------------------
Public Property Get TabsWidth() As Long
Attribute TabsWidth.VB_Description = "Returns/sets the width of each tab (in pixels)"
    TabsWidth = propTabWide
End Property

Public Property Let TabsWidth(ByVal newVal As Long)
    propTabWide = newVal
    PropertyChanged "TABWIDE"
    DrawTabs
End Property

Public Property Get TabsHeight() As Long
Attribute TabsHeight.VB_Description = "Returns/sets the height of each tab (in pixels)"
    TabsHeight = propTabHigh
End Property

Public Property Let TabsHeight(ByVal newVal As Long)
    propTabHigh = newVal
    PropertyChanged "TABHIGH"
    DrawTabs
End Property


'----------------------------------------------------------
' Tabs
' The number of tabs on the control
'----------------------------------------------------------
Public Property Get Tabs() As Integer
Attribute Tabs.VB_Description = "Returns/sets the number of tabs on the control"
    Tabs = propTabCount
End Property

Public Property Let Tabs(ByVal newVal As Integer)
    Dim oldVal As Integer, tabChanged As Boolean
    If newVal > 0 Then
        propTabCount = newVal
        ReDim Preserve propCaption(1 To propTabCount)
        'Reducing the number of tabs can also change the selected tab
        If propTabCount < propTabSelected Then
            oldVal = propTabSelected
            propTabSelected = propTabCount
            tabChanged = True
        End If
        PropertyChanged "TABCOUNT"
        DrawTabs
        'Do this here because we want to raise the event
        'AFTER the tabs have been drawn
        If tabChanged Then
            PropertyChanged "TABSELECTED"
            RaiseEvent TabClick(oldVal, propTabSelected)
        End If
    End If
End Property