enhlistview.pas

动态提示控件

    function StoreSettings: boolean; virtual;
    function WriteSettings: boolean; virtual;
    function LoadSettings: boolean; virtual;
    function ReadSettings: boolean; virtual;
    procedure DefaultSort(ColumnIndex:integer; Descending: boolean); virtual;
    procedure Resort; virtual;
    // Use these as replacements for Items.BeginUpdate and EndUpdate.  They
    // call those methods, but they also inhibit autosorting until after the
    // last EndUpdate.
    procedure BeginUpdate; virtual;
    procedure EndUpdate; virtual;

    // Resize all columns.
    procedure ResizeColumns(ResizeMethod: TResizeMethod); virtual;

    // Move list item to new position.
    procedure MoveItem(OriginalIndex, NewIndex: Integer); virtual;

    function StringSelect(FindStr: string; ColumnIndex: Integer): boolean; virtual;
    function SubStringSelect(FindStr: string; ColumnIndex: Integer): boolean; virtual;

    // Accounts for re-ordered columns
    property ActualColumn[Index: integer]: TListColumn
       read GetActualColumn;
  published
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
  end;


  TdfsEnhListView = class(TCustomEnhListView)
  public
    property HeaderHandle;
    property CurrentSortAscending;
    property LastColumnClicked;
    property CurrentColumnWidth;
  published
    property AutoColumnSort;
    property AutoSortStyle;
    property AutoResort;
    property AutoSortAscending;
{$IFDEF BACKGROUND_FIXED}
    property BackgroundImage;
{$ENDIF}
    property ColumnSearch;
    property NoColumnResize;
    property ReverseSortArrows;
    property ShowSortArrows;
    property SaveSettings;
    property Style;

    property OnMeasureItem;
    property OnDrawItem;
    property OnDrawSubItem;
    property OnAfterDefaultDrawItem;
    property OnDrawHeader;
    property OnSortItems;
    property OnSortBegin;
    property OnSortFinished;
    property OnEditCanceled;

    { Publish TCustomListView inherited protected properties }
    property Align;
{$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode;
{$ENDIF}
    property BorderStyle;
{$IFDEF DFS_COMPILER_4_UP}
    property BorderWidth;
{$ENDIF}
    property Color;
    property ColumnClick;
    property OnClick;
    property OnDblClick;
    property Columns;
{$IFDEF DFS_COMPILER_4_UP}
    property Constraints;
{$ENDIF}
    property Ctl3D;
{$IFDEF DFS_COMPILER_4_UP}
    property DragKind;
{$ENDIF}
    property DragMode;
    property ReadOnly
       default False;
    property Enabled;
    property Font;
    property HideSelection;
    property IconOptions;
    property Items;
    property AllocBy;
    property MultiSelect;
    property OnChange;
    property OnChanging;
    property OnColumnClick;
    property OnDeletion;
    property OnEdited;
    property OnEditing;
{$IFDEF DFS_COMPILER_4_UP}
    property OnEndDock;
{$ENDIF}
    property OnEnter;
    property OnExit;
    property OnInsert;
    property OnDragDrop;
    property OnDragOver;
    property DragCursor;
    property OnStartDrag;
    property OnEndDrag;
    property OnGetImageIndex;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF DFS_COMPILER_4_UP}
    property OnResize;
    property OnSelectItem;
    property OnStartDock;
{$ENDIF}
    property ParentColor
       default False;
    property ParentFont;
    property ParentShowHint;
{$IFDEF DFS_COMPILER_4_UP}
    property ParentBiDiMode;
{$ENDIF}
    property ShowHint;
    property PopupMenu;
    property ShowColumnHeaders;
    property TabOrder;
    property TabStop
       default True;
    property ViewStyle;
    property Visible;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property LargeImages;
    property SmallImages;
    property StateImages;
  end;

var
  { Default drawing variables }
  DefDraw_TextOffset: integer; // Offset for the text -- 5
  DefDraw_ImageOffset: integer; // Offset for image -- 2


implementation

uses
  Registry, ExtListView;


var
  FDirection,
  FSortColNum: integer;

{$IFNDEF DFS_COMPILER_4_UP}
type
  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := {$IFDEF DFS_COMPILER_2} Pos( {$ELSE} AnsiPos( {$ENDIF} Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;
{$ENDIF}

function IsValidNumber(S: string; var V: extended): boolean;
var
  NumCode: integer;
  FirstSpace: integer;
begin
  FirstSpace := Pos(' ', S);
  if FirstSpace > 0 then
    S := Copy(S, 1, FirstSpace - 1);
  Val(S, V, NumCode);
  Result := (NumCode = 0);
  if not Result then
  begin
    // Remove all thousands seperators
    S := StringReplace(S, ThousandSeparator, '', [rfReplaceAll]);
    // change DecimalSeperator to '.' because Val only recognizes that, not
    // the locale specific decimal char.  Stupid Val.
    S := StringReplace(S, DecimalSeparator, '.', [rfReplaceAll]);
    // and try again
    Val(S, V, NumCode);
    Result := (NumCode = 0);
  End;
end;

// date conversion will fail if using long format, e.g. '1 January 1994'
function IsValidDateTime(const S: string; var D: TDateTime): boolean;
var
  i: integer;
  HasDate: boolean;
  HasTime: boolean;
begin
  // Check for two date seperators.  This is because some regions use a "-"
  //  to seperate dates, so if we just checked for one we would flag negative
  //  numbers as being dates.
  i := Pos(DateSeparator, S);
  HasDate := i > 0;
  if HasDate and (i <> Length(S)) then
    HasDate := Pos(DateSeparator, Copy(S, i+1, Length(S)-i)) > 0;
  HasTime := Pos(TimeSeparator, S) > 0;
  Result := HasDate or HasTime;
  if Result then
  begin
    try
      if HasDate and HasTime then
        D := StrToDateTime(S)
      else if HasDate then
        D := StrToDate(S)
      else if HasTime then
        D := StrToTime(S);
    except
      // Something failed to convert...
      D := 0;
      Result := FALSE;
    end;
  end;
end; { IsValidDateTime }

function __CustomSortProc1__(Item1, Item2: TListItem; Data: integer): integer;
   stdcall;
var
  Str1, Str2: string;
  Val1, Val2: extended;
  Date1, Date2: TDateTime;
  Diff: TDateTime;
begin
  if (Item1 = NIL) or (Item2 = NIL) then
  begin
    // something bad happening, I'm outta here
    Result := 0;
    exit;
  end;

  try
    if FSortColNum = -1 then
    begin
      Str1 := Item1.Caption;
      Str2 := Item2.Caption;
    end else begin
      if FSortColNum < Item1.SubItems.Count then
        Str1 := Item1.SubItems[FSortColNum]
      else
        Str1 := '';
      if FSortColNum < Item2.SubItems.Count then
        Str2 := Item2.SubItems[FSortColNum]
      else
        Str2 := '';
    end;

    if TCustomEnhListView(Data).AutoSortStyle = assSmart then
    begin
      if IsValidDateTime(Str1, Date1) and IsValidDateTime(Str2, Date2) then
      begin
        Diff := Date1 - Date2;
        if Diff < 0.0 then Result := -1
        else if Diff > 0.0 then Result := 1
        else Result := 0
      end else if IsValidNumber(Str1, Val1) and IsValidNumber(Str2, Val2) then
      begin
        if Val1 < Val2 then Result := -1
        else if Val1 > Val2 then Result := 1
        else Result := 0
      end else
        Result := AnsiCompareStr(Str1, Str2);
    end else
      Result := AnsiCompareStr(Str1, Str2);

    Result := FDirection * Result; // Set direction flag.
  except
    Result := 0;  // Something went bad in the comparison.  Say they are equal.
  end;
end;

function __CustomSortProc2__(Item1, Item2: TListItem; Data: integer): integer;
   stdcall;
var
  EvRes: integer;
begin
  EvRes := 0;
  TCustomEnhListView(Data).SortItems(Item1, Item2, FSortColNum, EvRes);
  Result := EvRes * FDirection;
end;



{ TdfsEnhLVSaveSettings }

constructor TdfsEnhLVSaveSettings.Create;
begin
  inherited Create;

  FAutoSave := FALSE;
  FRegistryKey := '';
  FSaveViewStyle := TRUE;
  FSaveColumnSizes := TRUE;
  SaveCurrentSort := TRUE;
end;

procedure TdfsEnhLVSaveSettings.StoreColumnSizes(ColCount: integer;
   const IntArray: array of integer);
var
  Reg: TRegIniFile;
  x: integer;
  s: string;
begin
  if ColCount < 1 then exit;
  s := '';
  for x := 0 to ColCount-1 do
    s := s + IntToStr(IntArray[x]) + ',';
  SetLength(s, Length(s)-1);
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    Reg.WriteString('Columns', 'Sizes', s);
  finally
    Reg.Free;
  end;
end;

procedure TdfsEnhLVSaveSettings.ReadColumnSizes(ColCount: integer;
   var IntArray: array of integer);
var
  Reg: TRegIniFile;
  x,y: integer;
  s: string;
begin
  if ColCount < 1 then exit;
  s := '';
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    s := Reg.ReadString('Columns', 'Sizes', '');
  finally
    Reg.Free;
  end;
  if s = '' then
  begin
    IntArray[0] := -1;
    exit;
  end;
  y := 0;
  for x := 0 to ColCount-1 do
  begin
    try
      y := Pos(',', s);
      if y = 0 then
        y := Length(s)+1;
      IntArray[x] := StrToInt(Copy(s, 1, y-1));
    except
      { Nothing, just eat the exception };
    end;
    s := copy(s, y+1, length(s));
    if s = '' then break;
  end;
end;

procedure TdfsEnhLVSaveSettings.StoreCurrentSort(Ascending: boolean;
   SortCol: integer);
var
  Reg: TRegIniFile;
begin
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    Reg.WriteBool('Sort', 'Ascending', Ascending);
    Reg.WriteInteger('Sort', 'SortCol', SortCol);
  finally
    Reg.Free;
  end;
end;

procedure TdfsEnhLVSaveSettings.ReadCurrentSort(var Ascending: boolean;
   var SortCol: integer);