Changeset 349 for trunk


Ignore:
Timestamp:
Dec 27, 2024, 10:29:54 AM (4 weeks ago)
Author:
chronos
Message:
  • Fixed: ItemList interface implementation was not working as expected. Implemented as proxy list instead.
Location:
trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/FormGameSystem.pas

    r344 r349  
    116116  FGameSystem := AValue;
    117117  if Assigned(FGameSystem) then begin
    118     FormUnitKinds.List := GameSystem.UnitKinds;
    119     FormNations.List := GameSystem.Nations;
    120     FormBuildingKinds.List := GameSystem.BuildingKinds;
     118    FormUnitKinds.List := GameSystem.UnitKinds.BaseItemList;
     119    FormNations.List := GameSystem.Nations.BaseItemList;
     120    FormBuildingKinds.List := GameSystem.BuildingKinds.BaseItemList;
    121121  end;
    122122end;

  • trunk/Forms/FormItem.pas

    r346 r349  
    8080  J: Integer;
    8181  Control: TControl;
    82   ReferenceList: IList<TItem>;
     82  ReferenceList: TBaseItemList;
    8383  ReferenceItem: TItem;
    8484begin

  • trunk/Forms/FormList.pas

    r346 r349  
    4747      Selected: Boolean);
    4848  private
    49     FList: IList<TItem>;
    50     procedure SetList(AValue: IList<TItem>);
     49    FList: TBaseItemList;
     50    procedure SetList(AValue: TBaseItemList);
    5151    procedure UpdateListViewColumns;
    5252  public
    … …  
    5555    procedure UpdateInterface;
    5656    procedure UpdateList;
    57     property List: IList<TItem> read FList write SetList;
     57    property List: TBaseItemList read FList write SetList;
    5858  end;
    5959
    … …  
    8484          if List.Count <= MinItemCount then Break;
    8585          ListView1.Items[I].Selected := False;
    86           List.Remove(TItem(ListView1.Items[I].Data));
     86          FList.Remove(TItem(ListView1.Items[I].Data));
    8787        end;
    8888      UpdateList;
    … …  
    9999  if Assigned(ListView1.Selected) then
    100100  with TItem(ListView1.Selected.Data) do begin
    101     TempEntry := List.CreateBaseItem;
     101    TempEntry := FList.CreateItem;
    102102    TempEntry.Assign(TItem(ListView1.Selected.Data));
    103103    FormItem := TFormItem.Create(Self);
    … …  
    121121  FormItem: TFormItem;
    122122begin
    123   if (MaxItemCount <> -1) and (List.Count >= MaxItemCount) then Exit;
    124 
    125   TempEntry := List.CreateBaseItem;
     123  if (MaxItemCount <> -1) and (FList.Count >= MaxItemCount) then Exit;
     124
     125  TempEntry := FList.CreateItem;
    126126  FormItem := TFormItem.Create(Self);
    127127  try
    128     TempEntry.Name := List.GetNextAvailableName(SNew + ' ' + LowerCase(List.GetName));
     128    TempEntry.Name := FList.GetNextAvailableName(SNew + ' ' + LowerCase(List.GetName));
    129129    FormItem.Item := TempEntry;
    130130    if FormItem.ShowModal = mrOk then begin
    131       List.Add(TempEntry);
     131      FList.Add(TempEntry);
    132132      TempEntry := nil;
    133133      UpdateList;
    … …  
    145145  FormItem: TFormItem;
    146146begin
    147   if (MaxItemCount <> -1) and (List.Count >= MaxItemCount) then Exit;
    148 
    149   TempEntry := List.CreateBaseItem;
     147  if (MaxItemCount <> -1) and (FList.Count >= MaxItemCount) then Exit;
     148
     149  TempEntry := FList.CreateItem;
    150150  TempEntry.Assign(TItem(ListView1.Selected.Data));
    151151  FormItem := TFormItem.Create(Self);
    … …  
    154154    FormItem.Item := TempEntry;
    155155    if FormItem.ShowModal = mrOk then begin
    156       List.Add(TempEntry);
     156      FList.Add(TempEntry);
    157157      TempEntry := nil;
    158158      UpdateList;
    … …  
    222222begin
    223223  if Item.Index < ListView1.Items.Count then
    224   with TItem(List[Item.Index]) do begin
     224  with FList[Item.Index] do begin
    225225    //Item.Caption := GetName;
    226     Item.Data := List[Item.Index];
    227     Fields := List.GetItemFields;
     226    Item.Data := FList[Item.Index];
     227    Fields := FList.GetItemFields;
    228228    try
    229229      for I := 0 to Fields.Count - 1 do begin
    … …  
    256256end;
    257257
    258 procedure TFormList.SetList(AValue: IList<TItem>);
     258procedure TFormList.SetList(AValue: TBaseItemList);
    259259begin
    260260  if FList = AValue then Exit;
    … …  
    269269  Fields: TItemFields;
    270270begin
     271  if not Assigned(FList) then begin
     272    while ListView1.Columns.Count > 0 do
     273      ListView1.Columns.Delete(ListView1.Columns.Count - 1);
     274    Exit;
     275  end;
    271276  Fields := List.GetItemFields;
    272277  ListView1.Columns.BeginUpdate;
    … …  
    297302procedure TFormList.UpdateList;
    298303begin
    299   if Assigned(List) then ListView1.Items.Count := List.Count
     304  if Assigned(FList) then ListView1.Items.Count := FList.Count
    300305    else ListView1.Items.Count := 0;
    301306  ListView1.Refresh;

  • trunk/Forms/FormNew.pas

    r344 r349  
    371371  if Assigned(FServer) then begin
    372372    Load(FServer);
    373     FormPlayers.List := FServer.Game.Players;
     373    FormPlayers.List := FServer.Game.Players.BaseItemList;
    374374  end else begin
    375375    FormPlayers.List := nil;
    … …  
    468468  WinObjective: TWinObjective;
    469469begin
    470 
    471470  ComboBoxGridType.Enabled := FServer.Game.GameSystem.PreferedMapType = mtNone;
    472471  if FServer.Game.GameSystem.PreferedMapType <> mtNone then

  • trunk/ItemList.pas

    r347 r349  
    3636  end;
    3737
    38   { IList }
    39 
    40   IList<T> = interface
    41     function GetName: string;
    42     function GetCount: SizeInt;
    43     function GetItem(Index: SizeInt): T;
    44     function Remove(constref AValue: T): SizeInt;
    45     function Add(constref AValue: T): SizeInt;
    46     function CreateBaseItem(Name: string = ''): T;
    47     function GetNextAvailableName(Name: string): string;
    48     function GetItemFields: TItemFields;
    49     procedure SetItem(Index: SizeInt; AValue: T);
    50     property Count: SizeInt read GetCount;
    51     property Items[Index: SizeInt]: T read GetItem write SetItem; default;
    52   end;
     38  TBaseItemList = class;
    5339
    5440  { TItem }
    … …  
    8773    class function GetClassSysName: string; virtual;
    8874    class function GetClassName: string; virtual;
    89     function GetReferenceList(Index: Integer): IList<TItem>; virtual;
     75    function GetReferenceList(Index: Integer): TBaseItemList; virtual;
    9076    constructor Create; virtual;
    9177  end;
    … …  
    9379  TItemClass = class of TItem;
    9480
    95   IItemList = interface(IList<TItem>)
    96   end;
     81  { TBaseItemList }
     82
     83  TBaseItemList = class
     84  public
     85  type
     86    TAddEvent = function (constref AValue: TItem): SizeInt of object;
     87    TGetCountEvent = function: SizeInt of object;
     88    TSetItemEvent = procedure(Index: SizeInt; AValue: TItem) of object;
     89    TGetNameEvent = function: string of object;
     90    TGetItemEvent = function(Index: SizeInt): TItem of object;
     91    TGetItemFieldsEvent = function: TItemFields of object;
     92    TRemoveEvent = function(constref AValue: TItem): SizeInt of object;
     93    TGetNextAvailableNameEvent = function(Name: string): string of object;
     94    TCreateItemEvent = function(Name: string = ''): TItem of object;
     95  private
     96    FOnAdd: TAddEvent;
     97    FOnCreateItem: TCreateItemEvent;
     98    FOnGetCount: TGetCountEvent;
     99    FOnGetItem: TGetItemEvent;
     100    FOnGetItemFields: TGetItemFieldsEvent;
     101    FOnGetName: TGetNameEvent;
     102    FOnGetNextAvailableName: TGetNextAvailableNameEvent;
     103    FOnRemove: TRemoveEvent;
     104    FOnSetItem: TSetItemEvent;
     105    procedure SetItem(Index: SizeInt; AValue: TItem);
     106    function GetItem(Index: SizeInt): TItem;
     107  public
     108    function GetName: string;
     109    function GetCount: SizeInt;
     110    function Remove(constref AValue: TItem): SizeInt;
     111    function Add(constref AValue: TItem): SizeInt;
     112    function CreateItem(Name: string = ''): TItem;
     113    function GetNextAvailableName(Name: string): string;
     114    function GetItemFields: TItemFields;
     115    property Count: SizeInt read GetCount;
     116    property Items[Index: SizeInt]: TItem read GetItem write SetItem; default;
     117    property OnAdd: TAddEvent read FOnAdd write FOnAdd;
     118    property OnGetCount: TGetCountEvent read FOnGetCount write FOnGetCount;
     119    property OnSetItem: TSetItemEvent read FOnSetItem write FOnSetItem;
     120    property OnGetItem: TGetItemEvent read FOnGetItem write FOnGetItem;
     121    property OnGetName: TGetNameEvent read FOnGetName write FOnGetName;
     122    property OnRemove: TRemoveEvent read FOnRemove write FOnRemove;
     123    property OnGetItemFields: TGetItemFieldsEvent read FOnGetItemFields write FOnGetItemFields;
     124    property OnGetNextAvailableName: TGetNextAvailableNameEvent read
     125      FOnGetNextAvailableName write FOnGetNextAvailableName;
     126    property OnCreateItem: TCreateItemEvent read FOnCreateItem
     127      write FOnCreateItem;
     128end;
    97129
    98130  { TItemList }
    99131
    100   TItemList<T: TItem> = class(TObjectList<T>, IList<TItem>)
     132  TItemList<T: TItem> = class(TObjectList<T>)
    101133  private
     134    FBaseItemList: TBaseItemList;
    102135    procedure RecalculateNewId(Reset: Boolean);
    103136    procedure RecalculateItemsId;
    104     function GetItem(Index: SizeInt): TItem;
    105     procedure SetItem(Index: SizeInt; AValue: TItem);
    106   protected
    107     function GetCount: SizeInt; override;
     137    function BaseGetItem(Index: SizeInt): TItem;
     138    procedure BaseSetItem(Index: SizeInt; AValue: TItem);
     139    function BaseAdd(constref AValue: TItem): SizeInt;
     140    function BaseGetCount: SizeInt;
     141    function BaseGetName(A: string): string;
     142    function BaseRemove(constref AValue: TItem): SizeInt;
     143    function BaseGetItemFields: TItemFields;
     144    function BaseCreateItem(Name: string = ''): TItem;
    108145  public
    109146    NewId: Integer;
    110     function GetName: string;
    111     function GetItemFields: TItemFields;
    112     function Remove(constref AValue: TItem): SizeInt;
    113     function Add(constref AValue: TItem): SizeInt; overload;
    114147    function CreateItem(Name: string = ''): T; virtual;
    115     function CreateBaseItem(Name: string = ''): TItem;
    116148    function IncrementName(Name: string): string;
    117149    function GetNextAvailableName(Name: string): string;
    … …  
    126158    procedure SaveToNode(Node: TDOMNode); virtual;
    127159    constructor Create(FreeObjects: Boolean = True);
    128     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    129     function _AddRef: Longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    130     function _Release: Longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     160    destructor Destroy; override;
     161    property BaseItemList: TBaseItemList read FBaseItemList;
    131162  end;
    132163
    … …  
    210241end;
    211242
    212 function TItemList<T>.CreateBaseItem(Name: string): TItem;
     243function TItemList<T>.BaseCreateItem(Name: string): TItem;
    213244begin
    214245  Result := TItem(CreateItem(Name));
    … …  
    247278begin
    248279  inherited;
     280  FBaseItemList := TBaseItemList.Create;
     281  FBaseItemList.OnAdd := BaseAdd;
     282  FBaseItemList.OnGetCount := BaseGetCount;
     283  FBaseItemList.OnSetItem := BaseSetItem;
     284  FBaseItemList.OnGetItem := BaseGetItem;
     285  FBaseItemList.OnRemove := BaseRemove;
     286  FBaseItemList.OnGetItemFields := BaseGetItemFields;
     287  FBaseItemList.OnCreateItem := BaseCreateItem;
     288  //FBaseItemList.OnGetNextAvailableName := GetNextAvailableName;
     289  //FBaseItemList.OnGetName := BaseGetName;
    249290  NewId := 1;
    250291end;
    251292
    252 function TItemList<T>.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: tguid; out obj): LongInt;
    253   {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    254 begin
    255   if GetInterface(IID, Obj) then Result := 0
    256     else Result := E_NOINTERFACE;
    257 end;
    258 
    259 function TItemList<T>._AddRef: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    260 begin
    261   Result := -1;
    262 end;
    263 
    264 function TItemList<T>._Release: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    265 begin
    266   Result := -1;
    267 end;
    268 
    269 function TItemList<T>.GetCount: SizeInt;
     293destructor TItemList<T>.Destroy;
     294begin
     295  FreeAndNil(FBaseItemList);
     296  inherited;
     297end;
     298
     299function TItemList<T>.BaseGetCount: SizeInt;
    270300begin
    271301  Result := Count;
    272302end;
    273303
    274 function TItemList<T>.GetName: string;
     304function TItemList<T>.BaseGetName(A: string): string;
    275305begin
    276306  Result := T.GetClassName;
    277307end;
    278308
    279 function TItemList<T>.GetItemFields: TItemFields;
     309function TItemList<T>.BaseGetItemFields: TItemFields;
    280310begin
    281311  Result := T.GetFields;
    282312end;
    283313
    284 function TItemList<T>.Remove(constref AValue: TItem): SizeInt;
     314function TItemList<T>.BaseRemove(constref AValue: TItem): SizeInt;
    285315begin
    286316  Result := inherited Remove(T(AValue));
    287317end;
    288318
    289 function TItemList<T>.Add(constref AValue: TItem): SizeInt;
     319function TItemList<T>.BaseAdd(constref AValue: TItem): SizeInt;
    290320begin
    291321  Result := inherited Add(T(AValue));
    … …  
    312342end;
    313343
    314 function TItemList<T>.GetItem(Index: SizeInt): TItem;
     344function TItemList<T>.BaseGetItem(Index: SizeInt): TItem;
    315345begin
    316346  Result := inherited GetItem(Index);
    317347end;
    318348
    319 procedure TItemList<T>.SetItem(Index: SizeInt; AValue: TItem);
     349procedure TItemList<T>.BaseSetItem(Index: SizeInt; AValue: TItem);
    320350begin
    321351  inherited SetItem(Index, T(AValue));
    … …  
    452482var
    453483  ReadId: Integer;
    454   ReferenceList: IList<TItem>;
     484  ReferenceList: TBaseItemList;
    455485begin
    456486  if Field.DataType = dtString then begin
    … …  
    471501  if Field.DataType = dtReference then begin
    472502    ReadId := ReadInteger(Node, Field.SysName, 0);
    473     ReferenceList := IList<TItem>(GetReferenceList(Field.Index));
     503    ReferenceList := GetReferenceList(Field.Index);
    474504    if (ReadId > 0) and Assigned(ReferenceList) then
    475505      SetValueReference(Field.Index, TItem(ReferenceList[ReadId]));
    … …  
    714744end;
    715745
    716 function TItem.GetReferenceList(Index: Integer): IList<TItem>;
     746function TItem.GetReferenceList(Index: Integer): TBaseItemList;
    717747begin
    718748  Result := nil;
    … …  
    723753end;
    724754
     755{ TBaseItemList }
     756
     757procedure TBaseItemList.SetItem(Index: SizeInt; AValue: TItem);
     758begin
     759  if Assigned(FOnSetItem) then FOnSetItem(Index, AValue)
     760    else Exception.Create('Undefined SetItem handler');
     761end;
     762
     763function TBaseItemList.GetName: string;
     764begin
     765  if Assigned(FOnGetName) then Result := FOnGetName
     766    else Exception.Create('Undefined GetName handler');
     767end;
     768
     769function TBaseItemList.GetCount: SizeInt;
     770begin
     771  if Assigned(FOnGetCount) then Result := FOnGetCount
     772    else Exception.Create('Undefined GetCount handler');
     773end;
     774
     775function TBaseItemList.GetItem(Index: SizeInt): TItem;
     776begin
     777  if Assigned(FOnGetItem) then Result := FOnGetItem(Index)
     778    else Exception.Create('Undefined GetItem handler');
     779end;
     780
     781function TBaseItemList.Remove(constref AValue: TItem): SizeInt;
     782begin
     783  if Assigned(FOnRemove) then Result := FOnRemove(AValue)
     784    else Exception.Create('Undefined Remove handler');
     785end;
     786
     787function TBaseItemList.Add(constref AValue: TItem): SizeInt;
     788begin
     789  if Assigned(FOnAdd) then Result := FOnAdd(AValue)
     790    else Exception.Create('Undefined Add handler');
     791end;
     792
     793function TBaseItemList.CreateItem(Name: string): TItem;
     794begin
     795  if Assigned(FOnCreateItem) then Result := FOnCreateItem(Name)
     796    else Exception.Create('Undefined CreateItem handler');
     797end;
     798
     799function TBaseItemList.GetNextAvailableName(Name: string): string;
     800begin
     801  if Assigned(FOnGetNextAvailableName) then Result := FOnGetNextAvailableName(Name)
     802    else Exception.Create('Undefined GetNextAvailableName handler');
     803end;
     804
     805function TBaseItemList.GetItemFields: TItemFields;
     806begin
     807  if Assigned(FOnGetItemFields) then Result := FOnGetItemFields
     808    else Exception.Create('Undefined GetItemFields handler');
     809end;
     810
    725811end.
    726812

  • trunk/Player.pas

    r346 r349  
    100100    procedure GetValue(Index: Integer; out Value); override;
    101101    procedure SetValue(Index: Integer; var Value); override;
    102     function GetReferenceList(Index: Integer): IList<TItem>; override;
     102    function GetReferenceList(Index: Integer): TBaseItemList; override;
    103103    class function GetClassSysName: string; override;
    104104    class function GetClassName: string; override;
    … …  
    12571257end;
    12581258
    1259 function TPlayer.GetReferenceList(Index: Integer): IList<TItem>;
    1260 begin
    1261   if Index = 2 then Result := TGame(Game).GameSystem.Nations
     1259function TPlayer.GetReferenceList(Index: Integer): TBaseItemList;
     1260begin
     1261  if Index = 2 then Result := TGame(Game).GameSystem.Nations.BaseItemList
    12621262  else Result := nil;
    12631263end;
Note: See TracChangeset for help on using the changeset viewer.