extlistview.pas

上传个考勤系统,希望别人也能用.该代码只能算初级的东东,软件代码复用性不高,重复代码比较多.唯一感觉有点取鉴的可能就是端口和dll的连接,还有线程的使用,本想改一改,但是手头没有考勤机了,对应考勤机是

{$IFNDEF DFS_C3D4COMMCTRL}
const
  LVM_GETSELECTIONMARK = (LVM_FIRST + 66);

function ListView_GetSelectionMark(LVWnd: HWnd): integer;

const
  LVM_SETSELECTIONMARK = (LVM_FIRST + 67);

function ListView_SetSelectionMark(LVWnd: HWnd; iIndex: integer): integer;

const
  LVM_SETHOVERTIME = (LVM_FIRST + 71);

function ListView_SetHoverTime(LVWnd: HWnd; dwHoverTimeMS: DWORD): DWORD;

const
  LVM_GETHOVERTIME = (LVM_FIRST + 72);

function ListView_GetHoverTime(LVWnd: HWnd): DWORD;

const
  LVM_SETTOOLTIPS = (LVM_FIRST + 74);

function ListView_SetToolTips(LVWnd, NewWnd: HWnd): HWnd;

const
  LVM_GETTOOLTIPS = (LVM_FIRST + 78);

function ListView_GetToolTips(LVWnd: HWnd): HWnd;
{$ENDIF}

type
  PLVBkImageA = ^TLVBkImageA;
  TLVBkImageA = packed record
    ulFlags: ULONG;              // LVBKIF_*
    hbm: HBITMAP;
    pszImage: PChar;
    cchImageMax: UINT;
    xOffsetPercent: integer;
    yOffsetPercent: integer;
  end;

  PLVBkImageW = ^TLVBkImageW;
  TLVBkImageW = packed record
    ulFlags: ULONG;              // LVBKIF_*
    hbm: HBITMAP;
    pszImage: PWideChar;
    cchImageMax: UINT;
    xOffsetPercent: integer;
    yOffsetPercent: integer;
  end;

  PLVBkImage = PLVBkImageA;
  TLVBkImage = TLVBkImageA;

{$IFNDEF DFS_C3D4COMMCTRL}
const
  LVBKIF_SOURCE_NONE      = $00000000;
  LVBKIF_SOURCE_HBITMAP   = $00000001;
  LVBKIF_SOURCE_URL       = $00000002;
  LVBKIF_SOURCE_MASK      = $00000003;
  LVBKIF_STYLE_NORMAL     = $00000000;
  LVBKIF_STYLE_TILE       = $00000010;
  LVBKIF_STYLE_MASK       = $00000010;

  LVM_SETBKIMAGEA         = (LVM_FIRST + 68);
  LVM_SETBKIMAGEW         = (LVM_FIRST + 138);
  LVM_GETBKIMAGEA         = (LVM_FIRST + 69);
  LVM_GETBKIMAGEW         = (LVM_FIRST + 139);

const
  LVM_SETBKIMAGE          = LVM_SETBKIMAGEA;

function ListView_SetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;

const
  LVM_GETBKIMAGE          = LVM_GETBKIMAGEA;

function ListView_GetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;

const
  LVN_HOTTRACK            = (LVN_FIRST-21);
{$ENDIF}

type
  PNMLVGetInfoTipA = ^TNMLVGetInfoTipA;
  TNMLVGetInfoTipA = packed record
    hdr: TNMHDR;
    dwFlags: DWORD;
    pszText: PChar;
    cchTextMax: integer;
    iItem: integer;
    iSubItem: integer;
    lParam: LPARAM;
  end;

  PNMLVGetInfoTipW = ^TNMLVGetInfoTipW;
  TNMLVGetInfoTipW = packed record
    hdr: TNMHDR;
    dwFlags: DWORD;
    pszText: PWideChar;
    cchTextMax: integer;
    iItem: integer;
    iSubItem: integer;
    lParam: LPARAM;
  end;

  PNMLVGetInfoTip = PNMLVGetInfoTipA;
  TNMLVGetInfoTip = TNMLVGetInfoTipA;

{$IFNDEF DFS_C3D4COMMCTRL}
// NMLVGETINFOTIPA.dwFlag values
const
  LVGIT_UNFOLDED          = $0001;

  LVN_GETINFOTIPA         = (LVN_FIRST-57);
  LVN_GETINFOTIPW         = (LVN_FIRST-58);
  LVN_GETINFOTIP          = LVN_GETINFOTIPA;
{$ENDIF}

type
  EELVException = class(Exception);
  EELVOldComCtl = class(EELVException);

  // New extended style flags converted to set format (RPM = Report Mode Only).
  //  lvxGridlines: Adds grid lines to seperate items and columns. RPM
  //  lvxSubItemImages: Allows images to be displayed for subitems. RPM
  //  lvxCheckboxes: Adds checkboxes to items.  Checked items are stored
  //      internally as selected items.
  //  lvxTrackSelect: Tracks the mouse and highlights the item it currently
  //      positioned over by changing it's color.  If mouse is left over an
  //      item for a brief period of time, it will be automatically selected.
  //  lvxHeaderDragDrop: Allows headers to be dragged to new positions and
  //      dropped, allowing users to reorder column information.
  //  lvxFullRowSelect: Allows user to click anywhere on an item to select it,
  //      highlighting the entire length of the item.  Without this style,
  //      users must click inside the Text of column 0.  It is only useful in
  //      vsReport view style.
  //  lvxOneClickActivate: Sends an LVN_ITEMACTIVATE notification message to
  //      the parent when the user clicks an item.
  //  lvxTwoClickActivate: Sends an LVN_ITEMACTIVATE notification message to
  //      the parent when the user double clicks an item.
  //  lvxFlatScrollBar: Enables flat scroll bars in the list view.
  //  lvxInfoTip: Enables the OnInfoTip event that allows notification and/or
  //      modification of a tooltip before it is displayed.  Only allowed for
  //      vsIcon ViewStyle.
  //  lvxUnderlineHot: Causes hot items to be displayed with underlined Text.
  //      This style is ignored if lvxOneClickActivate or lvxTwoClickActivate
  //      is not set.
  //  lvxUnderlineCold: Causes nonhot items to be displayed with underlined
  //      Text. This style is ignored if lvxOneClickActivate is not set.
  //  lvxLabelTip: If a partially hidden label in any list view mode lacks
  //      tooltip text, the list view control will unfold the label. If this
  //      style is not set, the list view control will unfold partly hidden
  //      labels only for the large icon mode.  Requires ComCtl32.dll v5.80. 
  TLVExtendedStyle = (lvxGridLines, lvxSubItemImages, lvxCheckboxes,
     lvxTrackSelect, lvxHeaderDragDrop, lvxFullRowSelect, lvxOneClickActivate,
     lvxTwoClickActivate, lvxFlatScrollBar, lvxInfoTip, lvxUnderlineHot,
     lvxUnderlineCold, lvxLabelTip);

  // A set of the new style bits.
  TLVExtendedStyles = set of TLVExtendedStyle;

  TLVItemCountFlag = (lvsicfNoInvalidateAll, lvsicfNoScroll);
  TLVItemCountFlags = set of TLVItemCountFlag;

  TLVVMMaskItem = (lvifText, lvifImage, lvifParam, lvifState, lvifIndent);
  TLVVMMaskItems = set of TLVVMMaskItem;
  TLVVMStateMaskItem = (lvisCut, lvisDropHighlighted, lvisFocused, lvisSelected,
     lvisOverlayMask);
  TLVVMStateMaskItems = set of TLVVMStateMaskItem;

  TColumnImageAlign = (ciaLeftOfText, ciaRightOfText);

  TLVItemCheckedEvent = procedure (Sender: TObject; ItemIndex: integer;
    Checked: boolean) of object;
  TLVMarqueeBeginEvent = procedure(Sender: TObject;
     var CanBegin: boolean) of object;
  TLVItemActivateEvent = TNotifyEvent;
  TLVInfoTipEvent = procedure(Sender: TObject; ItemIndex, SubItemIndex: integer;
     Current: string; var Additional: string) of object;
  TLVHotTrackEvent = procedure(Sender: TObject; var ItemIndex: integer;
     SubItemIndex: integer; Location: TPoint;
     var AllowSelect: boolean) of object;
  TLVVMGetItemInfoEvent = procedure(Sender: TObject; Item, SubItem: integer;
     var Mask: TLVVMMaskItems; var Image: integer; var OverlayImage,
     StateImage: word; var Param: LPARAM; var State: UINT; var StateMask: UINT;
     var Indent: integer; var Text: string) of object;
  TLVVMCacheHintEvent = procedure(Sender: TObject;
     var HintInfo: TNMCacheHint) of object;
  TLVVMFindItemEvent = procedure(Sender: TObject; var FindInfo: TNMFindItem;
     var Found: integer) of object;
  TLVVMStateChangedEvent = procedure(Sender: TObject;
     var StateInfo: TNMODStateChange) of object;
  TLVVMCaptionEditedEvent = procedure (Sender: TObject; Item: integer;
    Canceled: boolean; const Text: string) of object;
  {$IFNDEF DFS_COMPILER_4_UP}
  TLVSubItemImageEvent = procedure(Sender: TObject; Item: TListItem; SubItem: Integer;
    var ImageIndex: Integer) of object;
  {$ENDIF}


  TCustomExtListView = class; { forward declaration }


{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  // Class for BackgroundImage property
  TELVBackgroundImage = class(TPersistent)
  private
    FOwningListView: TCustomExtListView;
    FFilename: string;
    FBrushBmp: TBitmap;
    FTile: boolean;
    FXOffsetPercent: integer;
    FYOffsetPercent: integer;
  protected
    procedure SetFilename(const Val: string);
    procedure SetTile(Val: boolean);
    procedure SetXOffsetPercent(Val: integer);
    procedure SetYOffsetPercent(Val: integer);

    procedure ApplyToListView; virtual;
  public
    constructor Create(AOwner: TCustomExtListView); virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Filename: string
       read FFilename
       write SetFilename;
    property Tile: boolean
       read FTile
       write SetTile
       default FALSE;
    property XOffsetPercent: integer
       read FXOffsetPercent
       write SetXOffsetPercent
       default 0;
    property YOffsetPercent: integer
       read FYOffsetPercent
       write SetYOffsetPercent
       default 0;
  end;
{$ENDIF}


  // Class for saved settings
  TdfsExtLVSaveSettings = class(TdfsEnhLVSaveSettings)
  private
    FSaveColumnOrder: boolean;
  public
    constructor Create; override;
    procedure StoreColumnOrder(ColCount: integer;
       const IntArray: array of integer);
    procedure ReadColumnOrder(ColCount: integer;
       var IntArray: array of integer);
  published
    property SaveColumnOrder: boolean
       read FSaveColumnOrder
       write FSaveColumnOrder
       default TRUE;
  end;


  TdfsExtListColumn = class(TCollectionItem)
  private
    FSmallImageIndex: Integer;
    FImageAlignment : TColumnImageAlign;
    FAllowResize: boolean;
    procedure DoChange;
    procedure SetSmallImageIndex(Value: Integer);
    procedure SetImageAlignment(Value: TColumnImageAlign);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ImageIndex: integer
       read FSmallImageIndex
       write SetSmallImageIndex
       default -1;
    property ImageAlignment: TColumnImageAlign
       read FImageAlignment
       write SetImageAlignment
       default ciaRightOfText;
    property AllowResize: boolean
       read FAllowResize
       write FAllowResize
       default TRUE;
  end;

  TdfsExtListColumns = class(TCollection)
  private
    FListView: TCustomExtListView;
    function GetItem(Index: Integer): TdfsExtListColumn;
    procedure SetItem(Index: Integer; Value: TdfsExtListColumn);
  protected
    function GetOwner: TPersistent; {$IFDEF DFS_COMPILER_3_UP} override; {$ENDIF}
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AListView: TCustomExtListView);
    procedure Assign(Source: TPersistent); override;
    function Add: TdfsExtListColumn;
    procedure Refresh;
    property ListView: TCustomExtListView
       read FListView;
    property Items[Index: Integer]: TdfsExtListColumn
       read GetItem
       write SetItem;
       default;
  end;

  // The new class.
  TCustomExtListView = class(TCustomEnhListView)
  private
    FExtendedStyles: TLVExtendedStyles;
    FColumnOrder: PIntArray;
    FColumnOrderCount: integer;
    FColumnsFormat: TdfsExtListColumns;
    FVirtualMode: boolean;
    FSaveSettings: TdfsExtLVSaveSettings;
    FColumnsFormatChangeLink: TChangeLink;
    FSelectionMark: integer;
    FHoverTime: Longint;
    FRequireComCtlUpdate: boolean;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
    FBackgroundImage: TELVBackgroundImage;
{$ENDIF}
    FItemCountEx: integer;
    FItemCountExFlags: TLVItemCountFlags;
    FRecreateStream: TMemoryStream;
{$IFDEF DFS_COMPILER_4_UP}
    FInhibitFeedData: boolean;
{$ENDIF}
    FChecked: boolean;
    FCheckedListItemIndex: integer;

    FOnItemChecked: TLVItemCheckedEvent;
    FOnMarqueeBegin: TLVMarqueeBeginEvent;
    FOnItemActivate: TLVItemActivateEvent;
    FOnHotTrack: TLVHotTrackEvent;
    FOnInfoTip: TLVInfoTipEvent;
    FOnVMGetItemInfo: TLVVMGetItemInfoEvent;
    FOnVMCacheHint: TLVVMCacheHintEvent;
    FOnVMFindItem: TLVVMFindItemEvent;
    FOnVMStateChanged: TLVVMStateChangedEvent;
    FOnVMCaptionEdited: TLVVMCaptionEditedEvent;

    // Function to convert from our set type to expected API value.
    function SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
    function SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;

    procedure ColumnHeaderImagesChange(Sender: TObject);

    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
    function GetItemIndent(Index: integer): Integer;
    procedure SetItemIndent(Index: integer; Value: Integer);
{$IFDEF DFS_COMPILER_4_UP}
    procedure FeedOwnerDataMode(Sender: TObject; Item: TListItem);
{$ENDIF}
  protected
    // Property method for setting styles.
    procedure SetExtendedStyles(Val: TLVExtendedStyles);
    function GetExtendedStyles: TLVExtendedStyles;
    function GetHeaderHandle: HWnd;
    function GetSubItemRect(Item, SubItem: integer; Index: integer): TRect;
    procedure SetHotItem(Val: integer);
    function GetHotItem: integer;
    procedure SetHotCursor(const Val: HCursor);
    function GetHotCursor: HCursor;
    procedure SetWorkArea(Rect: TRect);
    procedure SetCheckState(Index: integer; Checked: boolean);
    function GetCheckState(Index: integer): boolean;
    procedure SetVirtualMode(Val: boolean);
    procedure SetColumnsFormat(Value: TdfsExtListColumns);
    function GetSubItemImageIndex(Item, SubItem: integer): integer;
    procedure SetSubItemImageIndex(Item, SubItem, Value: integer);
    function GetSelectionMark: integer;
    procedure SetSelectionMark(Val: integer);
    function GetHoverTime: Longint;
    procedure SetHoverTime(Val: Longint);
    procedure SetRequireComCtlUpdate(Value: boolean);
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
    procedure SetBackgroundImage(Value: TELVBackgroundImage);
{$ENDIF}
    function GetStateImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
    procedure SetStateImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
    function GetSmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
    procedure SetSmallImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
    function GetShowSortArrows: boolean;
    procedure SetShowSortArrows(Value: boolean);
    function GetVersion: string; override;
    function GetSubItemText(Index, SubItem: integer): string; override;
    function ActualColumnIndex(Index: integer): integer; override;
    function GetActualColumn(Index: integer): TListColumn; override;
    procedure DestroyWnd; override;
    procedure RestoreChecks;