Componentes.Terceros.RemObj.../internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/Arrays/ArraysLibrary_Intf.pas
david 2824855ea7 - Modificación del paquete RemObjects_Core_D10 para que sea un paquete de runtime/designtime (antes era designtime sólo)
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10
- Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
2007-09-10 14:06:19 +00:00

742 lines
20 KiB
ObjectPascal

unit ArraysLibrary_Intf;
{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading }
{ the RODL file associated with this project . }
{ }
{ Do not modify this unit manually, or your changes will be lost when this }
{ unit is regenerated the next time you compile the project. }
{----------------------------------------------------------------------------}
interface
uses
{vcl:} Classes, TypInfo,
{RemObjects:} uROClasses, uROClient, uROTypes, uROClientIntf;
const
{ Library ID }
LibraryUID = '{7BFDF035-4BE8-4255-9337-E112A2F30DA0}';
TargetNamespace = '';
{ Service Interface ID's }
IArraysService_IID : TGUID = '{426D1A36-4EBF-4241-8E63-A26D303AA90E}';
{ Event ID's }
type
{ Forward declarations }
IArraysService = interface;
CustomersArray = class;
OrdersArray = class;
Customers = class;
Orders = class;
Tables = class;
{ Customers }
Customers = class(TROComplexType)
private
fCustomerID: String;
fCompanyName: String;
fContactName: String;
fContactTitle: String;
fAddress: String;
fCity: String;
fRegion: String;
fPostalcode: String;
fCountry: String;
fPhone: String;
fFax: String;
public
procedure Assign(iSource: TPersistent); override;
published
property CustomerID:String read fCustomerID write fCustomerID;
property CompanyName:String read fCompanyName write fCompanyName;
property ContactName:String read fContactName write fContactName;
property ContactTitle:String read fContactTitle write fContactTitle;
property Address:String read fAddress write fAddress;
property City:String read fCity write fCity;
property Region:String read fRegion write fRegion;
property Postalcode:String read fPostalcode write fPostalcode;
property Country:String read fCountry write fCountry;
property Phone:String read fPhone write fPhone;
property Fax:String read fFax write fFax;
end;
{ CustomersCollection }
CustomersCollection = class(TROCollection)
protected
constructor Create(aItemClass: TCollectionItemClass); overload;
function GetItems(Index: integer): Customers;
procedure SetItems(Index: integer; const Value: Customers);
public
constructor Create; overload;
function Add: Customers; reintroduce;
procedure SaveToArray(anArray: CustomersArray);
procedure LoadFromArray(anArray: CustomersArray);
property Items[Index: integer]:Customers read GetItems write SetItems; default;
end;
{ Orders }
Orders = class(TROComplexType)
private
fOrderID: Integer;
fCustomerID: String;
fEmployeeID: Integer;
fOrderDate: DateTime;
fRequiredDate: DateTime;
fShippedDate: DateTime;
fShipVia: Integer;
fFreight: Currency;
fShipName: String;
fShipAddress: String;
fShipCity: String;
fShipRegion: String;
fShipPostalCode: String;
fShipCountry: String;
public
procedure Assign(iSource: TPersistent); override;
published
property OrderID:Integer read fOrderID write fOrderID;
property CustomerID:String read fCustomerID write fCustomerID;
property EmployeeID:Integer read fEmployeeID write fEmployeeID;
property OrderDate:DateTime read fOrderDate write fOrderDate;
property RequiredDate:DateTime read fRequiredDate write fRequiredDate;
property ShippedDate:DateTime read fShippedDate write fShippedDate;
property ShipVia:Integer read fShipVia write fShipVia;
property Freight:Currency read fFreight write fFreight;
property ShipName:String read fShipName write fShipName;
property ShipAddress:String read fShipAddress write fShipAddress;
property ShipCity:String read fShipCity write fShipCity;
property ShipRegion:String read fShipRegion write fShipRegion;
property ShipPostalCode:String read fShipPostalCode write fShipPostalCode;
property ShipCountry:String read fShipCountry write fShipCountry;
end;
{ OrdersCollection }
OrdersCollection = class(TROCollection)
protected
constructor Create(aItemClass: TCollectionItemClass); overload;
function GetItems(Index: integer): Orders;
procedure SetItems(Index: integer; const Value: Orders);
public
constructor Create; overload;
function Add: Orders; reintroduce;
procedure SaveToArray(anArray: OrdersArray);
procedure LoadFromArray(anArray: OrdersArray);
property Items[Index: integer]:Orders read GetItems write SetItems; default;
end;
{ Tables }
Tables = class(TROComplexType)
private
faCustomers: CustomersArray;
faOrders: OrdersArray;
function GetaCustomers: CustomersArray;
function GetaOrders: OrdersArray;
public
procedure Assign(iSource: TPersistent); override;
published
property aCustomers:CustomersArray read GetaCustomers write faCustomers;
property aOrders:OrdersArray read GetaOrders write faOrders;
end;
{ TablesCollection }
TablesCollection = class(TROCollection)
protected
constructor Create(aItemClass: TCollectionItemClass); overload;
function GetItems(Index: integer): Tables;
procedure SetItems(Index: integer; const Value: Tables);
public
constructor Create; overload;
function Add: Tables; reintroduce;
property Items[Index: integer]:Tables read GetItems write SetItems; default;
end;
{ CustomersArray }
CustomersArray = class(TROArray)
private
fCount: Integer;
fItems : array of Customers;
protected
procedure Grow; virtual;
function GetItems(Index: integer): Customers;
procedure SetItems(Index: integer; const Value: Customers);
function GetCount: integer; override;
public
class function GetItemType: PTypeInfo; override;
class function GetItemClass: TClass; override;
class function GetItemSize: integer; override;
function GetItemRef(Index: integer): pointer; override;
procedure SetItemRef(Index: integer; Ref: pointer); override;
procedure Clear; override;
procedure Delete(Index: integer); override;
procedure Resize(ElementCount: integer); override;
procedure Assign(iSource:TPersistent); override;
function Add: Customers; overload;
function Add(const Value: Customers):integer; overload;
property Count : integer read GetCount;
property Items[Index: integer]:Customers read GetItems write SetItems; default;
end;
{ OrdersArray }
OrdersArray = class(TROArray)
private
fCount: Integer;
fItems : array of Orders;
protected
procedure Grow; virtual;
function GetItems(Index: integer): Orders;
procedure SetItems(Index: integer; const Value: Orders);
function GetCount: integer; override;
public
class function GetItemType: PTypeInfo; override;
class function GetItemClass: TClass; override;
class function GetItemSize: integer; override;
function GetItemRef(Index: integer): pointer; override;
procedure SetItemRef(Index: integer; Ref: pointer); override;
procedure Clear; override;
procedure Delete(Index: integer); override;
procedure Resize(ElementCount: integer); override;
procedure Assign(iSource:TPersistent); override;
function Add: Orders; overload;
function Add(const Value: Orders):integer; overload;
property Count : integer read GetCount;
property Items[Index: integer]:Orders read GetItems write SetItems; default;
end;
{ IArraysService }
IArraysService = interface
['{426D1A36-4EBF-4241-8E63-A26D303AA90E}']
function GetTables: Tables;
end;
{ CoArraysService }
CoArraysService = class
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IArraysService;
end;
{ TArraysService_Proxy }
TArraysService_Proxy = class(TROProxy, IArraysService)
protected
function __GetInterfaceName:string; override;
function GetTables: Tables;
end;
implementation
uses
{vcl:} SysUtils,
{RemObjects:} uROEventRepository, uRORes;
{ CustomersArray }
procedure CustomersArray.Assign(iSource: TPersistent);
var lSource:CustomersArray;
i:integer;
begin
if (iSource is CustomersArray) then begin
lSource := CustomersArray(iSource);
Clear();
Resize(lSource.Count);
for i := 0 to Count-1 do begin
if Assigned(lSource.Items[i]) then begin
Items[i].Assign(lSource.Items[i]);
end;
end;
end
else begin
inherited Assign(iSource);
end;
end;
class function CustomersArray.GetItemType: PTypeInfo;
begin
result := TypeInfo(Customers);
end;
class function CustomersArray.GetItemClass: TClass;
begin
result := Customers;
end;
class function CustomersArray.GetItemSize: integer;
begin
result := SizeOf(Customers);
end;
function CustomersArray.GetItems(Index: integer): Customers;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
function CustomersArray.GetItemRef(Index: integer): pointer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
procedure CustomersArray.SetItemRef(Index: integer; Ref: pointer);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
if Ref <> fItems[Index] then begin
fItems[Index].Free;
fItems[Index] := Ref;
end;
end;
procedure CustomersArray.Clear;
var i: integer;
begin
for i := 0 to (Count-1) do fItems[i].Free();
SetLength(fItems, 0);
FCount := 0;
end;
procedure CustomersArray.Delete(Index: integer);
var i: integer;
begin
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
fItems[Index].Free();
if (Index<Count-1) then
for i := Index to Count-2 do fItems[i] := fItems[i+1];
SetLength(fItems, Count-1);
Dec(FCount);
end;
procedure CustomersArray.SetItems(Index: integer; const Value: Customers);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
fItems[Index].Free;
fItems[Index] := Value;
end;
procedure CustomersArray.Resize(ElementCount: integer);
var i: Integer;
begin
for i := FCount -1 downto ElementCount do
FItems[i].Free;
SetLength(fItems, ElementCount);
for i := FCount to ElementCount -1 do
FItems[i] := Customers.Create;
FCount := ElementCount;
end;
function CustomersArray.GetCount: integer;
begin
result := FCount;
end;
procedure CustomersArray.Grow;
var
Delta, Capacity: Integer;
begin
Capacity := Length(fItems);
if Capacity > 64 then
Delta := Capacity div 4
else
if Capacity > 8 then
Delta := 16
else
Delta := 4;
SetLength(fItems, Capacity + Delta);
end;
function CustomersArray.Add: Customers;
begin
result := Customers.Create;
Add(Result);
end;
function CustomersArray.Add(const Value:Customers): integer;
begin
Result := Count;
if Length(fItems) = Result then
Grow;
fItems[result] := Value;
Inc(fCount);
end;
{ OrdersArray }
procedure OrdersArray.Assign(iSource: TPersistent);
var lSource:OrdersArray;
i:integer;
begin
if (iSource is OrdersArray) then begin
lSource := OrdersArray(iSource);
Clear();
Resize(lSource.Count);
for i := 0 to Count-1 do begin
if Assigned(lSource.Items[i]) then begin
Items[i].Assign(lSource.Items[i]);
end;
end;
end
else begin
inherited Assign(iSource);
end;
end;
class function OrdersArray.GetItemType: PTypeInfo;
begin
result := TypeInfo(Orders);
end;
class function OrdersArray.GetItemClass: TClass;
begin
result := Orders;
end;
class function OrdersArray.GetItemSize: integer;
begin
result := SizeOf(Orders);
end;
function OrdersArray.GetItems(Index: integer): Orders;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
function OrdersArray.GetItemRef(Index: integer): pointer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
procedure OrdersArray.SetItemRef(Index: integer; Ref: pointer);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
if Ref <> fItems[Index] then begin
fItems[Index].Free;
fItems[Index] := Ref;
end;
end;
procedure OrdersArray.Clear;
var i: integer;
begin
for i := 0 to (Count-1) do fItems[i].Free();
SetLength(fItems, 0);
FCount := 0;
end;
procedure OrdersArray.Delete(Index: integer);
var i: integer;
begin
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
fItems[Index].Free();
if (Index<Count-1) then
for i := Index to Count-2 do fItems[i] := fItems[i+1];
SetLength(fItems, Count-1);
Dec(FCount);
end;
procedure OrdersArray.SetItems(Index: integer; const Value: Orders);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
fItems[Index].Free;
fItems[Index] := Value;
end;
procedure OrdersArray.Resize(ElementCount: integer);
var i: Integer;
begin
for i := FCount -1 downto ElementCount do
FItems[i].Free;
SetLength(fItems, ElementCount);
for i := FCount to ElementCount -1 do
FItems[i] := Orders.Create;
FCount := ElementCount;
end;
function OrdersArray.GetCount: integer;
begin
result := FCount;
end;
procedure OrdersArray.Grow;
var
Delta, Capacity: Integer;
begin
Capacity := Length(fItems);
if Capacity > 64 then
Delta := Capacity div 4
else
if Capacity > 8 then
Delta := 16
else
Delta := 4;
SetLength(fItems, Capacity + Delta);
end;
function OrdersArray.Add: Orders;
begin
result := Orders.Create;
Add(Result);
end;
function OrdersArray.Add(const Value:Orders): integer;
begin
Result := Count;
if Length(fItems) = Result then
Grow;
fItems[result] := Value;
Inc(fCount);
end;
{ Customers }
procedure Customers.Assign(iSource: TPersistent);
var lSource: ArraysLibrary_Intf.Customers;
begin
inherited Assign(iSource);
if (iSource is ArraysLibrary_Intf.Customers) then begin
lSource := ArraysLibrary_Intf.Customers(iSource);
CustomerID := lSource.CustomerID;
CompanyName := lSource.CompanyName;
ContactName := lSource.ContactName;
ContactTitle := lSource.ContactTitle;
Address := lSource.Address;
City := lSource.City;
Region := lSource.Region;
Postalcode := lSource.Postalcode;
Country := lSource.Country;
Phone := lSource.Phone;
Fax := lSource.Fax;
end;
end;
{ CustomersCollection }
constructor CustomersCollection.Create;
begin
inherited Create(Customers);
end;
constructor CustomersCollection.Create(aItemClass: TCollectionItemClass);
begin
inherited Create(aItemClass);
end;
function CustomersCollection.Add: Customers;
begin
result := Customers(inherited Add);
end;
function CustomersCollection.GetItems(Index: integer): Customers;
begin
result := Customers(inherited Items[Index]);
end;
procedure CustomersCollection.LoadFromArray(anArray: CustomersArray);
var i : integer;
begin
Clear;
for i := 0 to (anArray.Count-1) do
Add.Assign(anArray[i]);
end;
procedure CustomersCollection.SaveToArray(anArray: CustomersArray);
var i : integer;
begin
anArray.Clear;
anArray.Resize(Count);
for i := 0 to (Count-1) do begin
anArray[i] := Customers.Create;
anArray[i].Assign(Items[i]);
end;
end;
procedure CustomersCollection.SetItems(Index: integer; const Value: Customers);
begin
Customers(inherited Items[Index]).Assign(Value);
end;
{ Orders }
procedure Orders.Assign(iSource: TPersistent);
var lSource: ArraysLibrary_Intf.Orders;
begin
inherited Assign(iSource);
if (iSource is ArraysLibrary_Intf.Orders) then begin
lSource := ArraysLibrary_Intf.Orders(iSource);
OrderID := lSource.OrderID;
CustomerID := lSource.CustomerID;
EmployeeID := lSource.EmployeeID;
OrderDate := lSource.OrderDate;
RequiredDate := lSource.RequiredDate;
ShippedDate := lSource.ShippedDate;
ShipVia := lSource.ShipVia;
Freight := lSource.Freight;
ShipName := lSource.ShipName;
ShipAddress := lSource.ShipAddress;
ShipCity := lSource.ShipCity;
ShipRegion := lSource.ShipRegion;
ShipPostalCode := lSource.ShipPostalCode;
ShipCountry := lSource.ShipCountry;
end;
end;
{ OrdersCollection }
constructor OrdersCollection.Create;
begin
inherited Create(Orders);
end;
constructor OrdersCollection.Create(aItemClass: TCollectionItemClass);
begin
inherited Create(aItemClass);
end;
function OrdersCollection.Add: Orders;
begin
result := Orders(inherited Add);
end;
function OrdersCollection.GetItems(Index: integer): Orders;
begin
result := Orders(inherited Items[Index]);
end;
procedure OrdersCollection.LoadFromArray(anArray: OrdersArray);
var i : integer;
begin
Clear;
for i := 0 to (anArray.Count-1) do
Add.Assign(anArray[i]);
end;
procedure OrdersCollection.SaveToArray(anArray: OrdersArray);
var i : integer;
begin
anArray.Clear;
anArray.Resize(Count);
for i := 0 to (Count-1) do begin
anArray[i] := Orders.Create;
anArray[i].Assign(Items[i]);
end;
end;
procedure OrdersCollection.SetItems(Index: integer; const Value: Orders);
begin
Orders(inherited Items[Index]).Assign(Value);
end;
{ Tables }
procedure Tables.Assign(iSource: TPersistent);
var lSource: ArraysLibrary_Intf.Tables;
begin
inherited Assign(iSource);
if (iSource is ArraysLibrary_Intf.Tables) then begin
lSource := ArraysLibrary_Intf.Tables(iSource);
aCustomers.Assign(lSource.aCustomers);
aOrders.Assign(lSource.aOrders);
end;
end;
function Tables.GetaCustomers: CustomersArray;
begin
if (faCustomers = nil) then faCustomers := CustomersArray.Create();
result := faCustomers;
end;
function Tables.GetaOrders: OrdersArray;
begin
if (faOrders = nil) then faOrders := OrdersArray.Create();
result := faOrders;
end;
{ TablesCollection }
constructor TablesCollection.Create;
begin
inherited Create(Tables);
end;
constructor TablesCollection.Create(aItemClass: TCollectionItemClass);
begin
inherited Create(aItemClass);
end;
function TablesCollection.Add: Tables;
begin
result := Tables(inherited Add);
end;
function TablesCollection.GetItems(Index: integer): Tables;
begin
result := Tables(inherited Items[Index]);
end;
procedure TablesCollection.SetItems(Index: integer; const Value: Tables);
begin
Tables(inherited Items[Index]).Assign(Value);
end;
{ CoArraysService }
class function CoArraysService.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IArraysService;
begin
result := TArraysService_Proxy.Create(aMessage, aTransportChannel);
end;
{ TArraysService_Proxy }
function TArraysService_Proxy.__GetInterfaceName:string;
begin
result := 'ArraysService';
end;
function TArraysService_Proxy.GetTables: Tables;
begin
try
result := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'ArraysLibrary', __InterfaceName, 'GetTables');
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(ArraysLibrary_Intf.Tables), result, []);
finally
__Message.UnsetAttributes(__TransportChannel);
__Message.FreeStream;
end
end;
initialization
RegisterROClass(Customers);
RegisterROClass(Orders);
RegisterROClass(Tables);
RegisterROClass(CustomersArray);
RegisterROClass(OrdersArray);
RegisterProxyClass(IArraysService_IID, TArraysService_Proxy);
finalization
UnregisterROClass(Customers);
UnregisterROClass(Orders);
UnregisterROClass(Tables);
UnregisterROClass(CustomersArray);
UnregisterROClass(OrdersArray);
UnregisterProxyClass(IArraysService_IID);
end.