tntcomctrls.pas

TNT Components Source

    SendMessageW(Control.Handle, CCM_SETUNICODEFORMAT, Integer(True), 0);
end;

{ TTntListColumn }

procedure TTntListColumn.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TTntListColumn then
    Caption := TTntListColumn(Source).Caption
  else if Source is TListColumn{TNT-ALLOW TListColumn} then
    FCaption := TListColumn{TNT-ALLOW TListColumn}(Source).Caption;
end;

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

procedure TTntListColumn.SetInheritedCaption(const Value: AnsiString);
begin
  inherited Caption := Value;
end;

function TTntListColumn.GetCaption: WideString;
begin
  Result := GetSyncedWideString(FCaption, inherited Caption);
end;

procedure TTntListColumn.SetCaption(const Value: WideString);
begin
  SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
end;

{ TTntListColumns }

{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
type
  THackCollection = class(TPersistent)
  protected
    FItemClass: TCollectionItemClass;
  end;
{$ENDIF}
{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
type
  THackCollection = class(TPersistent)
  protected
    FItemClass: TCollectionItemClass;
  end;
{$ENDIF}
{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
type
  THackCollection = class(TPersistent)
  protected
    FItemClass: TCollectionItemClass;
  end;
{$ENDIF}
{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
type
  THackCollection = class(TPersistent)
  protected
    FItemClass: TCollectionItemClass;
  end;
{$ENDIF}

constructor TTntListColumns.Create(AOwner: TTntCustomListView);
begin
  inherited Create(AOwner);
  Assert(THackCollection(Self).FItemClass = Self.ItemClass, 'Internal Error in TTntListColumns.Create().');
  THackCollection(Self).FItemClass := TTntListColumn
end;

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

function TTntListColumns.Add: TTntListColumn;
begin
  Result := (inherited Add) as TTntListColumn;
end;

function TTntListColumns.GetItem(Index: Integer): TTntListColumn;
begin
  Result := inherited Items[Index] as TTntListColumn;
end;

procedure TTntListColumns.SetItem(Index: Integer; Value: TTntListColumn);
begin
  inherited SetItem(Index, Value);
end;

{ TWideSubItems }
type
  TWideSubItems = class(TTntStringList)
  private
    FIgnoreInherited: Boolean;
    FInheritedOwner: TListItem{TNT-ALLOW TListItem};
    FOwner: TTntListItem;
  protected
    procedure Put(Index: Integer; const S: WideString); override;
    function GetObject(Index: Integer): TObject; override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    procedure Insert(Index: Integer; const S: WideString); override;
    function AddObject(const S: WideString; AObject: TObject): Integer; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
  public
    constructor Create(AOwner: TTntListItem);
  end;

constructor TWideSubItems.Create(AOwner: TTntListItem);
begin
  inherited Create;
  FInheritedOwner := AOwner;
  FOwner := AOwner;
end;

function TWideSubItems.AddObject(const S: WideString; AObject: TObject): Integer;
begin
  FOwner.ListView.BeginChangingWideItem;
  try
    Result := inherited AddObject(S, AObject);
    if (not FIgnoreInherited) then
      FInheritedOwner.SubItems.AddObject(S, AObject);
  finally
    FOwner.ListView.EndChangingWideItem;
  end;
end;

procedure TWideSubItems.Clear;
begin
  FOwner.ListView.BeginChangingWideItem;
  try
    inherited;
    if (not FIgnoreInherited) then
      FInheritedOwner.SubItems.Clear;
  finally
    FOwner.ListView.EndChangingWideItem;
  end;
end;

procedure TWideSubItems.Delete(Index: Integer);
begin
  FOwner.ListView.BeginChangingWideItem;
  try
    inherited;
    if (not FIgnoreInherited) then
      FInheritedOwner.SubItems.Delete(Index);
  finally
    FOwner.ListView.EndChangingWideItem;
  end;
end;

procedure TWideSubItems.Insert(Index: Integer; const S: WideString);
begin
  FOwner.ListView.BeginChangingWideItem;
  try
    inherited;
    if (not FIgnoreInherited) then
      FInheritedOwner.SubItems.Insert(Index, S);
  finally
    FOwner.ListView.EndChangingWideItem;
  end;
end;

procedure TWideSubItems.Put(Index: Integer; const S: WideString);
begin
  FOwner.ListView.BeginChangingWideItem;
  try
    inherited;
    if (not FIgnoreInherited) then
      FInheritedOwner.SubItems[Index] := S;
  finally
    FOwner.ListView.EndChangingWideItem;
  end;
end;

function TWideSubItems.GetObject(Index: Integer): TObject;
begin
  Result := FInheritedOwner.SubItems.Objects[Index];
end;

procedure TWideSubItems.PutObject(Index: Integer; AObject: TObject);
begin
  FInheritedOwner.SubItems.Objects[Index] := AObject;
end;

type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});

procedure TWideSubItems.SetUpdateState(Updating: Boolean);
begin
  inherited;
  TAccessStrings(FInheritedOwner.SubItems).SetUpdateState(Updating);
end;

{ TTntListItem }

constructor TTntListItem.Create(AOwner: TListItems{TNT-ALLOW TListItems});
begin
  inherited Create(AOwner);
  FSubItems := TWideSubItems.Create(Self);
end;

destructor TTntListItem.Destroy;
begin
  inherited;
  FreeAndNil(FSubItems);
end;

function TTntListItem.GetCaption: WideString;
begin
  Result := GetSyncedWideString(FCaption, inherited Caption);
end;

procedure TTntListItem.SetInheritedCaption(const Value: AnsiString);
begin
  inherited Caption := Value;
end;

procedure TTntListItem.SetCaption(const Value: WideString);
begin
  ListView.BeginChangingWideItem;
  try
    SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
  finally
    ListView.EndChangingWideItem;
  end;
end;

procedure TTntListItem.Assign(Source: TPersistent);
begin
  if Source is TTntListItem then
    with Source as TTntListItem do
    begin
      Self.Caption := Caption;
      Self.Data := Data;
      Self.ImageIndex := ImageIndex;
      Self.Indent := Indent;
      Self.OverlayIndex := OverlayIndex;
      Self.StateIndex := StateIndex;
      Self.SubItems := SubItems;
      Self.Checked := Checked;
    end
  else inherited Assign(Source);
end;

procedure TTntListItem.SetSubItems(const Value: TTntStrings);
begin
  if Value <> nil then
    FSubItems.Assign(Value);
end;

function TTntListItem.GetTntOwner: TTntListItems;
begin
  Result := ListView.Items;
end;

function TTntListItem.GetListView: TTntCustomListView;
begin
  Result := ((inherited Owner).Owner as TTntCustomListView);
end;

{ TTntListItemsEnumerator }

constructor TTntListItemsEnumerator.Create(AListItems: TTntListItems);
begin
  inherited Create;
  FIndex := -1;
  FListItems := AListItems;
end;

function TTntListItemsEnumerator.GetCurrent: TTntListItem;
begin
  Result := FListItems[FIndex];
end;

function TTntListItemsEnumerator.MoveNext: Boolean;
begin
  Result := FIndex < FListItems.Count - 1;
  if Result then
    Inc(FIndex);
end;

{ TTntListItems }

function TTntListItems.Add: TTntListItem;
begin
  Result := (inherited Add) as TTntListItem;
end;

function TTntListItems.AddItem(Item: TTntListItem; Index: Integer): TTntListItem;
begin
  Result := (inherited AddItem(Item, Index)) as TTntListItem;
end;

function TTntListItems.Insert(Index: Integer): TTntListItem;
begin
  Result := (inherited Insert(Index)) as TTntListItem;
end;

function TTntListItems.GetItem(Index: Integer): TTntListItem;
begin
  Result := (inherited Item[Index]) as TTntListItem;
end;

function TTntListItems.Owner: TTntCustomListView;
begin
  Result := (inherited Owner) as TTntCustomListView;
end;

procedure TTntListItems.SetItem(Index: Integer; const Value: TTntListItem);
begin
  inherited Item[Index] := Value;
end;

function TTntListItems.GetEnumerator: TTntListItemsEnumerator;
begin
  Result := TTntListItemsEnumerator.Create(Self);
end;

{ TSavedListItem }
type
  TSavedListItem = class
    FCaption: WideString;
    FSubItems: TTntStrings;
    constructor Create;
    destructor Destroy; override;
  end;

constructor TSavedListItem.Create;
begin
  inherited;
  FSubItems := TTntStringList.Create;
end;

destructor TSavedListItem.Destroy;
begin
  FSubItems.Free;
  inherited;
end;

{ _TntInternalCustomListView }

function _TntInternalCustomListView.OwnerDataFind(Find: TItemFind;
  const FindString: AnsiString; const FindPosition: TPoint;
  FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
  Wrap: Boolean): Integer;
var
  WideFindString: WideString;
begin
  if Assigned(PWideFindString) then
    WideFindString := PWideFindString
  else
    WideFindString := FindString;
  Result := OwnerDataFindW(Find, WideFindString, FindPosition, FindData, StartIndex, Direction, Wrap);
end;

function _TntInternalCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem};
  Request: TItemRequest): Boolean;
begin
  if  (CurrentDispInfo <> nil)
  and (OriginalDispInfoMask and LVIF_TEXT <> 0) then begin
    (Item as TTntListItem).FCaption := CurrentDispInfo.item.pszText
  end;
  (Item as TTntListItem).FSubItems.Clear;
  Result := OwnerDataFetchW(Item, Request);
end;

{ TTntCustomListView }

{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
type
  THackCustomListView = class(TCustomMultiSelectListControl)
  protected
    FxxxCanvas: TCanvas;
    FxxxBorderStyle: TBorderStyle;
    FxxxViewStyle: TViewStyle;
    FxxxReadOnly: Boolean;
    FxxxLargeImages: TCustomImageList;
    FxxxSmallImages: TCustomImageList;
    FxxxStateImages: TCustomImageList;
    FxxxDragImage: TDragImageList;