[Lazarus-es] TDD

Antonio Evora aevorar en gmail.com
Mar Jul 1 13:40:39 CEST 2014


Buenas Francisco.
He realizado las siguientes modificaciones para que compile y se ejecute 
bajo linux (por si deseas añadirlas):

<code>
unit NoRefCountObject;

interface

type

   // TNoRefCountObject
   //
   {: Base object to implement interfaces without reference counting }
   TNoRefCountObject =  class(TObject, IInterface)
   protected
     function QueryInterface({$IFDEF 
FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : 
longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     function _AddRef: longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     function _Release: longint;{$IFNDEF 
WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   end;

implementation

{ TNoRefCountObject }

function TNoRefCountObject.QueryInterface({$IFDEF 
FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : 
longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
   if GetInterface(IID, Obj) then
     Result := 0
   else
     Result := E_NOINTERFACE;
end;

function TNoRefCountObject._AddRef: longint;{$IFNDEF 
WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
   Result := -1;
end;

function TNoRefCountObject._Release: longint;{$IFNDEF 
WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
   Result := -1;
end;

end.
</code>

<code>
unit VariantsUtil;

interface

uses
   // Delphi
   Variants,
   SysUtils
   ;

type

   TVariantArray = array of Variant;

   //: convert an array of const to an array of variants
   procedure ConstArrayToVariantArray(const AValues : array of const;
     var ADest: TVariantArray);

   //: convert an array of variant to a text representation
   function VariantArrayToString(const AVarArray: TVariantArray): string;

   //: convert a variant to an integer
   function Var2Int(Value: Variant): Integer;
   //: convert a variant to a pointer
   function Var2Ptr(Value: Variant): Pointer;
   //: convert a pointer to a variant
   function Ptr2Var(Value: Pointer): Variant;
   //: convert a variant to an object
   function Var2Obj(Value: Variant): TObject;
   //: convert an object to a variant
   function Obj2Var(Value: TObject): Variant;
   //: convert a variant to an interface
   function Var2Intf(Value: Variant): IInterface;
   //: convert an interface to a variant
   function Intf2Var(Value: IInterface): Variant;


implementation


// ConstArrayToVariantArray
//
procedure ConstArrayToVariantArray(const AValues : array of const;
   var ADest: TVariantArray);
var
   i : Integer;
begin
   SetLength(ADest, Length(AValues));
   for i := Low(AValues) to High(AValues) do
   begin
     with AValues[i] do
     begin
       case VType of
         vtInteger: ADest[i] := VInteger;
         vtInt64: ADest[i] := VInt64^;
         vtBoolean: ADest[i] := VBoolean;
         vtChar: ADest[i] := VChar;
         vtExtended: ADest[i] := VExtended^;
         vtString: ADest[i] := VString^;
         vtPointer: ADest[i] := Integer(VPointer);
         vtPChar: ADest[i] := StrPas(VPChar);
         vtObject: ADest[i]:= Pointer(VObject);
         vtAnsiString: ADest[i] := String(VAnsiString);
         vtCurrency: ADest[i] := VCurrency^;
         vtVariant: ADest[i] := VVariant^;
         vtInterface: ADest[i]:= Integer(VPointer);
       else
         raise Exception.Create ('invalid data type ' + IntToStr(VType))
       end;
     end;
   end;
end;


// VariantArrayToString
//
function VariantArrayToString(const AVarArray: TVariantArray): string;
var
   I: Integer;
begin
   Result := '';
   for i := Low(AVarArray) to High(AVarArray) do
   begin
     if Length(Result) > 0 then
       Result := Result + ', ';
     if VarIsNull(AVarArray[I]) then
       Result := Result + 'ignored'
     else
       Result := Result + VarToStr(AVarArray[I]);
   end;
   Result := '('+Result+')';
end;


function Var2Int(Value: Variant): Integer;
begin
   Result := Value;
end;

function Var2Ptr(Value: Variant): Pointer;
begin
   Result := Pointer(Var2Int(Value));
end;

function Ptr2Var(Value: Pointer): Variant;
begin
   Result := Integer(Value);
end;

function Var2Obj(Value: Variant): TObject;
begin
   Result := TObject(Var2Ptr(Value));
end;

function Obj2Var(Value: TObject): Variant;
begin
   Result := pointer(Value);
end;

function Var2Intf(Value: Variant): IInterface;
begin
   Result := IInterface(Var2Ptr(Value));
end;

function Intf2Var(Value: IInterface): Variant;
begin
   Result := Ptr2Var(Value);
end;

end.
</code>

Tiene buena pinta.

Un cordial saludo.



More information about the Lazarus-es mailing list