Summary Table

Categories Total Count
PII 0
URL 0
DNS 0
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

unit VAClasses;

interface

uses
Windows, Controls, Classes, SysUtils, Types, RTLConsts;

type
TVABaseMethodList = class(TObject)
strict private
FCode: TList;
FData: TList;
strict protected
function GetMethod(index: integer): TMethod;
property Code: TList read FCode;
property Data: TList read FData;
protected
constructor Create; virtual;
function IndexOf(const Method: TMethod): integer;
procedure Add(const Method: TMethod);
procedure Clear;
function Count: integer;
procedure Delete(index: integer);
procedure Remove(const Method: TMethod);
property Methods[index: integer]: TMethod read GetMethod; default;
public
destructor Destroy; override;
end;

TVAMethodList = class(TVABaseMethodList)
public
constructor Create; override;
destructor Destroy; override;
function IndexOf(const Method: TMethod): integer;
procedure Add(const Method: TMethod);
procedure Clear;
function Count: integer;
procedure Delete(index: integer);
procedure Remove(const Method: TMethod);
property Methods;
end;


TVALinkedMethodList = class(TVABaseMethodList)
private
FLinkedObjects: TList;
public
constructor Create; override;
destructor Destroy; override;
procedure Add(Obj: TObject; const Method: TMethod);
function IndexOf(const obj: TObject): integer;
procedure Clear;
function Count: integer;
procedure Delete(index: integer);
procedure Remove(const obj: TObject); overload;
function GetMethod(Obj: TObject): TMethod;
// property Methods;
end;

// event fires before the component has acted on the notification
TVANotifyEvent = procedure(AComponent: TComponent; Operation: TOperation) of object;

TVANotificationEventComponent = class(TComponent)
private
FOnNotifyEvent: TVANotifyEvent;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor NotifyCreate(AOwner: TComponent; AOnNotifyEvent: TVANotifyEvent); virtual;
property OnNotifyEvent: TVANotifyEvent read FOnNotifyEvent write FOnNotifyEvent;
end;

TVAListChangeEvent = procedure(Sender: TObject; Item: Pointer; Operation: TOperation) of object;

TVAList = class(TList)
private
FOnChange: TVAListChangeEvent;
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
property OnChange: TVAListChangeEvent read FOnChange write FOnChange;
end;

const
DynaPropAccesibilityCaption = 1;

type
IVADynamicProperty = interface(IInterface)
['{1D1620E9-59D1-475D-94E9-FAE89A601D55}']
function SupportsDynamicProperty(PropertyID: integer): boolean;
function GetDynamicProperty(PropertyID: integer): string;
end;

implementation

{ TVABaseMethodList }

procedure TVABaseMethodList.Add(const Method: TMethod);
begin
if IndexOf(Method) < 0 then
begin
FCode.Add(Method.Code);
FData.Add(Method.Data);
end;
end;

procedure TVABaseMethodList.Clear;
begin
FCode.Clear;
FData.Clear;
end;

function TVABaseMethodList.Count: integer;
begin
Result := FCode.Count;
end;

constructor TVABaseMethodList.Create;
begin
FCode := TList.Create;
FData := TList.Create;
end;

procedure TVABaseMethodList.Delete(index: integer);
begin
FCode.Delete(index);
FData.Delete(index);
end;

destructor TVABaseMethodList.Destroy;
begin
FreeAndNil(FCode);
FreeAndNil(FData);
inherited;
end;

function TVABaseMethodList.GetMethod(index: integer): TMethod;
begin
Result.Code := FCode[index];
Result.Data := FData[index];
end;

function TVABaseMethodList.IndexOf(const Method: TMethod): integer;
begin
if assigned(Method.Code) and assigned(Method.data) and (FCode.Count > 0) then
begin
Result := 0;
while((Result < FCode.Count) and ((FCode[Result] <> Method.Code) or
(FData[Result] <> Method.Data))) do inc(Result);
if Result >= FCode.Count then Result := -1;
end
else
Result := -1;
end;

procedure TVABaseMethodList.Remove(const Method: TMethod);
var
idx: integer;

begin
idx := IndexOf(Method);
if(idx >= 0) then
begin
FCode.Delete(idx);
FData.Delete(idx);
end;
end;

{ TVAMethodList }

procedure TVAMethodList.Add(const Method: TMethod);
begin
inherited Add(Method);
end;

procedure TVAMethodList.Clear;
begin
inherited Clear;
end;

function TVAMethodList.Count: integer;
begin
Result := inherited Count;
end;

constructor TVAMethodList.Create;
begin
inherited Create;
end;

procedure TVAMethodList.Delete(index: integer);
begin
inherited Delete(index);
end;

destructor TVAMethodList.Destroy;
begin
inherited;
end;

function TVAMethodList.IndexOf(const Method: TMethod): integer;
begin
Result := inherited IndexOf(Method);
end;

procedure TVAMethodList.Remove(const Method: TMethod);
begin
inherited Remove(Method);
end;

{ TVANotificationEventComponent }

procedure TVANotificationEventComponent.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if assigned(FOnNotifyEvent) then FOnNotifyEvent(AComponent, Operation);
inherited;
end;

constructor TVANotificationEventComponent.NotifyCreate(AOwner: TComponent;
AOnNotifyEvent: TVANotifyEvent);
begin
inherited Create(AOwner);
FOnNotifyEvent := AOnNotifyEvent;
end;

{ TVALinkedMethodList }

procedure TVALinkedMethodList.Add(Obj: TObject; const Method: TMethod);
begin
if assigned(obj) and assigned(Method.Code) and (IndexOf(Obj) < 0) then
begin
FLinkedObjects.Add(Obj);
Code.Add(Method.Code);
Data.Add(Method.Data);
end;
end;

procedure TVALinkedMethodList.Clear;
begin
FLinkedObjects.Clear;
Code.Clear;
Data.Clear;
end;

function TVALinkedMethodList.Count: integer;
begin
Result := FLinkedObjects.Count;
end;

constructor TVALinkedMethodList.Create;
begin
inherited;
FLinkedObjects := TList.Create;
end;

procedure TVALinkedMethodList.Delete(index: integer);
begin
FLinkedObjects.Delete(index);
Code.Delete(index);
Data.Delete(index);
end;

destructor TVALinkedMethodList.Destroy;
begin
FreeAndNil(FLinkedObjects);
inherited;
end;

function TVALinkedMethodList.GetMethod(Obj: TObject): TMethod;
var
idx: integer;
begin
idx := IndexOf(Obj);
if idx < 0 then
begin
Result.Code := nil;
Result.Data := nil;
end
else
Result := Methods[idx];
end;

function TVALinkedMethodList.IndexOf(const obj: TObject): integer;
begin
if assigned(obj) then
Result := FLinkedObjects.IndexOf(obj)
else
Result := -1;
end;

procedure TVALinkedMethodList.Remove(const obj: TObject);
var
i: integer;
begin
i := IndexOf(obj);
if i >= 0 then
Delete(i);
end;

{ TVAList }

procedure TVAList.Notify(Ptr: Pointer; Action: TListNotification);
begin
if assigned(FOnChange) and (Ptr <> nil) then
begin
if Action = lnAdded then
FOnChange(Self, Ptr, opInsert)
else
FOnChange(Self, Ptr, opRemove)
end;
end;

end.