CentrED/UOLib/UMulBlock.pas

172 lines
4.0 KiB
Plaintext
Raw Permalink Normal View History

2015-05-01 12:14:15 +02:00
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMulBlock;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes;
type
TMulBlock = class;
TMulBlockChanged = procedure(ABlock: TMulBlock) of object;
{ TMulBlockEventHandler }
TMulBlockEventHandler = class
constructor Create;
destructor Destroy; override;
protected
FEvents: TList;
public
procedure RegisterEvent(AEvent: TMulBlockChanged);
procedure UnregisterEvent(AEvent: TMulBlockChanged);
procedure FireEvents(ABlock: TMulBlock);
end;
{ TMulBlock }
TMulBlock = class
constructor Create;
destructor Destroy; override;
protected
FID: Integer;
FOnChanged: TMulBlockChanged;
FOnFinished: TMulBlockChanged;
FOnDestroy: TMulBlockEventHandler;
public
class procedure Change(ABlock: TMulBlock); virtual;
class procedure Finish(var ABlock: TMulBlock); virtual;
function Clone: TMulBlock; virtual; abstract;
function GetSize: Integer; virtual; abstract;
procedure Write(AData: TStream); virtual; abstract;
property ID: Integer read FID write FID;
property OnChanged: TMulBlockChanged read FOnChanged write FOnChanged;
property OnFinished: TMulBlockChanged read FOnFinished write FOnFinished;
property OnDestroy: TMulBlockEventHandler read FOnDestroy;
end;
implementation
type
PMethod = ^TMethod;
{ TMulBlockEventHandler }
constructor TMulBlockEventHandler.Create;
begin
inherited Create;
FEvents := TList.Create;
end;
destructor TMulBlockEventHandler.Destroy;
var
i: Integer;
begin
if FEvents <> nil then
begin
for i := 0 to FEvents.Count - 1 do
Dispose(PMethod(FEvents.Items[i]));
FreeAndNil(FEvents);
end;
inherited Destroy;
end;
procedure TMulBlockEventHandler.RegisterEvent(AEvent: TMulBlockChanged);
var
eventInfo: PMethod;
begin
//UnregisterEvent(AEvent);
New(eventInfo);
eventInfo^.Code := TMethod(AEvent).Code;
eventInfo^.Data := TMethod(AEvent).Data;
FEvents.Add(eventInfo);
end;
procedure TMulBlockEventHandler.UnregisterEvent(AEvent: TMulBlockChanged);
var
i: Integer;
function RemoveEntry: Boolean;
begin
Dispose(PMethod(FEvents.Items[i]));
FEvents.Delete(i);
Result := True;
end;
begin
i := 0;
while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do
Inc(i);
end;
procedure TMulBlockEventHandler.FireEvents(ABlock: TMulBlock);
var
i: Integer;
begin
for i := 0 to FEvents.Count - 1 do
TMulBlockChanged(FEvents.Items[i]^)(ABlock);
end;
{ TMulBlock }
constructor TMulBlock.Create;
begin
inherited Create;
FOnDestroy := TMulBlockEventHandler.Create;
end;
destructor TMulBlock.Destroy;
begin
if FOnDestroy <> nil then
begin
FOnDestroy.FireEvents(Self);
FreeAndNil(FOnDestroy);
end;
inherited Destroy;
end;
class procedure TMulBlock.Change(ABlock: TMulBlock);
begin
if ABlock <> nil then
begin
if ABlock.OnChanged <> nil then ABlock.OnChanged(ABlock);
end;
end;
class procedure TMulBlock.Finish(var ABlock: TMulBlock);
begin
if ABlock <> nil then
begin
if ABlock.OnFinished <> nil then ABlock.OnFinished(ABlock) else ABlock.Free;
ABlock := nil;
end;
end;
end.