tntcomctrls.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

    FxxxMultiSelect: Boolean;
    FxxxSortType: TSortType;
    FxxxColumnClick: Boolean;
    FxxxShowColumnHeaders: Boolean;
    FxxxListItems: TListItems{TNT-ALLOW TListItems};
    FxxxClicked: Boolean;
    FxxxRClicked: Boolean;
    FxxxIconOptions: TIconOptions;
    FxxxHideSelection: Boolean;
    FListColumns: TListColumns{TNT-ALLOW TListColumns};
  end;
{$ENDIF}
{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
type
  THackCustomListView = class(TCustomMultiSelectListControl)
  protected
    FxxxCanvas: TCanvas;
    FxxxBorderStyle: TBorderStyle;
    FxxxViewStyle: TViewStyle;
    FxxxReadOnly: Boolean;
    FxxxLargeImages: TCustomImageList;
    FxxxSmallImages: TCustomImageList;
    FxxxStateImages: TCustomImageList;
    FxxxDragImage: TDragImageList;
    FxxxMultiSelect: Boolean;
    FxxxSortType: TSortType;
    FxxxColumnClick: Boolean;
    FxxxShowColumnHeaders: Boolean;
    FxxxListItems: TListItems{TNT-ALLOW TListItems};
    FxxxClicked: Boolean;
    FxxxRClicked: Boolean;
    FxxxIconOptions: TIconOptions;
    FxxxHideSelection: Boolean;
    FListColumns: TListColumns{TNT-ALLOW TListColumns};
  end;
{$ENDIF}
{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
type
  THackCustomListView = class(TCustomMultiSelectListControl)
  protected
    FxxxCanvas: TCanvas;
    FxxxBorderStyle: TBorderStyle;
    FxxxViewStyle: TViewStyle;
    FxxxReadOnly: Boolean;
    FxxxLargeImages: TCustomImageList;
    FxxxSmallImages: TCustomImageList;
    FxxxStateImages: TCustomImageList;
    FxxxDragImage: TDragImageList;
    FxxxMultiSelect: Boolean;
    FxxxSortType: TSortType;
    FxxxColumnClick: Boolean;
    FxxxShowColumnHeaders: Boolean;
    FxxxListItems: TListItems{TNT-ALLOW TListItems};
    FxxxClicked: Boolean;
    FxxxRClicked: Boolean;
    FxxxIconOptions: TIconOptions;
    FxxxHideSelection: Boolean;
    FListColumns: TListColumns{TNT-ALLOW TListColumns};
  end;
{$ENDIF}
{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
type
  THackCustomListView = class(TCustomMultiSelectListControl)
  protected
    FxxxCanvas: TCanvas;
    FxxxBorderStyle: TBorderStyle;
    FxxxViewStyle: TViewStyle;
    FxxxReadOnly: Boolean;
    FxxxLargeImages: TCustomImageList;
    FxxxSaveSelectedIndex: Integer;
    FxxxSmallImages: TCustomImageList;
    FxxxStateImages: TCustomImageList;
    FxxxDragImage: TDragImageList;
    FxxxMultiSelect: Boolean;
    FxxxSortType: TSortType;
    FxxxColumnClick: Boolean;
    FxxxShowColumnHeaders: Boolean;
    FxxxListItems: TListItems{TNT-ALLOW TListItems};
    FxxxClicked: Boolean;
    FxxxRClicked: Boolean;
    FxxxIconOptions: TIconOptions;
    FxxxHideSelection: Boolean;
    FListColumns: TListColumns{TNT-ALLOW TListColumns};
  end;
{$ENDIF}

var
  ComCtrls_DefaultListViewSort: TLVCompare = nil;

constructor TTntCustomListView.Create(AOwner: TComponent);
begin
  inherited;
  FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
  // create list columns
  Assert(THackCustomListView(Self).FListColumns = inherited Columns, 'Internal Error in TTntCustomListView.Create().');
  FreeAndNil(THackCustomListView(Self).FListColumns);
  THackCustomListView(Self).FListColumns := TTntListColumns.Create(Self);
end;

destructor TTntCustomListView.Destroy;
begin
  inherited;
  Classes.FreeObjectInstance(FEditInstance);
  FreeAndNil(FSavedItems);
end;

procedure TTntCustomListView.CreateWindowHandle(const Params: TCreateParams);

  procedure Capture_ComCtrls_DefaultListViewSort;
  begin
    FTestingForSortProc := True;
    try
      AlphaSort;
    finally
      FTestingForSortProc := False;
    end;
  end;

var
  Column: TLVColumn;
begin
  CreateUnicodeHandle_ComCtl(Self, Params, WC_LISTVIEW);
  if (Win32PlatformIsUnicode) then begin
    if not Assigned(ComCtrls_DefaultListViewSort) then
      Capture_ComCtrls_DefaultListViewSort;
    // the only way I could get editing to work is after a column had been inserted
    Column.mask := 0;
    ListView_InsertColumn(Handle, 0, Column);
    ListView_DeleteColumn(Handle, 0);
  end;
end;

procedure TTntCustomListView.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

procedure TTntCustomListView.CreateWnd;
begin
  inherited;
  FreeAndNil(FSavedItems);
end;

procedure TTntCustomListView.DestroyWnd;
var
  i: integer;
  FSavedItem: TSavedListItem;
  Item: TTntListItem;
begin
  if (not (csDestroying in ComponentState)) and (not OwnerData) then begin
    FreeAndNil(FSavedItems); // fixes a bug on Windows 95.
    FSavedItems := TObjectList.Create(True);
    for i := 0 to Items.Count - 1 do begin
      FSavedItem := TSavedListItem.Create;
      Item := Items[i];
      FSavedItem.FCaption := Item.FCaption;
      FSavedItem.FSubItems.Assign(Item.FSubItems);
      FSavedItems.Add(FSavedItem)
    end;
  end;
  inherited;
end;

function TTntCustomListView.GetDropTarget: TTntListItem;
begin
  Result := inherited DropTarget as TTntListItem;
end;

procedure TTntCustomListView.SetDropTarget(const Value: TTntListItem);
begin
  inherited DropTarget := Value;
end;

function TTntCustomListView.GetItemFocused: TTntListItem;
begin
  Result := inherited ItemFocused as TTntListItem;
end;

procedure TTntCustomListView.SetItemFocused(const Value: TTntListItem);
begin
  inherited ItemFocused := Value;
end;

function TTntCustomListView.GetSelected: TTntListItem;
begin
  Result := inherited Selected as TTntListItem;
end;

procedure TTntCustomListView.SetSelected(const Value: TTntListItem);
begin
  inherited Selected := Value;
end;

function TTntCustomListView.GetTopItem: TTntListItem;
begin
  Result := inherited TopItem as TTntListItem;
end;

function TTntCustomListView.GetListColumns: TTntListColumns;
begin
  Result := inherited Columns as TTntListColumns;
end;

procedure TTntCustomListView.SetListColumns(const Value: TTntListColumns);
begin
  inherited Columns := Value;
end;

{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
type
  THackListColumn = class(TCollectionItem)
  protected
    FxxxAlignment: TAlignment;
    FxxxAutoSize: Boolean;
    FxxxCaption: AnsiString;
    FxxxMaxWidth: TWidth;
    FxxxMinWidth: TWidth;
    FxxxImageIndex: TImageIndex;
    FxxxPrivateWidth: TWidth;
    FxxxWidth: TWidth;
    FOrderTag: Integer;
  end;
{$ENDIF}
{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
type
  THackListColumn = class(TCollectionItem)
  protected
    FxxxAlignment: TAlignment;
    FxxxAutoSize: Boolean;
    FxxxCaption: AnsiString;
    FxxxMaxWidth: TWidth;
    FxxxMinWidth: TWidth;
    FxxxImageIndex: TImageIndex;
    FxxxPrivateWidth: TWidth;
    FxxxWidth: TWidth;
    FOrderTag: Integer;
  end;
{$ENDIF}
{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
type
  THackListColumn = class(TCollectionItem)
  protected
    FxxxxxxxxAlignment: TAlignment;
    FxxxxAutoSize: Boolean;
    FxxxxCaption: AnsiString;
    FxxxxMaxWidth: TWidth;
    FxxxxMinWidth: TWidth;
    FxxxxImageIndex: TImageIndex;
    FxxxxPrivateWidth: TWidth;
    FxxxxWidth: TWidth;
    FOrderTag: Integer;
  end;
{$ENDIF}
{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
type
  THackListColumn = class(TCollectionItem)
  protected
    FxxxxxxxxAlignment: TAlignment;
    FxxxxAutoSize: Boolean;
    FxxxxCaption: AnsiString;
    FxxxxMaxWidth: TWidth;
    FxxxxMinWidth: TWidth;
    FxxxxImageIndex: TImageIndex;
    FxxxxPrivateWidth: TWidth;
    FxxxxWidth: TWidth;
    FOrderTag: Integer;
  end;
{$ENDIF}

function TTntCustomListView.GetColumnFromTag(Tag: Integer): TTntListColumn;
var
  I: Integer;
begin
  for I := 0 to Columns.Count - 1 do
  begin
    Result := Columns[I];
    if THackListColumn(Result).FOrderTag = Tag then Exit;
  end;
  Result := nil;
end;

function TTntCustomListView.ColumnFromIndex(Index: Integer): TTntListColumn;
begin
  Result := inherited Column[Index] as TTntListColumn;
end;

function TTntCustomListView.AreItemsStored: Boolean;
begin
  if Assigned(Action) then
  begin
    if Action is TCustomListAction{TNT-ALLOW TCustomListAction} then
      Result := False
    else
      Result := True;
  end
  else
    Result := not OwnerData;
end;

function TTntCustomListView.GetItems: TTntListItems;
begin
  Result := inherited Items as TTntListItems;
end;

procedure TTntCustomListView.SetItems(Value: TTntListItems);
begin
  inherited Items := Value;
end;

type TTntListItemClass = class of TTntListItem;

function TTntCustomListView.CreateListItem: TListItem{TNT-ALLOW TListItem};
var
  LClass: TClass;
  TntLClass: TTntListItemClass;
begin
  LClass := TTntListItem;
  if Assigned(OnCreateItemClass) then
    OnCreateItemClass(Self, TListItemClass(LClass));
  if not LClass.InheritsFrom(TTntListItem) then
    raise ETntInternalError.Create('Internal Error: OnCreateItemClass.ItemClass must inherit from TTntListItem.');
  TntLClass := TTntListItemClass(LClass);
  Result := TntLClass.Create(inherited Items);
  if FTempItem = nil then
    FTempItem := Result as TTntListItem; { In Delphi 5/6/7/9/10, the first item created is the temp item }
  { TODO: Verify that D11 creates a temp item in its constructor. }
end;

function TTntCustomListView.CreateListItems: TListItems{TNT-ALLOW TListItems};
begin
  Result := TTntListItems.Create(Self);
end;

function TTntCustomListView.GetItemW(Value: TLVItemW): TTntListItem;
begin
  with Value do begin
    if (mask and LVIF_PARAM) <> 0 then
      Result := TListItem{TNT-ALLOW TListItem}(lParam) as TTntListItem
    else if iItem >= 0 then
      Result := Items[IItem]
    else if OwnerData then
      Result := FTempItem
    else
      Result := nil
  end;
end;

function TTntCustomListView.OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
begin
  Result := OwnerDataFetch(Item, Request);
end;

function TTntCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
begin
  if Assigned(OnData) then
  begin
    OnData(Self, Item);
    Result := True;
  end
  else Result := False;
end;

function TntDefaultListViewSort(Item1, Item2: TTntListItem; lParam: Integer): Integer; stdcall;
begin
  Assert(Win32PlatformIsUnicode);
  with Item1 do
    if Assigned(ListView.OnCompare) then
      ListView.OnCompare(ListView, Item1, Item2, lParam, Result)
    else Result := lstrcmpw(PWideChar(Item1.Caption), PWideChar(Item2.Caption));
end;

procedure TTntCustomListView.WndProc(var Message: TMessage);
var
  Item: TTntListItem;
  InheritedItem: TListItem{TNT-ALLOW TListItem};
  SubItem: Integer;
  SavedItem: TSavedListItem;
  PCol: PLVColumn;
  Col: TTntListColumn;
begin
  with Message do begin
    // restore previous values (during CreateWnd)
    if (FSavedItems <> nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
      Item := Items[wParam];
      SavedItem := TSavedListItem(FSavedItems[wP