Форум: "Начинающим";
Текущий архив: 2019.02.10;
Скачать: [xml.tar.bz2];

Вниз

Ошибка преобразования типов   Найти похожие ветки 

← →
Artem78   (2016-10-23 05:36) [0]

У меня есть вот такой класс для работы с объектами на базе TCollection:
unit UTasks;

interface

uses SysUtils, Classes, Variants, Controls;

type
 TDayOfWeek = 1..7;

 TTask = class(TCollectionItem)
 private
   FDayOfWeek: TDayOfWeek;
   FTime1: TTime;
   FTime2: TTime;
   FTimeInterval: boolean;
   FTitle: string;
   FOrder: integer;
   FEnabled: boolean;
 public
   constructor Create(Collection: TCollection); override;
 published
   property DayOfWeek: TDayOfWeek read FDayOfWeek write FDayOfWeek;
   property Time1: TTime read FTime1 write FTime1;
  property Time2: TTime read FTime2 write FTime2;
   property TimeInterval: boolean read FTimeInterval write FTimeInterval;
   property Title: string read FTitle write FTitle;
   property Order: integer read FOrder write FOrder;
   property Enabled: boolean read FEnabled write FEnabled;
 end;

 TTaskChangeEvent = procedure(Item: TCollectionItem) of object;

 TTasksList = class(TCollection)
 private
   FOnTaskChange: TTaskChangeEvent;
   function GetTask(index:integer): TTask;
   procedure SetTask(index:integer; Value:TTask);
 protected
   procedure DoTaskChange(Item: TCollectionItem); dynamic;
 public
   function Add:TTask;
   property Items[Index:integer]:TTask read GetTask write SetTask; default;
   procedure Update(Item: TCollectionItem); override;
 published
   property OnTaskChange: TTaskChangeEvent read FOnTaskChange write FOnTaskChange;
 end;

 TTasks = class(TComponent)
 private
   FTasksList: TTasksList;
   function GetIndexById(const ID: integer): variant;
   function GetCount: integer;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;

   function Add: TTask;
   function Get(const ID: integer): TTask; {overload;}
   procedure Update(const ID: integer; const Task: TTask); {overload;}
   procedure Delete(const ID: integer);
   procedure DeleteAll;

   procedure SaveToFile(Path:String);
   procedure LoadFromFile(Path:String);
 published
   property TasksList: TTasksList read FTasksList write FTasksList;
   property Count: integer read GetCount;
 end;

implementation

{ TTask }

constructor TTask.Create(Collection: TCollection);
begin
 inherited create(Collection);
 DayOfweek := 1;
 Time1 := StrToTime("00:00:00");
 Time2 := StrToTime("00:00:00");
 TimeInterval := False;
 Title := "";
 Enabled := false;
end;

{ TTasksList }

function TTasksList.Add: TTask;
begin
 Result := TTask(inherited Add);
end;

function TTasksList.GetTask(index: integer): TTask;
begin
 Result := TTask(Inherited GetItem(index));
end;

procedure TTasksList.SetTask(index: integer; Value: TTask);
begin
 Items[Index].Assign(Value);
end;

procedure TTasksList.Update(Item: TCollectionItem);
begin
 inherited Update(Item);
 DoTaskChange(Item);
end;

procedure TTasksList.DoTaskChange(Item: TCollectionItem);
begin
 if Assigned(FOnTaskChange) then
   FOnTaskChange(Item);
end;

{ TTasks }

constructor TTasks.Create(AOwner: TComponent);
begin
 inherited create(AOwner);
 TasksList := TTasksList.Create(TTask);
end;

destructor TTasks.Destroy;
begin
 TasksList.Free;
 inherited;
end;

function TTasks.GetIndexById(const ID: integer): variant;
var
 Task: TTask;
begin
 Task := TTask(TasksList.FindItemID(ID));
 if Task <> nil then
 begin
   Result := Task.Index;
 end
 else
   Result := null;
end;

function TTasks.GetCount: integer;
begin
 Result := TasksList.Count;
end;

function TTasks.Add: TTask;
begin
 Result := TasksList.Add;
end;

procedure TTasks.Delete(const ID: integer);
var
 Index: variant;
begin
 Index := GetIndexById(ID);
 if Index <> null then
   TasksList.Delete(Index);
end;

procedure TTasks.DeleteAll;
begin
 TasksList.Clear;
end;

function TTasks.Get(const ID: integer): TTask;
begin
 Result := TTask(TasksList.FindItemID(ID));
end;

procedure TTasks.Update(const ID: integer; const Task: TTask);
var
 Index: variant;
begin
 Index := GetIndexById(ID);
 if Index <> null then
 begin
   TasksList.SetTask(Index, Task);
 end;
end;

procedure TTasks.LoadFromFile(Path: String);
var
 ms: TMemoryStream;
 fs: TFileStream;
begin

 fs := TFileStream.Create(path, fmOpenRead);
 ms := TMemoryStream.Create;
 try
   ObjectTextToBinary(fs, ms);
   ms.position := 0;
   ms.ReadComponent(Self);
 finally
   ms.Free;
   fs.free;
 end;
end;

procedure TTasks.SaveToFile(Path: String);
var
 ms: TMemoryStream;
 fs: TFileStream;
begin
 fs := TFileStream.Create(path, fmCreate or fmOpenWrite);
 ms := TMemoryStream.Create;
 try
   ms.WriteComponent(Self);
   ms.position := 0;
   ObjectBinaryToText(ms, fs);
 finally
   ms.Free;
   fs.free;
 end;
end;

end.

Я обновляю существующую запись таким образом:
   Task := TTask.Create(nil);
   Task.DayOfWeek := cbDayOfWeek.ItemIndex + 1;
   Task.Time1 := EncodeTime(HourOf(dtTime1.Time), MinuteOf(dtTime1.Time), 0, 0);
   Task.Time2 := EncodeTime(HourOf(dtTime2.Time), MinuteOf(dtTime2.Time), 0, 0);
   Task.TimeInterval := dtTime2.Checked;
   Task.Enabled := chkEnabled.Checked;
   Form1.Tasks.Update(EditID, Task); // Form1.Tasks это экземпляр класса TTasks

И получаю exception "Can`t assign a TTask to a TTask". Подскажите, в чём моя ошибка?

---

← →
sniknik ©   (2016-10-23 11:58) [1]

> Can`t assign a TTask to a TTask
2 объявления в разных модулях похоже. для гарантии проверь с указанием, типа  
var
Task: ИмяМодуля.TTask;

Task := ИмяТогоЖеМодуля.TTask.Create(nil);

ну или искорени дубли.

---

← →
Artem78   (2016-10-23 13:59) [2]

Дубля быть не должно (только в самом делфи если нет класса с таким именем). Возможно это как-то связано с моей ошибкой: TForm1, TTasks/TTask и часть кода которая производит обновление находятся в разных модулях.

Добавление имени модуля не помогло.

Ошибка не после вызова Create, а после Update выскакивает. Добавил ещё в объявление TForm1, но тоже самое:
type
 TForm1 = class(TForm)
   // ...
   Tasks: UTasks.TTasks;
   // ...
 end;

---

← →
sniknik ©   (2016-10-23 15:27) [3]

> а после Update выскакивает
и что? какая разница где выскакивает, ошибка однозначная (Can`t assign a TTask to a TTask)
ладно, по другому скажу
Form1.Tasks.Update(EditID, Task);
в описании Update используется из одного модуля, значение передается с типом из другого.

---

← →
Юрий Зотов ©   (2016-10-23 16:09) [4]

Сделате точно по этому образцу:
http://delphikingdom.com/asp/viewitem.asp?catalogid=215
и должно заработать.

---

← →
Игорь Шевченко ©   (2016-10-23 16:14) [5]

> Возможно это как-то связано с моей ошибкой: TForm1, TTasks/TTask
> и часть кода которая производит обновление находятся в разных
> модулях.


Часом не в DLL и EXE ?

---

← →
Artem78   (2016-10-24 02:03) [6]

> в описании Update используется из одного модуля, значение
> передается с типом из другого.

Вот набросал демку по-минимому - https://yadi.sk/d/dmK07_KwxTr3N. Везде TTasks заменён на UTasks.TTasks и тоже самое. Просьба ткунуть носом в нужное место.


> Сделате точно по этому образцу:
> http://delphikingdom.com/asp/viewitem.asp?catalogid=215
> и должно заработать.

Я его за основу и взял, но естественно изменил под свою задачу.


> Часом не в DLL и EXE ?

DLL не использую, только EXE.

---

← →
NoUser ©   (2016-10-24 05:02) [7]

> ткунуть носом в нужное место.
"Зайти на сайт" http://delphikingdom.com/asp/answer.asp?IDAnswer=42982

ЗЫ.
- "use debug .dcus" установи в true;
- для индексов вместо Variant_var := null, лучше Integer_var := -1;
- сделай простенько, используя только TList ( может design-time тебе и не нужен ? )
- ...

ЗЫЫ.
Картина маслом: "Ловушка в генофонде" ))

procedure TPersistent.Assign(Source: TPersistent);
begin
 if Source <> nil then Source.AssignTo(Self) else AssignError(nil);
end;

procedure TPersistent.AssignError(Source: TPersistent);
var
 SourceName: string;
begin
 if Source <> nil then
   SourceName := Source.ClassName else
   SourceName := "nil";
 raise EConvertError.CreateResFmt(@SAssignError, [SourceName, ClassName]);
end;

procedure TPersistent.AssignTo(Dest: TPersistent);
begin
 Dest.AssignError(Self);
end;


---

← →
Eraser ©   (2016-10-24 06:19) [8]

> TTask

в новых версиях есть стандартный класс с таким названием, лучше переименуй.

---

← →
Игорь Шевченко ©   (2016-10-24 10:31) [9]

> Картина маслом: "Ловушка в генофонде" ))


А где ловушка-то ?


> И получаю exception "Can`t assign a TTask to a TTask". Подскажите,
>  в чём моя ошибка?


А где у TTask метод Assign ?

---

← →
sniknik ©   (2016-10-24 12:17) [10]

> А где у TTask метод Assign ?
+
без твоей реализации вызывается родительский, вот этот, где кроме эксепта ничего нет
procedure TPersistent.AssignTo(Dest: TPersistent);
begin
 Dest.AssignError(Self);
end;

---

← →
Юрий Зотов ©   (2016-10-24 12:17) [11]

> Сабж

Перекройте метод TTask.AssignTo:

procedure TTask.AssignTo(Dest: TPersistent);
begin
 if (Dest is TTask)  then
 begin
   ... // Копируем начинку Self в TTask(Dest)
 end
 else inherited AssignTo(Dest);
end;


---

← →
Игорь Шевченко ©   (2016-10-24 15:51) [12]

Юрий Зотов ©   (24.10.16 12:17) [11]

А почему не Assign ?

---

← →
Юрий Зотов ©   (2016-10-24 17:18) [13]

> Игорь Шевченко ©   (24.10.16 15:51) [12

Если перекрыть Assign, то юзер может вызвать неперекрытый AssignTo и получит ошибку. Хотя класс параметра правильный и ошибки быть не должно.

Если же перекрыть AssignTo, то юзер может вызывать хоть Asssign, хоть AssignTo и при правильном классе параметра ошибки не будет. Что и нужно.

---

← →
Игорь Шевченко ©   (2016-10-24 17:47) [14]

> Если перекрыть Assign, то юзер может вызвать неперекрытый
> AssignTo


AssignTo - protected.

---

← →
Игорь Шевченко ©   (2016-10-24 17:55) [15]

Юрий Зотов ©   (24.10.16 17:18) [13]

Я смотрю, в VCL/RTL перекрывается поровну, и Assign и AssignTo, мне интересно.

---

← →
Юрий Зотов ©   (2016-10-24 18:07) [16]

> Игорь Шевченко ©   (24.10.16 17:47) [14]

> AssignTo - protected.

Да. Но это не мешает юзеру вызвать AssignTo в своем потомке, да и не в потомке тоже можно.

---

← →
Artem78 ©   (2016-10-24 21:05) [17]

Вообщем перекрыл оба и Assign и AssignTo, но как показал эксперимент достаточно одного Assign.

---

← →
Юрий Зотов ©   (2016-10-25 00:21) [18]

> Artem78 ©   (24.10.16 21:05) [17]

Эксперимент был неполным. См. [13].

Не перекрыв AssignTo, Вы заложили в код бомбу замедленного действия.

---

← →
Германн ©   (2016-10-25 01:25) [19]

Удалено модератором
Примечание: Правила читаем и уважаем

---

← →
Pavia ©   (2016-10-27 16:17) [20]

> Я смотрю, в VCL/RTL перекрывается поровну, и Assign и AssignTo,
>  мне интересно.

А если справку почитать? Насколько помню рекомендуется перекрывать AssignTo.
Что касается мой точки зрения, то:
В VCL надо перекрывать AssignTo. В VCL это связано с автоматической загрузкой данных из форм(десериализацией).
Что касается RTL, то там перекрывается Assign так как просто с транслировано с Сишных библиотек в которых нет понятия AssignTo.

---

← →
Игорь Шевченко ©   (2016-10-27 17:52) [21]

> Что касается RTL, то там перекрывается Assign так как просто
> с транслировано с Сишных библиотек в которых нет понятия
> AssignTo.


"Вы, сударь, ерунду говорите. И хуже всего то, что говорите безапеляционно и уверенно"


> А если справку почитать?


TPersistent.Assign Method:

Most objects override Assign to handle the assignment of properties from similar objects. When overriding Assign, call the inherited method if the destination object can"t handle the assignment of properties from the class of the Source parameter.

If no overridden Assign method can handle the assignment of properties from Source, the method implemented in TPersistent calls the source object"s AssignTo method. This allows the source object to handle the assignment. If the Source object is nil (Delphi) or NULL (C++), Assign raises an EConvertError exception.

TPersistent.AssignTo Method:

Override the AssignTo method to extend the functionality of the Assign method of destination objects so that they handle newly created object classes. When defining a new object class, override the Assign method for every existing object class that should be able to copy its properties to the new class. Override the AssignTo method for every existing class to which the new class can copy.

The Assign method of TPersistent calls AssignTo if the descendant object does not succeed in copying the properties of a source object. The AssignTo method defined by TPersistent raises an EConvertError exception

Ты бы сам читал, прежде чем советовать.

---

← →
Pavia ©   (2016-10-27 19:43) [22]

> Игорь Шевченко ©   (27.10.16 17:52) [21]

А почему вы не выделили следующее предложение?

> Override the AssignTo method for every existing class to
> which the new class can copy.

Я не вижу тут рекомендаций или запретов. Только пояснения отличия.

Или вы считаете слово should следует трактовать в ультимативной, без оговорочной форме?  Должен и точка.


> The Assign method of TPersistent calls AssignTo if the descendant
> object does not succeed in copying the properties of a source
> object.

А тут описывает последовательность вызовов.  Используем правило не плоди лишних сущности. От куда следует что код надо писать в  AssignTo, всё равно он вызывается.

А вот что написано в старой справке.
Override the AssignTo method to extend the functionality of the Assign method of destination objects so that they handle newly created object classes. When defining a new object class, override the Assign method for every existing object class that should be able to copy its properties to the new class.  Override the AssignTo method for every existing class to which the new class can copy.

Как по мне они просто сделали лишнюю сущность. Но возможно был какой-то смысл.


> "Вы, сударь, ерунду говорите. И хуже всего то, что говорите
> безапеляционно и уверенно"

Согласен ерунду написал. Я имел в виду std из Си++, там нет AssignTo только Assign. Разве что где-то в хэшмепах видел. Вот при разработки Builder и Delphi за основу брались существующие аналоги, так что вполне могли при создании RTL скопировать с std.

---

← →
Игорь Шевченко ©   (2016-10-27 21:52) [23]

> А тут описывает последовательность вызовов.  Используем
> правило не плоди лишних сущности. От куда следует что код
> надо писать в  AssignTo, всё равно он вызывается.


Феерично :) Написано, что метод Assign класса TPersistent вызывает AssignTo, если наследник не смог скопировать свойства :)
Ты начинаешь про лишние сущности - право, смешно.
Впрочем, жизнь слишком коротка, чтобы тратить время на убеждение несогласных.

---

← →
Pavia ©   (2016-10-27 22:22) [24]

> Феерично :) Написано, что метод Assign класса TPersistent
> вызывает AssignTo, если наследник не смог скопировать свойства
> :)

Что-то вы сегодня тупите. Да же толком объяснить не можете. Даю подсказку при каких условиях Assign не может скопировать свойства?

---

← →
Игорь Шевченко ©   (2016-10-28 10:22) [25]

Pavia ©   (27.10.16 22:22) [24]

Справку ты читать не хочешь, исходники ты читать не хочешь.
Вынужден констатировать факт моей неоспоримой правоты в данной дискуссии, дальшейшее обсуждение считаю нецелесообразным

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2019.02.10;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.53 MB
Время: 0.002 c