dmain.pas

来自「FlexGraphics是一套创建矢量图形的VCL组件」· PAS 代码 · 共 475 行

unit dMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IniFiles, ExtCtrls;

const
  // Sections in ini-file
  isMain       = 'Main';
  isPersonnel  = 'Personnel';
  isZones      = 'Zones';
  isPasses     = 'Passes';
  isOptions    = 'Options';

  EmployeeMovementAvgInt = 300; // sec

  MaxEvents    = 50000;
  EventsCut    = 1000;

type
  TPersonType = ( ptIndefinite, ptGuard, ptEmployee );
  TPersonState = ( psPassive, psMovement );

  PPerson = ^TPerson;
  TPerson = record
   Id: integer;
   FirstName: string[31];
   LastName: string[31];
   // Run-time
   PersonType: TPersonType;
   State: TPersonState;
   StateEndTime: TDateTime;
   ZoneId: integer;
   EndZoneId: integer;
   TimeEnter: TDateTime;
   TimeLeave: TDateTime;
  end;

  PZone = ^TZone;
  TZone = record
   Id: integer;
   ParentId: integer;
   Name: string[63];
   // Run-time
   PersonCount: integer;
  end;

  PPass = ^TPass;
  TPass = record
   Id: integer;
   ZoneFromId: integer;
   ZoneToId: integer;
   Name: string[63];
  end;

  PEvent = ^TEvent;
  TEvent = record
   // Run-time
   Time: TDateTime;
   PersonId: integer;
   PassId: integer;
   ZoneId: integer;
   Info: ShortString;
  end;

  TdmMain = class(TDataModule)
   tmMovements: TTimer;
   procedure dmMainCreate(Sender: TObject);
   procedure dmMainDestroy(Sender: TObject);
   procedure tmMovementsTimer(Sender: TObject);
  private
   { Private declarations }
   FIni: TIniFile;
   FUseDB: boolean;
   FPersonnel: TList;
   FZones: TList;
   FOfficeZones: TList; // for movements emulation only
   FPasses: TList;
   FEvents: TList;
   FOnEventAdd: TNotifyEvent;
   procedure LoadFromIni;
   procedure SetupPersons;
   procedure DoPersonMove(Index: integer);
   function  GetZoneById(ZoneId: integer): PZone;
  public
   { Public declarations }
   procedure AddEvent(const EventInfo: string; PassId, ZoneId, PersonId: integer);
   function  FindPerson(PersonId: integer): integer;
   function  FindZone(ZoneId: integer): integer;
   function  FindPass(PassId: integer): integer;
   property  Ini: TIniFile read FIni;
   property  Personnel: TList read FPersonnel;
   property  Zones: TList read FZones;
   property  ZonesById[ZoneId: integer]: PZone read GetZoneById;
   property  OfficeZones: TList read FOfficeZones;
   property  Passes: TList read FPasses;
   property  Events: TList read FEvents;
   property  OnEventAdd: TNotifyEvent read FOnEventAdd write FOnEventAdd;
  end;

var
  dmMain: TdmMain;

function SecToDT(const Sec: integer): TDateTime;

implementation

{$R *.DFM}

uses
  FlexUtils, fMain, fControl, fSplash;

function SecToDT(const Sec: integer): TDateTime;
begin
 Result := Sec / (24*60*60);
end;

// dmMain /////////////////////////////////////////////////////////////////////

procedure TdmMain.dmMainCreate(Sender: TObject);
begin
 dmMain := Self;
 CreateSplash;
 FIni := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
 FPersonnel := TList.Create;
 FZones := TList.Create;
 FOfficeZones := TList.Create;
 FPasses := TList.Create;
 FEvents := TList.Create;
 LoadFromIni;
 SetupPersons;
 Application.CreateForm(TfmMain, fmMain);
 DestroySplash;
end;

procedure TdmMain.dmMainDestroy(Sender: TObject);
var i: integer;
begin
 FIni.Free;
 FOfficeZones.Free;
 for i:=0 to FPersonnel.Count-1 do Dispose(PPerson(FPersonnel[i]));
 FPersonnel.Free;
 for i:=0 to FZones.Count-1 do Dispose(PZone(FZones[i]));
 FZones.Free;
 for i:=0 to FPasses.Count-1 do Dispose(PPass(FPasses[i]));
 FPasses.Free;
 for i:=0 to FEvents.Count-1 do Dispose(PEvent(FEvents[i]));
 FEvents.Free;
end;

function TdmMain.FindPerson(PersonId: integer): integer;
var i: integer;
begin
 Result := -1;
 for i:=0 to FPersonnel.Count-1 do
  if PPerson(FPersonnel[i]).Id = PersonId then begin
   Result := i;
   break;
  end;
end;

function TdmMain.FindZone(ZoneId: integer): integer;
var i: integer;
begin
 Result := -1;
 for i:=0 to FZones.Count-1 do
  if PZone(FZones[i]).Id = ZoneId then begin
   Result := i;
   break;
  end;
end;

function TdmMain.FindPass(PassId: integer): integer;
var i: integer;
begin
 Result := -1;
 for i:=0 to FPasses.Count-1 do
  if PPass(FPasses[i]).Id = PassId then begin
   Result := i;
   break;
  end;
end;

procedure TdmMain.LoadFromIni;
var i, Count: integer;
    s: string;
    Person: PPerson;
    Zone: PZone;
    Pass: PPass;
begin
 FUseDB := FIni.ReadBool(isMain, 'UseDB', False);
 if FUseDB then begin
  // ToDO: load config from database
 end;
 // Read personnel
 Count := FIni.ReadInteger(isPersonnel, 'Count', 0);
 for i:=0 to Count-1 do begin
  s := FIni.ReadString(isPersonnel, 'Item'+IntToStr(i), '');
  if s = '' then continue;
  New(Person);
  try
   FillChar(Person^, SizeOf(Person^), 0);
   Person.Id := StrToInt(ExtractWord(s, 1, ';'));
   Person.LastName := ExtractWord(s, 2, ';');
   Person.FirstName := ExtractWord(s, 3, ';');
   Person.ZoneId := 0; // Initializes as outside zone
   Person.PersonType := ptIndefinite;
   FPersonnel.Add(Person);
  except
   Dispose(Person);
   raise;
  end;
 end;
 // Read zones
 Count := FIni.ReadInteger(isZones, 'Count', 0);
 for i:=0 to Count-1 do begin
  s := FIni.ReadString(isZones, 'Item'+IntToStr(i), '');
  if s = '' then continue;
  New(Zone);
  try
   FillChar(Zone^, SizeOf(Zone^), 0);
   Zone.Id := StrToInt(ExtractWord(s, 1, ';'));
   Zone.ParentId := StrToInt(ExtractWord(s, 2, ';'));
   Zone.Name := ExtractWord(s, 3, ';');
   FZones.Add(Zone);
   if copy(Zone.Name, 1, Length('Office')) = 'Office' then
    FOfficeZones.Add(Zone);
  except
   Dispose(Zone);
   raise;
  end;
 end;
 // Read passes
 Count := FIni.ReadInteger(isPasses, 'Count', 0);
 for i:=0 to Count-1 do begin
  s := FIni.ReadString(isPasses, 'Item'+IntToStr(i), '');
  if s = '' then continue;
  New(Pass);
  try
   FillChar(Pass^, SizeOf(Pass^), 0);
   Pass.Id := StrToInt(ExtractWord(s, 1, ';'));
   Pass.ZoneFromId := StrToInt(ExtractWord(s, 2, ';'));
   Pass.ZoneToId := StrToInt(ExtractWord(s, 3, ';'));
   Pass.Name := ExtractWord(s, 4, ';');
   FPasses.Add(Pass);
  except
   Dispose(Pass);
   raise;
  end;
 end;
end;

procedure TdmMain.AddEvent(const EventInfo: string;
  PassId, ZoneId, PersonId: integer);
var Event: PEvent;
    i: integer;
begin
 if (FEvents.Count >= MaxEvents) {and (EventsCut < MaxEvents)} then begin
  Event := PEvent(FEvents[0]);
  Event.PersonId := 0;
  Event.PassId := 0;
  Event.ZoneId := 0;
  Event.Info := 'System online (old events deleted)';
  for i:=EventsCut+1 to FEvents.Count-1 do begin
   Dispose(PEvent(FEvents[i-EventsCut]));
   FEvents[i-EventsCut] := FEvents[i];
  end;
  FEvents.Count := FEvents.Count - EventsCut;
 end;
 New(Event);
 FillChar(Event^, SizeOf(Event^), 0);
 Event.Time := Now;
 Event.PassId := PassId;
 Event.ZoneId := ZoneId;
 Event.PersonId := PersonId;
 Event.Info := EventInfo;
 FEvents.Add(Event);
 if Assigned(FOnEventAdd) then FOnEventAdd(Self);
end;

procedure TdmMain.SetupPersons;
var i: integer;
    GateZone: PZone;
 function GenerateIndex: integer;
 begin
  // Find random "indefinite" person
  Result := Round(Random*(FPersonnel.Count-1));
  while PPerson(FPersonnel[Result]).PersonType <> ptIndefinite do
   if Result = FPersonnel.Count-1
    then Result := 0
    else inc(Result);
 end;

begin
 RandSeed := 777;
 GateZone := ZonesById[100];
 if Assigned(GateZone) then begin
  // Select 2 guards
  for i:=1 to 2 do with PPerson(FPersonnel[GenerateIndex])^ do begin
   PersonType := ptGuard;
   // Place two guards in gatekeepers office
   ZoneId := 100;
   State := psPassive;
  end;
  GateZone.PersonCount := 2;
 end;
 for i:=0 to FPersonnel.Count-1 do with PPerson(FPersonnel[i])^ do begin
  if PersonType <> ptIndefinite then continue;
  PersonType := ptEmployee;
  State := psPassive;
  StateEndTime := Now + SecToDT(5 + Round(Random*20));
 end;
 Randomize;
end;

procedure TdmMain.DoPersonMove(Index: integer);
var Person: PPerson;
    Zone, SrcZone, DestZone: PZone;
    SrcZones, DestZones: TList;
    Id, Idx: integer;

 procedure MoveTo(Zone: PZone);
 var i, FromZoneId, ToZoneId: integer;
     Pass: PPass;
     Info: string;
 begin
  // Define zone id's
  if Assigned(SrcZone)
   then FromZoneId := SrcZone.Id
   else FromZoneId := 0;
  if Assigned(Zone)
   then ToZoneId := Zone.Id
   else ToZoneId := 0;
  // Find pass
  Pass := Nil;
  for i:=0 to FPasses.Count-1 do with PPass(FPasses[i])^ do
   if (ZoneFromId = FromZoneId) and (ZoneToId = ToZoneId) then begin
    Pass := PPass(FPasses[i]);
    break;
   end;
  if not Assigned(Pass) then begin
   // Pass not found
   Info := Format('%s %s can''t find door from ',
     [Person.FirstName, Person.LastName]);
   if Assigned(SrcZone)
    then Info := Info + SrcZone.Name + ' to '
    else Info := Info + '[outside] to ';
   if Assigned(SrcZone)
    then Info := Info + Zone.Name
    else Info := Info + '[outside]';
   AddEvent(Info, 0, 0, Person.Id);
  end else begin
   // Pass found. Try to open door.
   if fmMain.DoPass(Pass.Id, Person.Id, true) then begin
    // Door is open. Change person counters for zones
    if Assigned(SrcZone) then SrcZone.PersonCount := SrcZone.PersonCount - 1;
    if Assigned(Zone) then Zone.PersonCount := Zone.PersonCount + 1;
    // Set new person location
    Person.ZoneId := Zone.Id;
    if Assigned(Zone) then begin
     Person.TimeEnter := Now;
     Person.TimeLeave := 0;
    end else begin
     Person.TimeEnter := 0;
     if Assigned(SrcZone) then Person.TimeLeave := Now
    end;
    if Person.ZoneId = Person.EndZoneId then begin
     // Move end
     Person.State := psPassive;
     Person.EndZoneId := 0;
    end else begin
     // Move through zone
     Person.State := psMovement;
     Person.StateEndTime := Now + SecToDT(5 + Round(10*Random));
    end;
    if Assigned(fmControl) then fmControl.RefreshInfo;
   end;
  end;
 end;

begin
 Person := PPerson(FPersonnel[Index]);
 SrcZone := ZonesById[Person.ZoneId];
 DestZone := ZonesById[Person.EndZoneId];
 if Person.ZoneId = Person.EndZoneId then begin
  Person.State := psPassive;
  Person.EndZoneId := 0;
  exit;
 end;
 SrcZones := Nil;
 DestZones := Nil;
 try
  // Build source zone parents list
  SrcZones := TList.Create;
  Zone := SrcZone;
  while Assigned(Zone) do begin
   SrcZones.Add(Zone);
   Id := Zone.ParentId;
   Zone := ZonesById[Id];
  end;
  // Build destination zone parents list
  DestZones := TList.Create;
  Zone := DestZone;
  while Assigned(Zone) do begin
   DestZones.Add(Zone);
   Id := Zone.ParentId;
   Zone := ZonesById[Id];
  end;
  // Search movement path
  Idx := DestZones.IndexOf(SrcZone);
  if Idx > 0 then begin
   MoveTo(PZone(DestZones[Idx - 1]));
  end else
  if SrcZones.Count > 1 then
   MoveTo(PZone(SrcZones[1]))
  else
  if DestZones.Count > 0 then
   MoveTo(PZone(DestZones[DestZones.Count - 1]))
  else
  if Person.EndZoneId = 0 then
   MoveTo(Nil) // move outside
  else begin
   // Way not found
   Person.State := psPassive;
   Person.EndZoneId := 0;
  end;
 finally
  SrcZones.Free;
  DestZones.Free;
 end;
end;

procedure TdmMain.tmMovementsTimer(Sender: TObject);
var i: integer;
    TimeNow: TDateTime;
    Zone: PZone;
begin
 TimeNow := Now;
 // Check personnel movements
 for i:=0 to FPersonnel.Count-1 do with PPerson(FPersonnel[i])^ do begin
  if PersonType = ptIndefinite then continue;
  if (StateEndTime = 0) or (StateEndTime - TimeNow > 0) then continue;
  case PersonType of
   ptEmployee:
     begin
      if State = psPassive then begin
       if FOfficeZones.Count = 0 then continue;
       // Select new office
       Zone := PZone(FOfficeZones[Round(Random*(FOfficeZones.Count-1))]);
       EndZoneId := Zone.Id;
      end;
      DoPersonMove(i);
      if State = psPassive then
       StateEndTime := TimeNow +
         //SecToDT(EmployeeMovementAvgInt + Round(Random*60) - 30);
         SecToDT(Round(Random*EmployeeMovementAvgInt));
     end;
  end;
 end;
end;

function TdmMain.GetZoneById(ZoneId: integer): PZone;
var Index: integer;
begin
 Index := FindZone(ZoneId);
 if Index < 0
  then Result := Nil
  else Result := PZone(FZones[Index]);
end;

end.