uclistview.ctl

需要控件：Active Report 2.0(专业报表控件破解版)2.0下的ardespro2.dll和arpro2.dll ARVIEW2.OCX等文件。即可打开源代码。

VERSION 5.00
Begin VB.UserControl ucListView 
   AutoRedraw      =   -1  'True
   ClientHeight    =   1800
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3045
   ClipControls    =   0   'False
   FillColor       =   &H80000008&
   HasDC           =   0   'False
   ScaleHeight     =   120
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   203
   ToolboxBitmap   =   "ucListView.ctx":0000
End
Attribute VB_Name = "ucListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'========================================================================================
' User control:  ucListView.ctl
' Author:        Carles P.V. (*)
' Dependencies:  mIOleInPlaceActivate.bas -> OleGuids.tlb (in IDE only)
'                mListViewEx.bas
' Last revision: 2004.12.09
' Version:       1.4.4
'----------------------------------------------------------------------------------------
'
' (*) based on:
'
'     - vbalListViewCtl by Steve McMahon - 2003
'       http://vbaccelerator.com/home/VB/Code/Controls/ListView/article.asp
'
'     - Common Control Routines
'       http://vbnet.mvps.org/index.html?code/comctl
'
'     - MSDN
'       http://msdn.microsoft.com/library/en-us/shellcc/platform/commctls/listview/reflist.asp
'----------------------------------------------------------------------------------------
'
'     Self-Subclassing UserControl template (IDE safe).
'
'     From original post by Paul Caton:
'
'     Self-subclassing Controls/Forms - NO dependencies
'     http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=54117&lngWId=1
'
'----------------------------------------------------------------------------------------
'
'     Traping TabStop + navigation keys.
'
'     From original post by Vlad Vissoultchev:
'
'     How to capture Tab/Enter/Esc on your custom UserControl
'     http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=41506&lngWId=1
'
'========================================================================================
'
' History:
'
'   * 1.0.0: - First release.
'   * 1.1.x: - Added Sort() function.
'   * 1.2.x: - Added Header (column) image support.
'   * 1.3.x: - Improved Header image support and added ColumnFixedWidth property.
'   * 1.4.0: - Added basic custom-draw support (Text fore and back color) in [Details] mode.
'              Notice: Chain of draw-stage notifications is a per-item chain (row). If desired
'                      effect is, for example, highlighting a column, you should specify next
'                      subitems (columns) colors, that is, restore to default.
'            - Added Refresh() Method.
'   * 1.4.1: - Fixed custom-draw routine. Crash when XP theme enabled ([Details] mode).
'              Thanks to Dana Seaman.
'   * 1.4.2: - Custom image size for image-lists).
'              Thanks to Dana Seaman for suggestion.
'   * 1.4.3: - Faster Sort routines: LVM_SORTITEMSEX instead of LVM_SORTITEMS
'              Callback lparam1 and lparam2 are already indexes of both compared items.
'   * 1.4.4: - Fixed crash when XP theme enabled.
'              Cause: when custom-draw (report) the uNMH.hwndFrom param. was not checked.
'========================================================================================
'
' Important:
'
'   Item, column and image (icon) indexing is zero-based.
'
' Quick reference:
'
'   Methods:
'
'     - F  Initialize() :Boolean
'     - F  InitializeImageListSmall([ImageWidth], [ImageHeight]) :Boolean
'     - F  InitializeImageListLarge([ImageWidth], [ImageHeight]) :Boolean
'     - F  InitializeImageListHeader([ImageWidth], [ImageHeight]) :Boolean
'     - S  Refresh()
'
'     - F  Clear() :Boolean
'     - F  Sort([Column], [<SortOrder>], [<SortType>]) :Boolean
'     - F  BackgroundPictureSet(URL) :Boolean
'
'     - F  ColumnAdd(Column, Text, Width, [<Align>], [Icon]) :Boolean
'     - F  ColumnRemove(Column) :Boolean
'     - F  ColumnAutosize(Column, [<AutosizeType>]) :Boolean
'
'     - F  ItemAdd(Item, Text, Icon, Indent) :Boolean
'     - F  ItemRemove(Item) :Boolean
'     - F  ItemEnsureVisible(Item) :Boolean
'     - F  ItemFindText(Text, [StartItem], [<Coincidence>]) :Integer
'     - F  ItemFindState(Text, [StartItem], [<State>]) :Integer
'     - F  ItemHitTest(x, y) :Integer
'     - F  SubItemSet(Item, SubItem, Text, Icon) :Boolean
'
'     - F  ImageListSmall_AddBitmap(hBitmap, [MaskColor]) :Integer
'     - F  ImageListSmall_AddIcon(hIcon) :Integer
'     - F  ImageListLarge_AddBitmap(hBitmap, [MaskColor]) :Integer
'     - F  ImageListLarge_AddIcon(hIcon) :Integer
'     - F  ImageListHeader_AddBitmap(hBitmap, [MaskColor]) :Integer
'     - F  ImageListHeader_AddIcon(hIcon) :Integer
'
'   Properties (run-time):
'
'     - RW ColumnText(Column) :String
'     - RW ColumnWidth(Column) :Integer
'     - RW ColumnAlign(Column) :eColumnAlignConstants
'     - RW ColumnIcon(Column) :Integer
'
'     - RW ItemText(Item) :String
'     - RW ItemIcon(Item) :Integer
'     - RW ItemIndent(Item) :Integer
'     - RW ItemSelected(Item) :Boolean (Item = -1 -> all items)
'     - RW ItemFocused(Item) :Boolean
'     - RW ItemChecked(Item) :Boolean (Item = -1 -> all items)
'     - RW ItemGhosted(Item) :Boolean (Item = -1 -> all items)
'     - RW SubItemText(Item, SubItem) :String
'     - RW SubItemIcon(Item, SubItem) :Integer
'
'     - RW BackColor() :OLE_COLOR
'     - RW BorderStyle() :eBorderStyleConstants
'     - R  ColumnCount() :Integer
'     - R  Count() :Integer
'     - RW CheckBoxes() :Boolean
'     - RW Enabled() :Boolean
'     - RW Font() :StdFont
'     - RW ForeColor() :OLE_COLOR
'     - RW FullRowSelect() :Boolean
'     - RW GridLines() :Boolean
'     - RW HeaderDragDrop() :Boolean
'     - RW HeaderFixedWidth() :Boolean
'     - RW HeaderFlat() :Boolean
'     - RW HeaderHide() :Boolean
'     - RW HideSelection() Boolean
'     - RW LabelEdit() :Boolean
'     - RW LabelTips() :Boolean
'     - RW MultiSelect() :Boolean
'     - RW OneClickActivate() :Boolean
'     - RW RaiseSubItemPrePaint() :Boolean
'     - RW ScaleMode() :ScaleModeConstants
'     - RW ScrollBarFlat() :Boolean
'     - R  SelectedCount() :Integer
'     - RW SubItemImages() :Boolean
'     - RW TrackSelect() :Boolean
'     - RW UnderlineHot() :Boolean
'     - RW ViewMode() :eViewModeConstants
'
'   Events:
'     -    Click()
'     -    DblClick()
'     -    ItemClick(Item)
'     -    ItemCheck(Item)
'     -    ColumnClick(Column)
'     -    ColumnRightClick(Column)
'     -    KeyDown(KeyCode, Shift)
'     -    KeyPress(KeyAscii)
'     -    KeyUp(KeyCode, Shift)
'     -    MouseDown(Button, Shift, x, y)
'     -    MouseMove(Button, Shift, x, y)
'     -    MouseUp(Button, Shift, x, y)
'     -    MouseEnter()
'     -    MouseLeave()
'     -    BeforeLabelEdit(Cancel)
'     -    AfterLabelEdit(Cancel, NewString)
'     -    Resize()
'     -    OnSubItemPrePaint(Item, SubItem, TextBackColor, TextForeColor, Process)
'========================================================================================
'
'  Known issues:
'
'    * SubItem background incorrectly drawn (image not painted or background erased) when:
'      Background image + [vmDetails] ViewMode + FullRowSelect + SubItemImages
'      Solution?: Trap NM_CUSTOMDRAW notification -> fix SubItem draw.
'                 NM_CUSTOMDRAW: dwDrawStage:CDDS_PREPAINT -> CDRF_NOTIFYITEMDRAW
'                 NM_CUSTOMDRAW: dwDrawStage:CDDS_ITEMPREPAINT -> CDRF_NOTIFYSUBITEMDRAW
'                 NM_CUSTOMDRAW: dwDrawStage:CDDS_SUBITEM | CDDS_ITEMPREPAINT -> ...
'
'    * Slow sorting routines ?
'========================================================================================

Option Explicit

'-- API

'= Common controls initialization =======================================================

Private Declare Sub InitCommonControls Lib "Comctl32" ()

'= Misc =================================================================================

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT2
    X1 As Long
    Y1 As Long
    X2 As Long
    Y2 As Long
End Type

Private Type LOGFONT
    lfHeight         As Long
    lfWidth          As Long
    lfEscapement     As Long
    lfOrientation    As Long
    lfWeight         As Long
    lfItalic         As Byte
    lfUnderline      As Byte
    lfStrikeOut      As Byte
    lfCharSet        As Byte
    lfOutPrecision   As Byte
    lfClipPrecision  As Byte
    lfQuality        As Byte
    lfPitchAndFamily As Byte
    lfFaceName(32)   As Byte
End Type

Private Const LOGPIXELSY             As Long = 90
Private Const FW_NORMAL              As Long = 400
Private Const FW_BOLD                As Long = 700
Private Const FF_DONTCARE            As Long = 0
Private Const DEFAULT_QUALITY        As Long = 0
Private Const DEFAULT_PITCH          As Long = 0
Private Const DEFAULT_CHARSET        As Long = 1
Private Const NONANTIALIASED_QUALITY As Long = 3

Private Const CLR_NONE               As Long = &HFFFFFFFF

Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT2) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function OleTranslateColor Lib "olepro32" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'//

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
Private Declare Function TrackMouseEventComCtl Lib "Comctl32" Alias "_TrackMouseEvent" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long

Private Const WM_MOUSELEAVE As Long = &H2A3

Private Enum TRACKMOUSEEVENT_FLAGS
    [TME_HOVER] = &H1&
    [TME_LEAVE] = &H2&
    [TME_QUERY] = &H40000000
    [TME_CANCEL] = &H80000000
End Enum

Private Type TRACKMOUSEEVENT_STRUCT
    cbSize      As Long
    dwFlags     As TRACKMOUSEEVENT_FLAGS
    hwndTrack   As Long
    dwHoverTime As Long
End Type

'= Window general =======================================================================

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal Length As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Any) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lparam As Long) As Long

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (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 DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long

Private Const GWL_STYLE        As Long = (-16)
Private Const GWL_EXSTYLE      As Long = (-20)
Private Const WS_EX_TOPMOST    As Long = &H8&
Private Const WS_EX_WINDOWEDGE As Long = &H100&
Private Const WS_EX_CLIENTEDGE As Long = &H200&
Private Const WS_EX_STATICEDGE As Long = &H20000
Private Const WS_TABSTOP       As Long = &H10000
Private Const WS_THICKFRAME    As Long = &H40000
Private Const WS_BORDER        As Long = &H800000
Private Const WS_DISABLED      As Long = &H8000000
Private Const WS_VISIBLE       As Long = &H10000000
Private Const WS_CHILD         As Long = &H40000000

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOW  As Long = 5
Private Const GW_CHILD As Long = 5

Private Declare Function 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) As Long
Private Const SWP_NOMOVE        As Long = &H2
Private Const SWP_NOSIZE        As Long = &H1
Private Const SWP_NOOWNERZORDER As Long = &H200
Private Const SWP_NOZORDER      As Long = &H4
Private Const SWP_FRAMECHANGED  As Long = &H20

'= ListView =============================================================================

Private Const LVS_EX_GRIDLINES         As Long = &H1&
Private Const LVS_EX_SUBITEMIMAGES     As Long = &H2&
Private Const LVS_EX_CHECKBOXES        As Long = &H4&
Private Const LVS_EX_TRACKSELECT       As Long = &H8&
Private Const LVS_EX_HEADERDRAGDROP    As Long = &H10&
Private Const LVS_EX_FULLROWSELECT     As Long = &H20&
Private Const LVS_EX_ONECLICKACTIVATE  As Long = &H40&