jvlistview.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvListView.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is S閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvListView.pas,v 1.50 2005/03/09 14:57:27 marquardt Exp $

unit JvListView;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ComCtrls, CommCtrl, Menus, ImgList, Clipbrd,
  JvTypes, JvExComCtrls, JvAppStorage;

const
  WM_AUTOSELECT = WM_USER + 1;

type
  EJvListViewError = EJVCLException;
  //  TJvSortMethod = (smAutomatic, smAlphabetic, smNonCaseSensitive, smNumeric, smDate, smTime, smDateTime, smCurrency);
  TJvOnProgress = procedure(Sender: TObject; Progression, Total: Integer) of object;

  TJvListItems = class(TListItems, IJvAppStorageHandler, IJvAppStoragePublishedProps)
  private
    FOwnerInterface: IInterface;
  protected
    { IInterface }
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IJvAppStorageHandler }
    procedure ReadFromAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
    procedure WriteToAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);

    { List item reader used in the call to ReadList. }
    procedure ReadListItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const Index: Integer; const ItemName: string);
    { List item writer used in the call to WriteList. }
    procedure WriteListItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const Index: Integer; const ItemName: string);
    { List item deleter usedin the call to WriteList. }
    procedure DeleteListItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const First, Last: Integer; const ItemName: string);
  public
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
    procedure AfterConstruction; override;
  end;

  TJvListItem = class(TListItem)
  private
    FPopupMenu: TPopupMenu;
    FBold: Boolean;
  protected
    procedure SetPopupMenu(const Value: TPopupMenu);
  public
    constructor CreateEnh(AOwner: TListItems; const Popup: TPopupMenu);
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  published
    // Published now for the usage of AppStorage.Read/WritePersistent
    property Caption;
    property Checked;
    property Selected;
    property SubItems;
  end;

  // (rom) Why that? C++ Builder should need this class.
  {$EXTERNALSYM TJvListItem}

  TJvListView = class(TJvExListView)
  private
    FAutoClipboardCopy: Boolean;
    FSortOnClick: Boolean;
    FLast: Integer;
    FOnSaveProgress: TJvOnProgress;
    FOnLoadProgress: TJvOnProgress;
    FOnAutoSort: TJvListViewColumnSortEvent;
    FSortMethod: TJvSortMethod;
    FOnHorizontalScroll: TNotifyEvent;
    FOnVerticalScroll: TNotifyEvent;
    FImageChangeLink: TChangeLink;
    FHeaderImages: TCustomImageList;
    FAutoSelect: Boolean;
    FPicture: TPicture;
    procedure DoPictureChange(Sender: TObject);
    procedure SetPicture(const Value: TPicture);
    procedure SetHeaderImages(const Value: TCustomImageList);
    procedure UpdateHeaderImages(HeaderHandle: Integer);
    procedure WMAutoSelect(var Msg: TMessage); message WM_AUTOSELECT;
    {$IFDEF COMPILER5}
    function GetItemIndex: Integer;
    procedure SetItemIndex(const Value: Integer);
    {$ENDIF COMPILER5}
  protected
    function CreateListItem: TListItem; override;
    function CreateListItems: TListItems; {$IFDEF COMPILER6_UP} override; {$ENDIF}
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetColumnsOrder: string;
    procedure SetColumnsOrder(const Order: string);
    procedure SetItemPopup(Node: TListItem; Value: TPopupMenu);
    function GetItemPopup(Node: TListItem): TPopupMenu;
    procedure CreateWnd; override;
    procedure DoHeaderImagesChange(Sender: TObject);
    procedure Loaded; override;
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;

    procedure InsertItem(Item: TListItem); override;
    function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; {$IFDEF COMPILER6_UP} override; {$ENDIF}
    function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ColClick(Column: TListColumn); override;
    procedure SaveToStrings(Strings: TStrings; Separator: Char);
    procedure LoadFromStrings(Strings: TStrings; Separator: Char);
    procedure SaveToFile(FileName: string; ForceOldStyle: Boolean = False);
    procedure LoadFromFile(FileName: string);
    procedure SaveToStream(Stream: TStream; ForceOldStyle: Boolean = False);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToCSV(FileName: string; Separator: Char = ';');
    procedure LoadFromCSV(FileName: string; Separator: Char = ';');
    procedure SetSmallImages(const Value: TCustomImageList);
    {$IFDEF COMPILER5}
    procedure SelectAll;
    procedure DeleteSelected;
    {$ENDIF COMPILER5}
    procedure UnselectAll;
    procedure InvertSelection;
    function MoveUp(Index: Integer; Focus: Boolean = True): Integer;
    function MoveDown(Index: Integer; Focus: Boolean = True): Integer;
    function SelectNextItem(Focus: Boolean = True): Integer;
    function SelectPrevItem(Focus: Boolean = True): Integer;

    property ItemPopup[Item: TListItem]: TPopupMenu read GetItemPopup write SetItemPopup;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
    procedure SetFocus; override;
    {$IFDEF COMPILER5}
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    {$ENDIF COMPILER5}
  published
    property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
    property ColumnsOrder: string read GetColumnsOrder write SetColumnsOrder;
    property HintColor;
    property Picture: TPicture read FPicture write SetPicture;
    property HeaderImages: TCustomImageList read FHeaderImages write SetHeaderImages;
    property SortMethod: TJvSortMethod read FSortMethod write FSortMethod default smAutomatic;
    property SortOnClick: Boolean read FSortOnClick write FSortOnClick default True;
    property SmallImages write SetSmallImages;
    property AutoClipboardCopy: Boolean read FAutoClipboardCopy write FAutoClipboardCopy default True;
    property OnAutoSort: TJvListViewColumnSortEvent read FOnAutoSort write FOnAutoSort;
    property OnHorizontalScroll: TNotifyEvent read FOnHorizontalScroll write FOnHorizontalScroll;
    property OnLoadProgress: TJvOnProgress read FOnLoadProgress write FOnLoadProgress;
    property OnSaveProgress: TJvOnProgress read FOnSaveProgress write FOnSaveProgress;
    property OnVerticalScroll: TNotifyEvent read FOnVerticalScroll write FOnVerticalScroll;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvListView.pas,v $';
    Revision: '$Revision: 1.50 $';
    Date: '$Date: 2005/03/09 14:57:27 $';
    LogPath: 'JVCL\run'
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  Math,
  JvJCLUtils, JvConsts, JvResources;

//=== { TJvListItem } ========================================================

const
  // (rom) increased from 100
  cColumnsHandled = 1024;

constructor TJvListItem.CreateEnh(AOwner: TListItems; const Popup: TPopupMenu);
begin
  inherited Create(AOwner);
  FBold := False;
  FPopupMenu := Popup; // (Salvatore) Get it from the JvListView
end;

procedure TJvListItem.SetPopupMenu(const Value: TPopupMenu);
begin
  FPopupMenu := Value;
end;

//=== { TJvListItems } =======================================================

procedure TJvListItems.AfterConstruction;
begin
  inherited AfterConstruction;
  if GetOwner <> nil then
    GetOwner.GetInterface(IInterface, FOwnerInterface);
end;

function TJvListItems._AddRef: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._AddRef
  else
    Result := -1;
end;

function TJvListItems._Release: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._Release
  else
    Result := -1;
end;

function TJvListItems.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
  E_NOINTERFACE = HRESULT($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TJvListItems.ReadFromAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
begin
  BeginUpdate;
  try
    Clear;
    AppStorage.ReadList(BasePath, Self, ReadListItem, cItem);
  finally
    EndUpdate;
  end;
end;

procedure TJvListItems.WriteToAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
begin
  AppStorage.WriteList(BasePath, Self, Count, WriteListItem, DeleteListItem, cItem);
end;

procedure TJvListItems.ReadListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  NewItem: TPersistent;
  NewPath: string;
begin
  if List is TJvListItems then
    try
      NewPath := Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]);
      NewItem := TJvListItems(List).Add;
      Sender.ReadPersistent(NewPath, NewItem);
    except
    end;
end;

procedure TJvListItems.WriteListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
begin
  if List is TJvListItems then
    if Assigned(TJvListItems(List)[Index]) then
      Sender.WritePersistent(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]), TPersistent(TJvListItems(List)[Index]));
end;

procedure TJvListItems.DeleteListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  if List is TJvListItems then
    for I := First to Last do
      Sender.DeleteValue(Sender.ConcatPaths([Path, ItemName + IntToStr(I)]));
end;

//=== { TJvListView } ========================================================

const
  cLISTVIEW01 = 'LISTVIEW01';

constructor TJvListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSortOnClick := True;
  FSortMethod := smAutomatic;
  FLast := -1;
  FAutoClipboardCopy := True;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := DoHeaderImagesChange;
  FAutoSelect := True;
  FPicture := TPicture.Create;
  FPicture.OnChange := DoPictureChange;
end;

destructor TJvListView.Destroy;
begin
  FImageChangeLink.Free;
  FPicture.Free;
  inherited Destroy;
end;

procedure TJvListView.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  UpdateHeaderImages(ListView_GetHeader(Handle));
  if Assigned(FOnHorizontalScroll) then
    FOnHorizontalScroll(Self);
end;

procedure TJvListView.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  UpdateHeaderImages(ListView_GetHeader(Handle));
  if Assigned(FOnVerticalScroll) then
    FOnVerticalScroll(Self);
end;

procedure TJvListView.ColClick(Column: TListColumn);
type
  TParamSort = record
    Index: Integer;
    Sender: TObject;
  end;
var
  Parm: TParamSort;

  function CustomCompare1(Item1, Item2, ParamSort: Integer): Integer stdcall;
  var
    Parm: TParamSort;
    i1, i2: TListItem;
    S1, S2: string;
    I: Integer;
    SortKind: TJvSortMethod;

    function IsBigger(First, Second: string; SortType: TJvSortMethod): Boolean;
    var
      I, J: Real;
      d, e: TDateTime;
      a, b: Currency;
      l, m: Int64;
      st, st2: string;
      int1, int2: Integer;

      function FirstNonAlpha(Value: string): Integer;
      var
        Len: Integer;
        I, J: Integer;
        Comma: Boolean;
      begin
        Len := Length(Value);
        I := 1;
        J := 0;
        Comma := False;

        while I <= Len do
        begin
          case Value[I] of
            '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
              J := I;
            ',', '.':
              if not Comma then
                Comma := True
              else
              begin
                J := I - 1;
                I := Len;
              end;
          else
            begin
              J := I - 1;
              I := Len;
            end;
          end;
          Inc(I);
        end;

        Result := J;
      end;

    begin
      Result := False;
      if Trim(First) = '' then
        Result := False
      else
        if Trim(Second) = '' then
          Result := True
        else
        begin
          case SortType of
            smAlphabetic:
              Result := First > Second;
            smNonCaseSensitive:
              Result := UpperCase(First) > UpperCase(Second);
            smNumeric:
              begin
                try
                  I := StrToFloat(First);
                  J := StrToFloat(Second);
                  Result := I > J;
                except
                  try
                    l := StrToInt64(First);
                  except
                    l := 0;
                  end;
                  try
                    m := StrToInt64(Second);
                  except
                    m := 0;
                  end;
                  Result := l > m;
                end;
              end;
            smDate:
              begin
                d := StrToDate(First);
                e := StrToDate(Second);
                Result := d > e;
              end;
            smTime:
              begin
                d := StrToTime(First);
                e := StrToTime(Second);
                Result := d > e;
              end;
            smDateTime:
              begin
                d := StrToDateTime(First);
                e := StrToDateTime(Second);
                Result := d > e;
              end;
            smCurrency:
              begin
                a := StrToCurr(First);
                b := StrToCurr(Second);
                Result := a > b;
              end;
            smAutomatic:
              begin
                int1 := FirstNonAlpha(First);
                int2 := FirstNonAlpha(Second);
                if (int1 <> 0) and (int2 <> 0) then
                begin
                  st := Copy(First, 1, int1);
                  st2 := Copy(Second, 1, int2);
                  try
                    Result := StrToFloat(st) > StrToFloat(st2);