enhlistview.pas

动态提示控件

var
  Reg: TRegIniFile;
begin
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    Ascending := Reg.ReadBool('Sort', 'Ascending', TRUE);
    SortCol := Reg.ReadInteger('Sort', 'SortCol', 0);
  finally
    Reg.Free;
  end;
end;

procedure TdfsEnhLVSaveSettings.StoreViewStyle(Style: TViewStyle);
const
  STYLE_VAL: array[TViewStyle] of integer = (0, 1, 2, 3);
var
  Reg: TRegIniFile;
begin
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    Reg.WriteInteger('ViewStyle', 'ViewStyle', STYLE_VAL[Style]);
  finally
    Reg.Free;
  end;
end;

function TdfsEnhLVSaveSettings.ReadViewStyle(Default: TViewStyle): TViewStyle;
const
  STYLES: array[0..3] of TViewStyle = (vsIcon, vsSmallIcon, vsList, vsReport);
var
  Reg: TRegIniFile;
  i: integer;
begin
  Reg := TRegIniFile.Create(FRegistryKey);
  try
    i := Reg.ReadInteger('ViewStyle', 'ViewStyle', -1);
    if (i >= Low(STYLES)) and (i <= High(STYLES)) then
      Result := STYLES[i]
    else
      Result := Default;
  finally
    Reg.Free;
  end;
end;


// Override constructor to "zero out" our internal variable.
constructor TCustomEnhListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSearchStr := '';
  FSearchTickCount := 0;
  FHeaderHandle := 0;
  FSortDirty := FALSE;
  FUpdateCount := 1; // inhibit sorting until finished creating.
  FSaveSettings := TdfsEnhLVSaveSettings.Create;
  FAutoColumnSort := acsNoSort;
  FAutoResort := TRUE;
  FAutoSortStyle := assSmart;
  FAutoSortAscending := TRUE;
  FTmpAutoSortAscending := FAutoSortAscending;
  FLastColumnClicked := -1;
  FCanvas := NIL;
  FStyle  := lvStandard;
  FSortUpBmp := NIL;
  FSortDownBmp := NIL;
  FShowSortArrows := FALSE;
  FReverseSortArrows := FALSE;
{$IFDEF BACKGROUND_FIXED}
  FBackgroundImage := TBitmap.Create;
{$ENDIF}
  FHeaderInstance := MakeObjectInstance(HeaderWndProc);
end;

destructor TCustomEnhListView.Destroy;
begin
{$IFDEF BACKGROUND_FIXED}
  FBackgroundImage.Free;
{$ENDIF}
  FSortUpBmp.Free;
  FSortDownBmp.Free;
  FCanvas.Free;
  if FHeaderHandle <> 0 then
    SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FOldHeaderWndProc));
  FreeObjectInstance(FHeaderInstance);

  inherited Destroy;

  FSaveSettings.Free;
end;

procedure TCustomEnhListView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  if (FStyle = lvOwnerDrawFixed) then
  begin
    Params.Style := Params.Style or LVS_OWNERDRAWFIXED;
    if FCanvas = NIL then
      FCanvas := TCanvas.Create;
  end else begin
    if (not assigned(FOnDrawHeader)) and (not FShowSortArrows) then
    begin
      FCanvas.Free;
      FCanvas := NIL;
    end;
  end;
end;

procedure TCustomEnhListView.CreateWnd;
begin
//  if FCreatingWindowHandle then exit;

  FCreatingWindowHandle := TRUE;
  try
    inherited CreateWnd;
    // If we are loading object from stream (form file), we have to wait until
    // everything is loaded before populating the list.  If we are not loading,
    // i.e. the component was created dynamically or was just dropped on a form,
    // we need to reset the flag now.
    if not (csLoading in ComponentState) then
      FUpdateCount := 0;

    // Something very bizarre happens in either TCustomListView or in the
    // list view code itself in COMCTL32.DLL:  The first WM_MEASUREITEM value
    // is not honored if the listview has small images assigned to it.  Instead
    // the value is ignored and the height of the images are used.  I found that
    // by forcing Windows to ask for the item height a second time, it would
    // honor the value then.
    if Style = lvOwnerDrawFixed then
      ResetOwnerDrawHeight;
  finally
    FCreatingWindowHandle := FALSE;
  end;
end;

procedure TCustomEnhListView.Loaded;
begin
  inherited Loaded;

{$IFDEF BACKGROUND_FIXED}
  BackgroundImageChanged(Self);
{$ENDIF}

  if not FCreatingWindowHandle then
    HandleNeeded;

  FUpdateCount := 0;

  if (not LoadSettings) or (not SaveSettings.SaveCurrentSort) then
  begin
    if Columns.Count > 0 then
      FLastColumnClicked := 0;
    Resort;
  end;

  // Something flaky going on.  Hard to explain, but this clears it up.
  PostMessage(Handle, WM_OWNERDRAWCOLUMNS, 0, 0);
end;

procedure TCustomEnhListView.WMDestroy(var Message: TWMDestroy);
begin
  StoreSettings;

  inherited;
end;


function TCustomEnhListView.StoreSettings: boolean;
begin
  if FSaveSettings.AutoSave and
     (([csDesigning, csLoading, csReading] * ComponentState) = []) then
    Result := WriteSettings
  else
    Result := FALSE;
end;

function TCustomEnhListView.WriteSettings: boolean;
var
  ColCount: integer;
  ColArray: PIntArray;
  x: integer;
begin
  Result := TRUE;
  ColCount := Columns.Count;
  if ColCount > 0 then
  begin
    GetMem(ColArray, SizeOf(Integer)*ColCount);
    try
      if FSaveSettings.SaveColumnSizes then
      begin
        for x := 0 to ColCount-1 do
          ColArray[x] := ActualColumn[x].Width;
        FSaveSettings.StoreColumnSizes(ColCount, ColArray^);
      end;
      if FSaveSettings.SaveCurrentSort then
        FSaveSettings.StoreCurrentSort(CurrentSortAscending, LastColumnClicked);
      if FSaveSettings.SaveViewStyle then
        FSaveSettings.StoreViewStyle(ViewStyle);
    finally
      FreeMem(ColArray);
    end;
  end;
end;

function TCustomEnhListView.LoadSettings: boolean;
begin
  if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then
    Result := ReadSettings
  else
    Result := FALSE;
end;

function TCustomEnhListView.ReadSettings: boolean;
var
  ColCount: integer;
  ColArray: PIntArray;
  x: integer;
  SortCol: integer;
  SortAscending: boolean;
begin
  Result := TRUE;
  ColCount := Columns.Count;
  if ColCount > 0 then
  begin
    GetMem(ColArray, SizeOf(Integer)*ColCount);
    try
      if FSaveSettings.SaveColumnSizes then
      begin
        for x := 0 to ColCount-1 do
          ColArray[x] := ActualColumn[x].Width;
        FSaveSettings.ReadColumnSizes(ColCount, ColArray^);
        if ColArray[0] <> -1 then
          for x := 0 to ColCount-1 do
            ActualColumn[x].Width := ColArray[x];
      end;
    finally
      FreeMem(ColArray);
    end;
  end;

  if FSaveSettings.SaveCurrentSort then
  begin
    FSaveSettings.ReadCurrentSort(SortAscending, SortCol);
    if SortCol >= Columns.Count then
      SortCol := Columns.Count-1;
    if SortCol < 0 then
      SortCol := 0;
    BeginUpdate;
    try
      CurrentSortAscending := SortAscending;
      LastColumnClicked := SortCol;
      Resort;
    finally
      EndUpdate;
    end;
  end;

  if FSaveSettings.SaveViewStyle then
    ViewStyle := FSaveSettings.ReadViewStyle(ViewStyle);
end;

procedure TCustomEnhListView.DoSort(ColumnIndex:integer; Descending: boolean);
begin
  FSortDirty := FALSE;
  LastColumnClicked := ColumnIndex;
  SortBegin(ColumnIndex, not Descending);
  if Descending then
    FDirection := 1
  else
    FDirection := -1;
  FSortColNum := ColumnIndex - 1;
  if assigned(FOnSortItems) then
    CustomSort(@__CustomSortProc2__, integer(Self))
  else
    CustomSort(@__CustomSortProc1__, integer(Self));
  SortFinished(ColumnIndex, not Descending);
end;

procedure TCustomEnhListView.DefaultSort(ColumnIndex: integer;
   Descending: boolean);
begin
  // Check if the sort order should be toggled
  if FAutoColumnSort = acsSortToggle then
    if LastColumnClicked = ColumnIndex then
      FTmpAutoSortAscending := not Descending
    else
      FTmpAutoSortAscending := Descending;

  InvalidateColumnHeader(ColumnIndex);
  DoSort(ColumnIndex, Descending);
end;

procedure TCustomEnhListView.SortItems(const Item1, Item2: TListItem;
   SortColumn: integer; var CompResult: integer);
var
  SortAs: TSortAs;
  Str1, Str2: string;
  F1, F2: extended;
  Date1, Date2, Diff: TDateTime;
begin
  // The only way to get in here is if FOnSortItems is assigned, so don't bother
  //  checking for NIL
  SortAs := saNone;
  FonSortItems(Self, Item1, Item2, SortColumn, SortAs, CompResult);
  // Do they want us to sort it?
  if SortAs <> saNone then
  begin
    if SortColumn = -1 then
    begin
      Str1 := Item1.Caption;
      Str2 := Item2.Caption;
    end else begin
      if SortColumn < Item1.SubItems.Count then
        Str1 := Item1.SubItems[SortColumn]
      else
        Str1 := '';
      if SortColumn < Item2.SubItems.Count then
        Str2 := Item2.SubItems[SortColumn]
      else
        Str2 := '';
    end;

    case SortAs of
      saString: CompResult := AnsiCompareStr(Str1, Str2);
      saNumeric:
        begin
          if not IsValidNumber(Str1, F1) then
            F1 := 0;
          if not IsValidNumber(Str2, F2) then
            F2 := 0;
          if F1 < F2 then CompResult := -1
          else if F1 > F2 then CompResult := 1
          else CompResult := 0;
        end;
      saDateTime:
        begin
          if not IsValidDateTime(Str1, Date1) then
            Date1 := 0;
          if not IsValidDateTime(Str2, Date2) then
            Date1 := 0;
          Diff := Date1 - Date2;
          if Diff < 0.0 then CompResult := -1
          else if Diff > 0.0 then CompResult := 1
          else CompResult := 0
        end;
    end;
  end;
end;

procedure TCustomEnhListView.SortBegin(ColumnIndex: integer;
   Ascending: boolean);
begin
  if assigned(FOnSortBegin) then
    FOnSortBegin(Self, ColumnIndex, Ascending);
end;

procedure TCustomEnhListView.SortFinished(ColumnIndex: integer;
   Ascending: boolean);
begin
  if assigned(FOnSortFinished) then
    FOnSortFinished(Self, ColumnIndex, Ascending);
end;

procedure TCustomEnhListView.ColClick(Column: TListColumn);
begin
  // Check if the sort order should be toggled
  if FAutoColumnSort = acsSortToggle then
    if LastColumnClicked = Column.Index then
      FTmpAutoSortAscending := not FTmpAutoSortAscending
    else
      FTmpAutoSortAscending := FAutoSortAscending;

  inherited ColClick(Column);

  if (FAutoColumnSort <> acsNoSort) and (Column.Index < Columns.Count) then
    DoSort(Column.Index, FTmpAutoSortAscending);

  LastColumnClicked := Column.Index;
end;

{$IFDEF DFS_FIXED_LIST_VIEW}
procedure TCustomEnhListView.InsertItem(Item: TListItem);
begin
  inherited InsertItem(Item);
  if FAutoResort then
    Resort;
end;
{$ENDIF}


procedure TCustomEnhListView.Edit(const Item: TLVItem);
begin
  inherited Edit(Item);
  if FAutoResort then
    Resort;
end;

type
  THackListItems = class(TListItems)
  end;

procedure TCustomEnhListView.EditCanceled(const Item: TLVItem);
begin
  if assigned(FOnEditCanceled) then
    with Item do
      FOnEditCanceled(Self, THackListItems(Items).GetItem(iItem));
end;