⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 slistview.pas

📁 Alpha Controls.v5.46b Source
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit sListView;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, sConst, ComCtrls, {$IFNDEF DELPHI5}types,{$ENDIF}
  Commctrl, sCommonData, sMessages, acSBUtils{$IFDEF LOGGED}, sDebugMsgs{$ENDIF}
  {$IFDEF TNTUNICODE}, TntComCtrls{$ENDIF};

{$I sDefs.inc}

type
{$IFDEF TNTUNICODE}
  TsCustomListView = class(TTntCustomListView)
{$ELSE}
  TsCustomListView = class(TCustomListView)
{$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    Loading          : boolean;
    FhWndHeader      : HWnd;
    FhHeaderProc     : Pointer;
    FhDefHeaderProc  : Pointer;
    FPressedColumn   : Integer;
    FCommonData: TsCommonData;
    HoverColIndex : integer;
    FBoundLabel: TsBoundLabel;
    FHighlightHeaders: boolean;
    FOldAdvancedCustomDraw: TLVAdvancedCustomDrawEvent;
    FFlag: Boolean;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMHitTest(var Message: TMessage); message WM_NCHITTEST;
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
    procedure NewAdvancedCustomDraw(Sender: TCustomListView; const ARect: TRect; Stage: TCustomDrawStage; var DefaultDraw: Boolean);

    procedure PrepareCache;
    function GetHeaderColumnRect(Index: Integer): TRect;
    procedure ColumnSkinPaint(ControlRect : TRect; cIndex : Integer);
    procedure PaintHeader;
  protected
    ListSW : TacScrollWnd;
    procedure WndProc (var Message: TMessage); override;
    procedure HeaderWndProc(var Message: TMessage);
    function AllColWidth : integer;
    function FullRepaint : boolean;
    property BorderStyle;
    procedure InvalidateSmooth(Always : boolean);
  public
    ListLineHeight : Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure AfterConstruction; override;
    procedure Loaded; override;
  published
{$ENDIF} // NOTFORHELP
    property BoundLabel : TsBoundLabel read FBoundLabel write FBoundLabel;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property HighlightHeaders : boolean read FHighlightHeaders write FHighlightHeaders default True;
  end;

  TsListView = class(TsCustomListView)
{$IFNDEF NOTFORHELP}
  published
    property Align;
    property AllocBy;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property BorderWidth;
    property Checkboxes;
    property Color;
    property Columns;
    property ColumnClick;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property FlatScrollBars;
    property FullDrag;
    property GridLines;
    property HideSelection;
    property HotTrack;
    property HotTrackStyles;
    property HoverTime;
    property IconOptions;
    property Items;
    property LargeImages;
    property MultiSelect;
    property OwnerData;
    property OwnerDraw;
    property ReadOnly default False;
    property RowSelect;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowColumnHeaders;
    property ShowWorkAreas;
    property ShowHint;
    property SmallImages;
    property SortType;
    property StateImages;
    property TabOrder;
    property TabStop default True;
    property ViewStyle;
    property Visible;
    property OnAdvancedCustomDraw;
    property OnAdvancedCustomDrawItem;
    property OnAdvancedCustomDrawSubItem;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnColumnClick;
    property OnColumnDragged;
    property OnColumnRightClick;
    property OnCompare;
    property OnContextPopup;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnCustomDrawSubItem;
    property OnData;
    property OnDataFind;
    property OnDataHint;
    property OnDataStateChange;
    property OnDblClick;
    property OnDeletion;
    property OnDrawItem;
    property OnEdited;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSubItemImage;
    property OnDragDrop;
    property OnDragOver;
    property OnInfoTip;
    property OnInsert;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnSelectItem;
    property OnStartDock;
    property OnStartDrag;
    property BoundLabel;
    property SkinData;
{$ENDIF} // NOTFORHELP
  end;

{$IFNDEF NOTFORHELP}
  TsHackedListItems = class({$IFDEF TNTUNICODE}TTntListItems{$ELSE}TListItems{$ENDIF})
  public
    FNoRedraw: Boolean;
  end;
{$ENDIF} // NOTFORHELP

implementation

uses sStyleSimply, acntUtils, sVclUtils, sMaskData, sGraphUtils, sSkinProps,
  sAlphaGraph, sSkinManager, math;

var
  LocalMsg : TMessage;
  LocalFlag : boolean;

constructor TsCustomListView.Create(AOwner: TComponent);
begin
  FhWndHeader     := 0;
  FhDefHeaderProc := nil;
  FPressedColumn  := -1;
  Loading := True;

  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsListView;
//  FCommonData.Updating := False;
  SkinData.BGChanged := True;
  FBoundLabel := TsBoundLabel.Create(Self, FCommonData);
  ListLineHeight := Font.Size;
  FHighlightHeaders := True;
  HoverColIndex := -2;

  if Assigned(OnAdvancedCustomDraw) then FOldAdvancedCustomDraw := OnAdvancedCustomDraw else FOldAdvancedCustomDraw := nil;
  OnAdvancedCustomDraw := NewAdvancedCustomDraw;
  try
    FhHeaderProc := MakeObjectInstance(HeaderWndProc);
  except
    Application.HandleException(Self);
  end;
end;

destructor TsCustomListView.Destroy;
begin
  if ListSW <> nil then FreeAndNil(ListSW);
  SmallImages := nil;
  LargeImages := nil;
  if FhWndHeader <> 0 then begin
    SetWindowLong(FhWndHeader, GWL_WNDPROC, LongInt(FhDefHeaderProc));
  end;
  if FhHeaderProc <> nil then begin
    FreeObjectInstance(FhHeaderProc);
  end;
  FreeAndNil(FBoundLabel);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  OnAdvancedCustomDraw := FOldAdvancedCustomDraw;
  inherited Destroy;
end;

procedure TsCustomListView.AfterConstruction;
begin
  Loading := True;
  inherited AfterConstruction;
  try
    FCommonData.Loaded;
  except
    Application.HandleException(Self);
  end;
end;

procedure TsCustomListView.WndProc(var Message: TMessage);
var
  R : TRect;
  SavedDC : hdc;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      Items.BeginUpdate;
      CommonWndProc(Message, FCommonData);
      if not FCommonData.CustomColor then Color := clWindow;
      if not FCommonData.CustomFont then Font.Color := clWindowText;
      if ListSW <> nil then FreeAndNil(ListSW);
      Items.EndUpdate;
      RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_UPDATENOW);
      Exit
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      Items.BeginUpdate;
      CommonWndProc(Message, FCommonData);
      if FCommonData.Skinned and not Loading {v4.66} then begin
        if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
        if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
        if HandleAllocated then UninitializeFlatSB(Handle); // v5.05
        RefreshEditScrolls(SkinData, ListSW);
        RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_UPDATENOW);
        HeaderWndProc(LocalMsg);
      end;
      Items.EndUpdate;
      Exit;
    end;
    AC_ENDPARENTUPDATE : begin
      acPrintDC := 0;
      PaintHeader;
      Exit
    end;
    AC_PREPARING       : begin // 5.40
      Message.LParam := integer(skinData.Updating);
      Exit;
    end;
  end;
  if (csCreating in ControlState) or (FCommonData = nil) or not FCommonData.Skinned then inherited else begin // <- csLoading state is damaged (enabled always)???
    case Message.Msg of
      LVM_SETCOLUMN, LVM_INSERTCOLUMN : with PLVColumn(Message.LParam)^ do begin
        if iImage = - 1 then Mask := Mask and not LVCF_IMAGE;
      end;
      WM_PRINT : begin
        inherited;
        if (ViewStyle = vsReport) and (ListSW <> nil) then begin
          SavedDC := SaveDC(TWMPaint(Message).DC);
          MoveWindowOrg(TWMPaint(Message).DC, ListSW.cxLeftEdge, ListSW.cxLeftEdge);
          IntersectClipRect(TWMPaint(Message).DC, 0, 0,
                            SkinData.FCacheBmp.Width - 2 * ListSW.cxLeftEdge - integer(ListSW.sBarVert.fScrollVisible) * GetScrollMetric(ListSW.sBarVert, SM_CXVERTSB),
                            SkinData.FCacheBmp.Height - 2 * ListSW.cxLeftEdge - integer(ListSW.sBarHorz.fScrollVisible) * GetScrollMetric(ListSW.sBarHorz, SM_CYHORZSB));
          acPrintDC := TWMPaint(Message).DC;
          HeaderWndProc(Message);
          acPrintDC := 0;
          RestoreDC(TWMPaint(Message).DC, SavedDC);
        end;
        Exit;
      end;
      WM_ERASEBKGND : if acPrintDC <> 0 then begin
        TWMPaint(Message).DC := acPrintDC;
        inherited;
      end
      else if FCommonData.Updating then Exit;
      WM_VSCROLL : case Message.WParamLo of
        SB_THUMBTRACK : begin
          if ViewStyle = vsReport then begin
            ListView_GetItemRect(Handle, 0, R, LVIR_BOUNDS);
            ListView_Scroll(Handle, 0, (Message.WParamHi - nLastSBPos) * max(1, HeightOf(R)));
          end
          else ListView_Scroll(Handle, 0, (Message.WParamHi - nLastSBPos));
//ListView_Scroll(Handle, 0, (Message.WParamHi - nLastSBPos) * max(1, integer(ViewStyle = vsReport) * (HeightOf(R))));
          InvalidateSmooth(False);
          Exit;
        end;
        SB_LINELEFT, SB_LINERIGHT : begin
          inherited;
          InvalidateSmooth(False);
          Exit;
        end;
      end;
      WM_HSCROLL : case Message.WParamLo of
        SB_THUMBTRACK : begin
          ListView_Scroll(Handle, Message.WParamHi - nLastSBPos, 0);
          InvalidateSmooth(False);
          PaintHeader;
          Exit;
        end;
        SB_LINELEFT, SB_LINERIGHT : begin
          inherited;
          InvalidateSmooth(False);
          Exit;
        end;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
    if FCommonData.Skinned then case Message.Msg of
      CM_MOUSEWHEEL, WM_MOUSEWHEEL : if (TWMMouseWheel(Message).Keys = 0) then begin
        InvalidateSmooth(False);
      end;
      CN_KEYDOWN, CN_KEYUP : case TWMKey(Message).CharCode of VK_PRIOR..VK_DOWN : InvalidateSmooth(False) end;
      CM_SHOWINGCHANGED : begin
        if HandleAllocated then UninitializeFlatSB(Handle); // v5.05
        RefreshEditScrolls(SkinData, ListSW);
      end;
      WM_STYLECHANGED : if not (csReadingState in ControlState) then begin
        ListView_Scroll(Handle, 0, 0);
        UpdateScrolls(ListSW, True);
      end;
      LVM_DELETEITEM, LVM_REDRAWITEMS,
      LVM_INSERTITEMA : UpdateScrolls(ListSW, True);
      WM_NCPAINT: begin
        PaintHeader;
      end;
      CM_VISIBLECHANGED, CM_ENABLEDCHANGED, WM_MOVE, WM_SIZE, WM_WINDOWPOSCHANGED : if FCommonData.Skinned and not (csDestroying in ComponentState) then begin
        Perform(WM_NCPAINT, 0, 0);
        LocalFlag := True;
        InvalidateSmooth(True);
        LocalFlag := False;
        case Message.Msg of
          WM_MOVE, WM_SIZE : begin
            if FullRepaint then SendMessage(Handle, WM_NCPAINT, 0, 0) // Scrollbars repainting if transparent
          end;
        end;
      end;
    end;
  end;
  // Aligning of the bound label
  if Assigned(BoundLabel) and Assigned(BoundLabel.FtheLabel) then case Message.Msg of
    WM_SIZE, WM_WINDOWPOSCHANGED : begin BoundLabel.AlignLabel end;
    CM_VISIBLECHANGED : begin BoundLabel.FtheLabel.Visible := Visible; BoundLabel.AlignLabel end;
    CM_ENABLEDCHANGED : begin BoundLabel.FtheLabel.Enabled := Enabled; BoundLabel.AlignLabel end;
    CM_BIDIMODECHANGED : begin BoundLabel.FtheLabel.BiDiMode := BiDiMode; BoundLabel.AlignLabel end;
  end;
end;

procedure TsCustomListView.Loaded;
begin
  Loading := True;
  inherited Loaded;
  try
    FCommonData.Loaded;
  except
    Application.HandleException(Self);
  end;
  if FCommonData.Skinned then begin
    if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
    if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
  end;
  Loading := False;
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -