clsadvancededit.cls

一款Grid表格控件源代码,非常棒.不下你一定会后悔

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsAdvancedEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Implements GXISubclass

Private Const CDDS_PREPAINT                     As Long = &H1
Private Const CDDS_POSTPAINT                    As Long = &H2
Private Const CDDS_PREERASE                     As Long = &H3
Private Const CDDS_POSTERASE                    As Long = &H4
Private Const CDDS_ITEM                         As Long = &H10000
Private Const CDDS_ITEMPREPAINT                 As Long = CDDS_ITEM Or CDDS_PREPAINT
Private Const CDDS_ITEMPOSTPAINT                As Long = CDDS_ITEM Or CDDS_POSTPAINT
Private Const CDDS_SUBITEM                      As Long = &H20000

Private Const CDRF_DODEFAULT                    As Long = &H0
Private Const CDRF_NOTIFYITEMDRAW               As Long = &H20
Private Const CDRF_NOTIFYSUBITEMDRAW            As Long = &H20

Private Const DS_MODALFRAME                     As Long = &H80

Private Const HDS_FLAT                          As Long = &H200
Private Const HWND_TOPMOST                      As Long = -1

Private Const NM_FIRST                          As Long = &HFFFF + 1
Private Const NM_CUSTOMDRAW                     As Long = (NM_FIRST - 12)

Private Const SWP_SHOWWINDOW                    As Long = &H40

Private Const WS_OVERLAPPED                     As Long = &H0
Private Const WS_CHILD                          As Long = &H40000000
Private Const WS_POPUP                          As Long = &H80000000
Private Const WS_CLIPSIBLINGS                   As Long = &H4000000
Private Const WS_CAPTION                        As Long = &HC00000
Private Const WS_SYSMENU                        As Long = &H80000
Private Const WS_THICKFRAME                     As Long = &H40000
Private Const WS_MINIMIZEBOX                    As Long = &H20000
Private Const WS_MAXIMIZEBOX                    As Long = &H10000
Private Const WS_CLIPCHILDREN                   As Long = &H2000000
Private Const WS_OVERLAPPEDWINDOW               As Long = _
(WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)

Private Const SS_WHITERECT                      As Long = &H6

Private Const WS_EX_LTRREADING                  As Long = &H0
Private Const WS_EX_LEFT                        As Long = &H0
Private Const WS_EX_RIGHTSCROLLBAR              As Long = &H0
Private Const WS_EX_DLGMODALFRAME               As Long = &H1
Private Const WS_EX_NOPARENTNOTIFY              As Long = &H4
Private Const WS_EX_TOPMOST                     As Long = &H8
Private Const WS_EX_ACCEPTFILES                 As Long = &H10
Private Const WS_EX_TRANSPARENT                 As Long = &H20
Private Const WS_EX_MDICHILD                    As Long = &H40
Private Const WS_EX_TOOLWINDOW                  As Long = &H80
Private Const WS_EX_WINDOWEDGE                  As Long = &H100
Private Const WS_EX_CLIENTEDGE                  As Long = &H200
Private Const WS_EX_CONTEXTHELP                 As Long = &H400
Private Const WS_EX_RIGHT                       As Long = &H1000
Private Const WS_EX_RTLREADING                  As Long = &H2000
Private Const WS_EX_LEFTSCROLLBAR               As Long = &H4000
Private Const WS_EX_CONTROLPARENT               As Long = &H10000
Private Const WS_EX_STATICEDGE                  As Long = &H20000
Private Const WS_EX_APPWINDOW                   As Long = &H40000

Private Const CLRYELLOW = "&H00FFFF &H00F0F0 &H00E1E1 &H00D2D2 &H00C3C3 &H00B4B4 &H00A5A5 &H009696 &H008787 &H007878 &H006969" & _
                        " &H9CFFFF &H8DF0F0 &H7EE1E1 &H6FD2D2 &H60C3C3 &H51B4B4 &H42A5A5 &H339696 &H248787 &H157878 &H066969" & _
                        " &HD2FFFF &HC3F0F0 &HB4E1E1 &HA5D2D2 &H96C3C3 &H87B4B4 &H78A5A5 &H699696 &H5A8787 &H4B7878 &H3C6969" & _
                        " &HEBFFFF &HDCF0F0 &HCDE1E1 &HBED2D2 &HAFC3C3 &HA0B4B4 &H91A5A5 &H829696 &H738787 &H647878 &H556969"
Private Const CLRMAGENTA = "&HFF00FF &HF000F0 &HE100E1 &HD200D2 &HC300C3 &HB400B4 &HA500A5 &H960096 &H870087 &H780078 &H690069" & _
                        " &HFF9CFF &HF08DF0 &HE17EE1 &HD26FD2 &HC360C3 &HB451B4 &HA542A5 &H963396 &H872487 &H781578 &H690669" & _
                        " &HFFD2FF &HF0C3F0 &HE1B4E1 &HD2A5D2 &HC396C3 &HB487B4 &HA578A5 &H966996 &H875A87 &H784B78 &H693C69" & _
                        " &HFFEBFF &HF0DCF0 &HE1CDE1 &HD2BED2 &HC3AFC3 &HB4A0B4 &HA591A5 &H968296 &H877387 &H786478 &H695569"
Private Const CLRCYAN = "&HFFFF00 &HF0F000 &HE1E100 &HD2D200 &HC3C300 &HB4B400 &HA5A500 &H969600 &H878700 &H787800 &H696900" & _
                        " &HFFFF9C &HF0F08D &HE1E17E &HD2D26F &HC3C360 &HB4B451 &HA5A542 &H969633 &H878724 &H787815 &H696906" & _
                        " &HFFFFD2 &HF0F0C3 &HE1E1B4 &HD2D2A5 &HC3C396 &HB4B487 &HA5A578 &H969669 &H87875A &H78784B &H69693C" & _
                        " &HFFFFEB &HF0F0DC &HE1E1CD &HD2D2BE &HC3C3AF &HB4B4A0 &HA5A591 &H969682 &H878773 &H787864 &H696955"
Private Const CLRBLUE = "&HFF0000 &HF00000 &HE10000 &HD20000 &HC30000 &HB40000 &HA50000 &H960000 &H870000 &H780000 &H690000" & _
                        " &HFF9C9C &HF08D8D &HE17E7E &HD26F6F &HC36060 &HB45151 &HA54242 &H963333 &H872424 &H781515 &H690606" & _
                        " &HFFD2D2 &HF0C3C3 &HE1B4B4 &HD2A5A5 &HC39696 &HB48787 &HA57878 &H966969 &H875A5A &H784B4B &H963C3C" & _
                        " &HFFEBEB &HF0DCDC &HE1CDCD &HD2BEBE &HC3AFAF &HB4A0A0 &HA59191 &H968282 &H877373 &H786464 &H695555"
Private Const CLRRED = "&H0000FF &H0000F0 &H0000E1 &H0000D2 &H0000C3 &H0000B4 &H0000A5 &H000096 &H000087 &H000078 &H000069" & _
                        " &H9C9CFF &H8D8DF0 &H7E7EE1 &H6F6FD2 &H6060C3 &H5151B4 &H4242A5 &H333396 &H242487 &H151578 &H060669" & _
                        " &HD2D2FF &HC3C3F0 &HB4B4E1 &HA5A5D2 &H9696C3 &H8787B4 &H7878A5 &H696996 &H5A5A87 &H4B4B78 &H3C3C69" & _
                        " &HEBEBFF &HDCDCF0 &HCDCDE1 &HBEBED2 &HAFAFC3 &HA0A0B4 &H9191A5 &H828296 &H737387 &H646478 &H555569"
Private Const CLRGREEN = "&H00FF00 &H00F000 &H00E100 &H00D200 &H00C300 &H00B400 &H00A500 &H009600 &H008700 &H007800 &H006900" & _
                        " &H9CFF9C &H8DF08D &H7EE17E &H6FD26F &H60C360 &H51B451 &H42A542 &H339633 &H248724 &H157815 &H066906" & _
                        " &HD2FFD2 &HC3F0C3 &HB4E1B4 &HA5D2A5 &H96C396 &H87B487 &H78A578 &H699669 &H5A875A &H4B784B &H3C693C" & _
                        " &HEBFFEB &HDCF0DC &HCDE1CD &HBED2BE &HAFC3AF &HA0B4A0 &H91A591 &H829682 &H738773 &H647864 &H556955"
Private Const CLRGREY = "&HD2D2D2 &HC3C3C3 &HB4B4B4 &HA5A5A5 &H969696 &H878787 &H787878 &H696969 &H5A5A5A &H4B4B4B &H3C3C3C" & _
                        " &HEBEBEB &HDCDCDC &HCDCDCD &HBEBEBE &HAFAFAF &HA0A0A0 &H919191 &H828282 &H737373 &H646464 &H555555" & _
                        " &HFAFAFA &HEBEBEB &HDCDCDC &HCDCDCD &HBEBEBE &HAFAFAF &HA0A0A0 &H919191 &H828282 &H737373 &H646464"



Public Enum ECAThemeStyle
    ecaAzure = 0&
    ecaClassic = 1&
    ecaGloss = 2&
    ecaMetal = 3&
    ecaXp = 4&
End Enum

Public Enum EIAImageType
    eiaBitmap = 0&
    eiaIcon = 1&
    eiaCursor = 2&
    eiaMetafile = 3&
End Enum

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

Private Type VERSIONINFO
    dwOSVersionInfoSize                         As Long
    dwMajorVersion                              As Long
    dwMinorVersion                              As Long
    dwBuildNumber                               As Long
    dwPlatformId                                As Long
    szCSDVersion                                As String * 128
End Type


Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersion As VERSIONINFO) As Long

Private Declare Function CreateWindowExA Lib "USER32" (ByVal dwExStyle As Long, _
                                                       ByVal lpClassName As String, _
                                                       ByVal lpWindowName As String, _
                                                       ByVal dwStyle As Long, _
                                                       ByVal x As Long, _
                                                       ByVal y As Long, _
                                                       ByVal nWidth As Long, _
                                                       ByVal nHeight As Long, _
                                                       ByVal hWndParent As Long, _
                                                       ByVal hMenu As Long, _
                                                       ByVal hInstance As Long, _
                                                       lpParam As Any) As Long

Private Declare Function CreateWindowExW Lib "USER32" (ByVal dwExStyle As Long, _
                                                       ByVal lpClassName As Long, _
                                                       ByVal lpWindowName As Long, _
                                                       ByVal dwStyle As Long, _
                                                       ByVal x As Long, _
                                                       ByVal y As Long, _
                                                       ByVal nWidth As Long, _
                                                       ByVal nHeight As Long, _
                                                       ByVal hWndParent As Long, _
                                                       ByVal hMenu As Long, _
                                                       ByVal hInstance As Long, _
                                                       lpParam As Any) As Long

Private Declare Function DestroyWindow Lib "USER32" (ByVal hWnd As Long) As Long

Private Declare Sub SetWindowPos Lib "USER32" (ByVal hWnd As Long, _
                                               ByVal hWndInsertAfter As Long, _
                                               ByVal x As Long, _
                                               ByVal y As Long, _
                                               ByVal cx As Long, _
                                               ByVal cy As Long, _
                                               ByVal wFlags As Long)

Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long

Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, _
                                                 ByVal hdc As Long) As Long

Private Declare Function ImageList_GetIcon Lib "COMCTL32" (ByVal hImageList As Long, _
                                                           ByVal ImgIndex As Long, _
                                                           ByVal fuFlags As Long) As Long

Private Declare Function ImageList_GetImageCount Lib "COMCTL32" (ByVal hImageList As Long) As Long

Private Declare Function ImageList_GetIconSize Lib "COMCTL32" (ByVal hImageList As Long, _
                                                               cx As Long, _
                                                               cy As Long) As Long

Private Declare Function DestroyIcon Lib "USER32" (ByVal hIcon As Long) As Long

Public Event ReturnData(ByVal sText As String, ByVal oFont As StdFont, ByVal lIcon As Long, ByVal lForeColor As Long, ByVal lBackColor As Long)
Public Event DestroyMe()


Private m_bIsNt                                 As Boolean
Private m_bShowing                              As Boolean
Private m_lParentHwnd                           As Long
Private m_lHostHwnd                             As Long
Private m_lWidth                                As Long
Private m_lHeight                               As Long
Private m_lImlHwnd                              As Long
Private m_lForeColor                            As Long
Private m_lBackColor                            As Long
Private m_lIconIndex                            As Long
Private m_lhIcon                                As Long
Private m_lThemeColor                           As Long
Private m_lOffsetColor                          As Long
Private m_sEditText                             As String
Private m_eImageType                            As EIAImageType
Private m_oFont                                 As StdFont
Private m_eThemeStyle                           As ECAThemeStyle
Private m_tRWnd                                 As RECT
Private m_cTxEditBox                            As clsODControl
Private m_cTxSize                               As clsODControl
Private m_cPbDisplay                            As clsODControl
Private m_cLbIcon                               As clsODControl
Private m_cLbFontSelect                         As clsODControl
Private m_cLbFontColor                          As clsODControl
Private m_cLbBackColor                          As clsODControl
Private m_cLbSize                               As clsODControl
Private WithEvents m_cCbBackColor               As clsODControl
Attribute m_cCbBackColor.VB_VarHelpID = -1
Private WithEvents m_cCbFontSelect              As clsODControl
Attribute m_cCbFontSelect.VB_VarHelpID = -1
Private WithEvents m_cCbFontColor               As clsODControl
Attribute m_cCbFontColor.VB_VarHelpID = -1
Private WithEvents m_cBtScrollUp                As clsODControl
Attribute m_cBtScrollUp.VB_VarHelpID = -1
Private WithEvents m_cBtScrollDwn               As clsODControl
Attribute m_cBtScrollDwn.VB_VarHelpID = -1
Private WithEvents m_cBtClose                   As clsODControl
Attribute m_cBtClose.VB_VarHelpID = -1
Private WithEvents m_cBtSave                    As clsODControl
Attribute m_cBtSave.VB_VarHelpID = -1
Private WithEvents m_cBtFontBold                As clsODControl
Attribute m_cBtFontBold.VB_VarHelpID = -1
Private WithEvents m_cBtFontItalic              As clsODControl
Attribute m_cBtFontItalic.VB_VarHelpID = -1
Private WithEvents m_cBtFontStrike              As clsODControl
Attribute m_cBtFontStrike.VB_VarHelpID = -1
Private WithEvents m_cBtFontUnderline           As clsODControl
Attribute m_cBtFontUnderline.VB_VarHelpID = -1
Private m_cHostSubclass                         As GXMSubclass


Private Sub Class_Initialize()

    m_bIsNt = CompatabilityCheck
    m_lForeColor = -1
    m_lBackColor = -1
    m_lIconIndex = -1
    
End Sub

Private Sub m_cBtClose_Click()
'/* signal close
    DestroyHost
    RaiseEvent DestroyMe
End Sub

Private Sub m_cBtSave_Click()
'/* return changes to parent

    If Not m_oFont Is Nothing Then
        With m_oFont
            .Bold = m_cBtFontBold.CommandPushed
            .Italic = m_cBtFontItalic.CommandPushed
            .Strikethrough = m_cBtFontStrike.CommandPushed
            .Underline = m_cBtFontUnderline.CommandPushed
        End With
    End If
    '/* send data
    RaiseEvent ReturnData(m_cTxEditBox.Text, m_oFont, m_lIconIndex, m_lForeColor, m_lBackColor)

End Sub

Private Sub m_cCbFontSelect_ItemChange(ByVal lItem As Long)
'/* font selection change

    With m_cCbFontSelect
        If (.ListIndex = 0) Then
            '/* open font dialog
            ComboGetFont
        Else
            '/* update local font
            If Not (.ListIndex = -1) Then
                Set m_oFont = New StdFont
                m_oFont.Name = .ListText(.ListIndex)
            End If
        End If
    End With

End Sub

Private Sub ComboGetFont()
'/* open font dialog

On Error Resume Next

    Set m_oFont = ShowFontDialog(m_lParentHwnd)

On Error GoTo 0

End Sub

Private Sub m_cBtScrollDwn_Click()
'/* scroll down icon list

    m_lIconIndex = (m_lIconIndex - 1)
    EditLoadPicture m_lIconIndex

End Sub

Private Sub m_cBtScrollUp_Click()
'/* scroll up icon list

    m_lIconIndex = (m_lIconIndex + 1)
    EditLoadPicture m_lIconIndex
    
End Sub

Private Sub m_cCbBackColor_ItemChange(ByVal lItem As Long)
'/* backcolor change

    With m_cCbBackColor
        If (.ListIndex = 0) Then
            '/* open color dialog
            m_lBackColor = ComboExtendedColors