ults.Items.Clear;
for i: = 0 to FEventQueue.Count - 1 do begin
with TEventRec (FEventQueue [i] ^) do begin
case Event of
EV_TAKE: S: = '+ + +:';
EV_REFUSE: S: = '------:';
EV_PASS: S: = 'PASS:';
end;
S: = S + IntToStr (Info);
S: = S + '[' + IntToStr (SysTime) + ']';
if Assigned (Source) then S: = S + TElement (Source). Name
else S: ​​= S + 'nil';
S: = S + '->';
if Assigned (Sender) then S: = S + TElement (Sender). Name
else S: ​​= S + 'nil';
end;
Form1.mResults.Items.Add (S);
end;}
end;
procedure TQSheme.RedrawDiagram;
// var i: integer;
begin
// Diagram.Canvas.FillRect (Rect (0,0, Diagram.Width, Diagram.Height));
// DrawElementLines;
DisplayEvents;
end;
initialization
Randomize;
end.
unit QSObjs;
interface
uses Classes, QSTypes, SysUtils, Utils;
type
TElement = class;
TIsRightElement = function (Element: TElement): Boolean of object ;//far;
TBeforeAfterAction = procedure (Sender: TElement) of object;
TElement = class
private
FId: integer;
FName: string;
FSources: TList;
FSheme: TObject;
FContainer: TParcel;
FOnSourceValidate: TIsRightElement;
FOnDestinationValidate: TIsRightElement;
FBeforeTake: TBeforeAfterAction;
FAfterTake: TBeforeAfterAction;
FBeforeDrop: TBeforeAfterAction;
FAfterDrop: TBeforeAfterAction;
procedure SetSheme (ASheme: TObject);
function GetSourceCount: integer;
function GetSource (Index: integer): TElement;
function GetParcelPresent: Boolean;
function GetCanDropParcelFor (Destination: TElement): Boolean;
function GetCanTakeParcelFrom (Source: TElement): Boolean;
procedure Pass (SourceIndex: integer); virtual;
protected
function GetCanTake: Boolean; virtual; abstract;
function GetCanDrop: Boolean; virtual; abstract;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AddSource (Element: TElement);
procedure DelSource (Element: TElement);
procedure AskForParcel; virtual;
procedure ClearContainer; virtual;
procedure RefuseParcel (SourceIndex: integer);
procedure DropParcel; virtual;
procedure TakeParcel (SourceIndex: integer); virtual;
procedure DoBeforeDrop (Sender: TElement);
procedure DoBeforeTake (Sender: TElement);
procedure DoAfterDrop (Sender: TElement);
procedure DoAfterTake (Sender: TElement);
property CanDropParcelFor [Destination: TEle...
