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

Вниз

Custom Variant Type   Найти похожие ветки 

← →
anton20vlad   (2011-07-18 22:21) [0]

Доброго времени суток. У меня RAD Studio 2007 Delphi c апдейтом от декабря 2007.

Пытаюсь определить свой тип для Variant. Вроде сделал как в доке написано. Но есть проблема: под дебагом ide зависает если поставить брейк поинт на строку в процедуре VarPointCreateInto(см. комент в коде). Привожу весь юнит ниже. Может я чего не так делаю? Помогите плиз советом.


unit cgCustomVariants;

interface

uses
 GDIPAPI, Variants, SysUtils;

function VarPointCreate(Point: TGPPointF): Variant;

function VarPointVar: TVarType;
function VarIsConvert(const AValue: Variant): Boolean;
function VarAsConvert(const AValue: Variant): Variant;

implementation

uses
 Math, Types;

type
 TcgVarPoint = class(TInvokeableVariantType)
 public
   procedure Clear(var V: TVarData); override;
   procedure Copy(var Dest: TVarData; const Source: TVarData;
     const Indirect: Boolean); override;

   function GetProperty(var Dest: TVarData; const V: TVarData;
     const Name: String): Boolean; override;
   function SetProperty(const V: TVarData; const Name: String;
     const Value: TVarData): Boolean; override;
 end;

 TConvertVarData = packed record
   VType: TVarType;
   X, Y: Single;
   Reserved1, Reserved2, Reserved3: Word;
 end;

var
 VarPoint: TcgVarPoint;

procedure VarPointCreateInto(var ADest: Variant; Point: TGPPointF);
begin
 VarClear(ADest);
 TConvertVarData(ADest).VType := VarPointVar; //СТАВЛЮ БРЕЙК ПОИНТ СЮДА. ЖМУ F8 И IDE ВИСНЕТ!!!
 TConvertVarData(ADest).X := Point.X;
 TConvertVarData(ADest).Y := Point.Y;  
end;

function VarPointCreate(Point: TGPPointF): Variant;
begin
 VarPointCreateInto(Result, Point);
end;

function VarPointVar: TVarType;
begin
 Result := VarPoint.VarType;
end;

function VarIsConvert(const AValue: Variant): Boolean;
begin
 Result := (TVarData(AValue).VType and varTypeMask) = VarPointVar;
end;

function VarAsConvert(const AValue: Variant): Variant; overload;
begin
 if not VarIsConvert(AValue) then
   VarCast(Result, AValue, VarPointVar)
 else
   Result := AValue;
end;

{ TConvertVariantType }

procedure TcgVarPoint.Clear(var V: TVarData);
begin
 SimplisticClear(V);
end;

procedure TcgVarPoint.Copy(var Dest: TVarData;
 const Source: TVarData; const Indirect: Boolean);
begin
 SimplisticCopy(Dest, Source, Indirect);
end;

function TcgVarPoint.GetProperty(var Dest: TVarData;
 const V: TVarData; const Name: String): Boolean;
begin
 Result := True;
end;

function TcgVarPoint.SetProperty(const V: TVarData;
 const Name: String; const Value: TVarData): Boolean;
begin
 Result := True;
end;

initialization
 VarPoint := TcgVarPoint.Create;
finalization
 FreeAndNil(VarPoint);
end.

---

← →
anton20vlad   (2011-07-19 11:01) [1]

Разобрался. Может где в доке это пропустил, но необходимо переопределить ещё две процедуры:

 TcgVarPoint = class(TInvokeableVariantType)
   public
...
     procedure Cast(var Dest: TVarData; const Source: TVarData); override;
     procedure CastTo(var Dest: TVarData; const Source: TVarData;
       const AVarType: Word); override;
...
 end;
...
procedure TcgVarPoint.Cast(var Dest: TVarData; const Source: TVarData);
begin
 RaiseCastError();
end;

procedure TcgVarPoint.CastTo(var Dest: TVarData; const Source: TVarData;
 const AVarType: Word);
begin
 RaiseCastError();
end;


Они у меня никак не вызываются, так что RaiseCastError вполне пойдёт. А вот если их не переопределить таким образом, то происходит зависание, как описано в предыдущем посте.

Если честно, то мне не совсем понятно почему так происходит. Буду признателен за разъяснения.

---

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

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

Наверх

Память: 0.45 MB
Время: 0.004 c