slv.pas

自己做的通讯录程序

{=============================================================================}
{=                                                                           =}
{=  TSortableListView component                                              =}
{=  Version 0.99 "as is"                                                     =}
{=                                                                           =}
{=  Copyright (c) 1996-97 by Vitaly Furman                                   =}
{=  [e-mail]                                                       =}
{=  http://www.geocities.com/SiliconValley/1593                              =}
{=                                                                           =}
{=  Freeware - for Delphi 2 and 3.                                           =}
{=  Full source code included                                                =}
{=                                                                           =}
{=  If you are interested in component development contact me by E-mail      =}
{=                                                                           =}
{=============================================================================}
unit SLV;

interface

uses
    ComCtrls,
    SysUtils, Classes;

type
    {-- TCustomSortableListView --------------------------------------------}
    TSortStyle = (ssAlpha,ssNumeric,ssDateTime);

    PSortInfo = ^TSortInfo;
    TSortInfo = record
        Col     : Integer;
        Style   : TSortStyle;
        Asc     : Boolean;
    end;

    TCustomSortableListView = class(TCustomListView)
    private
        FSortInfo   : TSortInfo;
        FSorted     : Boolean;

        function    GetSortedColumn: Integer;
        function    GetSortedAscend: Boolean;
        function    GetSortedStyle: TSortStyle;
    public
        procedure   SortByColumn(i: Integer; Style: TSortStyle; Ascending: Boolean);
        procedure   ToggleSortByColumn(i: Integer; Style: TSortStyle);

        property    SortedColumn: Integer read GetSortedColumn;
        property    SortedAscend: Boolean read GetSortedAscend;
        property    SortedStyle: TSortStyle read GetSortedStyle;
    end;

    {-- TSortableListView --------------------------------------------------}
    TSortableListView       = class(TCustomSortableListView)
    published
        property Align;
        property BorderStyle;
        property Color;
        property ColumnClick;
        property OnClick;
        property OnDblClick;
        property Columns;
        property Ctl3D;
        property DragMode;
        property ReadOnly;
        property Font;
        property HideSelection;
        property IconOptions;
        property Items;
        property AllocBy;
        property MultiSelect;
        property OnChange;
        property OnChanging;
        property OnColumnClick;
        property OnCompare;
        property OnDeletion;
        property OnEdited;
        property OnEditing;
        property OnEnter;
        property OnExit;
        property OnInsert;
        property OnDragDrop;
        property OnDragOver;
        property DragCursor;
        property OnStartDrag;
        property OnEndDrag;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property ParentShowHint;
        property ShowHint;
        property PopupMenu;
        property ShowColumnHeaders;
        property SortType;
        property TabOrder;
        property TabStop default True;
        property ViewStyle;
        property Visible;
        property OnKeyDown;
        property OnKeyPress;
        property OnKeyUp;
        property LargeImages;
        property SmallImages;
        property StateImages;
    end;

{-----------------------------------------------------------------------}
procedure   Register;

implementation

{-----------------------------------------------------------------------}
function    Compare(I1, I2: TListItem; Data: Integer): Integer; stdcall;
var
    V1, V2: string;

    function    Sign(Val: Extended): Integer;
    begin
        if Val < 0 then
            Result := -1
        else if Val > 0 then
            Result := 1
        else
            Result := 0;
    end;

    function    ExtractNum(const S: string): string;
    var
        i, j: Integer;
    begin
        j := 0;
        for i := 1 to Length(S) do
            if S[i] in ['0'..'9'] then
                Inc(j)
            else
                Break;
        if j = 0 then
            Result := '0'
        else
            Result := Copy(S,1,j);
    end;
begin
    with PSortInfo(Data)^ do
    begin

        if Col = 0 then
        begin
            V1 := I1.Caption;
            V2 := I2.Caption;
        end
        else
        begin
            V1 := I1.SubItems[Col-1];
            V2 := I2.SubItems[Col-1];
        end;

        case Style of
            ssAlpha     : Result := AnsiCompareText(V1,V2);
            ssNumeric   : Result := Sign(StrToFloat(ExtractNum(V1))-StrToFloat(ExtractNum(V2)));
            ssDateTime  : Result := Sign(StrToDateTime(V1) - StrToDateTime(V2));
        else
            Result := 0; // To prevent compiler warning
        end;

        if not Asc then
            Result := -Result;
    end;
end;

{-- TCustomSortableListView --------------------------------------------}
procedure   TCustomSortableListView.SortByColumn(i: Integer; Style: TSortStyle; Ascending: Boolean);
begin
    FSortInfo.Col   := i;
    FSortInfo.Style := Style;
    FSortInfo.Asc   := Ascending;
    CustomSort(@Compare,LongInt(@FSortInfo));
    FSorted := True;
end;

{-- TCustomSortableListView --------------------------------------------}
procedure   TCustomSortableListView.ToggleSortByColumn(i: Integer; Style: TSortStyle);
begin
    if SortedColumn = i then
        SortByColumn(i,Style,not SortedAscend)
    else
        SortByColumn(i,Style,True);
end;

{-- TCustomSortableListView --------------------------------------------}
function    TCustomSortableListView.GetSortedColumn: Integer;
begin
    if FSorted then
        Result := FSortInfo.Col
    else
        Result := -1;
end;

{-- TCustomSortableListView --------------------------------------------}
function    TCustomSortableListView.GetSortedAscend: Boolean;
begin
    Result := FSortInfo.Asc;
end;

{-- TCustomSortableListView --------------------------------------------}
function    TCustomSortableListView.GetSortedStyle: TSortStyle;
begin
    Result := FSortInfo.Style;
end;

{-----------------------------------------------------------------------}
procedure   Register;
begin
    RegisterComponents('ActiveX',[TSortableListView]);
end;

end.