suilistview.pas

SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIListView.pas
//  Creator     :   Shen Min
//  Date        :   2002-10-03 V1-V3
//                  2003-07-04 V4
//                  2006-06-06 V6
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUIListView;

interface

{$I SUIPack.inc}

uses Windows, SysUtils, Classes, Controls, ComCtrls, Graphics, Messages, Forms,
     CommCtrl, ImgList, SUIThemes, SUIMgr, SUIScrollBar, SUI2Define;

type
    TsuiListView = class(TCustomListView)
    private
        m_BorderColor : TColor;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_Header : THandle;
        m_OldProc : Pointer;
        m_HeaderFontColor : TColor;
        m_HeaderColor : TColor;
        m_SelfChanging2 : Boolean;

        // scroll bar
        m_VScrollBar : TsuiScrollBar;
        m_HScrollBar : TsuiScrollBar;
        m_MouseDown : Boolean;
        m_SelfChanging : Boolean;
        procedure SetVScrollBar(const Value: TsuiScrollBar);
        procedure SetHScrollBar(const Value: TsuiScrollBar);
        procedure OnVScrollBarChange(Sender : TObject);
        procedure OnHScrollBarChange(Sender : TObject);

        procedure UpdateScrollBarsPos();
        procedure UpdateScrollBars();        

        procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
        procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
        procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
        procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
        procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
        procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
        procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
        procedure WMDELETEITEM(var Msg : TMessage); message WM_DELETEITEM;
        procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
        procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
        procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;

        procedure SetBorderColor(const Value: TColor);
        procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
        procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure WMSETREDRAW(var Msg : TMessage); message WM_SETREDRAW;
        procedure HeaderWndProc(var Message: TMessage);
        procedure PaintHeader();

        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetFileTheme(const Value: TsuiFileTheme);

    protected
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure Loaded(); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;

        // scroll bar
        property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
        property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;

        property Action;
        property Align;
        property AllocBy;
        property Anchors;
        property BevelEdges;
        property BevelInner;
        property BevelOuter;
        property BevelKind default bkNone;
        property BevelWidth;
        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;

    end;


implementation

uses SUIPublic, SUIProgressBar;

{ TsuiListView }

procedure TsuiListView.CMEnabledChanged(var Msg: TMessage);
begin
    inherited;
    UpdateScrollBars();
end;

procedure TsuiListView.CMVisibleChanged(var Msg: TMEssage);
begin
    inherited;

    if not Visible then
    begin
        if m_VScrollBar <> nil then
            m_VScrollBar.Visible := Visible;
        if m_HScrollBar <> nil then
            m_HScrollBar.Visible := Visible;
    end
    else
        UpdateScrollBarsPos();
end;

constructor TsuiListView.Create(AOwner: TComponent);
begin
    inherited;

    ControlStyle := ControlStyle + [csOpaque];
    BorderStyle := bsNone;
    BorderWidth := 2;
    m_SelfChanging := false;
    m_SelfChanging2 := false;
    m_MouseDown := false;

    UIStyle := GetSUIFormStyle(AOwner);
end;

procedure TsuiListView.HeaderWndProc(var Message: TMessage);
var
    ps : tagPaintStruct;
begin
    if Message.Msg = WM_PAINT then
    begin
        BeginPaint(m_Header, ps);
        PaintHeader();
        EndPaint(m_Header, ps);
        Exit;
    end;

    if Assigned(m_OldProc) then
        Message.Result := CallWindowProc(
            m_OldProc, m_Header, Message.Msg, Message.WParam, Message.LParam
        );

    if Message.Msg = HDM_SETITEM then
    begin
        PaintHeader();
    end;

    if (Message.Msg = WM_WINDOWPOSCHANGING) and (not m_SelfChanging2) then
        UpdateScrollBars();
end;

procedure TsuiListView.Loaded;
begin
    inherited;
    m_Header := ListView_GetHeader(Handle);
    m_OldProc := Pointer(GetWindowLong(m_Header, GWL_WNDPROC));
    SetWindowLong(m_Header, GWL_WNDPROC, Integer({$IFDEF SUIPACK_D6UP}Classes.{$ENDIF}MakeObjectInstance(HeaderWndProc)));
end;

procedure TsuiListView.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if (
        (Operation = opRemove) and
        (AComponent = m_VScrollBar)
    )then
        m_VScrollBar := nil;

    if (
        (Operation = opRemove) and
        (AComponent = m_HScrollBar)
    )then
        m_HScrollBar := nil;
        
    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);          
    end;
end;

procedure TsuiListView.OnHScrollBarChange(Sender: TObject);
begin
    if m_SelfChanging then
        Exit;
    m_SelfChanging2 := true;
    Scroll(m_HScrollBar.LastChange, 0);
    m_SelfChanging2 := false;    
end;

procedure TsuiListView.OnVScrollBarChange(Sender: TObject);
var
    i : Integer;
    LastChange : Integer;
begin
    if m_SelfChanging then
        Exit;
    if ViewStyle = vsReport then
    begin
        LastChange := m_VScrollBar.LastChange;
        if LastChange > 0 then
        begin
            for i := 0 to LastChange - 1 do
                SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_LINEDOWN, 0), 0);
        end
        else
        begin
            for i := LastChange + 1 to 0 do
                SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_LINEUP, 0), 0);
        end;
        Invalidate;
    end
    else
        Scroll(0, m_VScrollBar.LastChange)
end;

function FormatStringWithWidth(Canvas: TCanvas; const szPath: string; nWidth: Integer): string;
var
    nNewWidth: Integer;
    nLeftPos : Integer;
begin
    Result := szPath;
    nNewWidth := Canvas.TextWidth(Result);
    if (nNewWidth <= nWidth) then
        exit;
    nLeftPos := 1;

    while (nLeftPos < Length(szPath)) do
    begin
        Result := Copy(szPath, 1, nLeftPos) + '...';

        nNewWidth := Canvas.TextWidth(Result);
        if (nNewWidth >= nWidth) then
            exit;

        inc(nLeftPos);
    end;

    Result := szPath;
end;

procedure TsuiListView.PaintHeader;
var
    HR, R, TR : TRect;
    Canvas : TCanvas;
    i : Integer;
    L : Integer;
    imgList : TCustomImageList;
    Cur : TListColumn;
    Top, Left : Integer;
    Cap : String;
    W : Integer;
begin
    GetWindowRect(m_Header, HR);
    HR.TopLeft := ScreenToClient(HR.TopLeft);
    HR.BottomRight := ScreenToClient(HR.BottomRight);
    Canvas := TCanvas.Create();
    Canvas.Handle := GetWindowDC(m_Header);

    L := 0;
    Canvas.Font.Color := m_HeaderFontColor;
    for i := 0 to Columns.Count - 1 do
    begin
        SendMessage(m_Header, HDM_GETITEMRECT, i, Integer(@R));
        Canvas.Brush.Color := m_HeaderColor;
        Canvas.FillRect(R);

        imgList := SmallImages;
        if imgList <> nil then
            Top := ((R.Bottom - R.Top) - imgList.Height) div 2
        else
            Top := 0;
        Cur := Column[i];
        Canvas.Brush.Style := bsClear;
        // draw text and image
        if Cur.Alignment = taLeftJustify then
        begin
            Left := R.Left + 4;
            if (imgList <> nil) and (Cur.ImageIndex > -1) then
            begin
                imgList.Draw(Canvas, Left, Top, Cur.ImageIndex);
                Inc(Left, imgList.Width + 2);
            end;
        end
        else if Cur.Alignment = taRightJustify then
        begin