fmain.pas

来自「FlexGraphics是一套创建矢量图形的VCL组件」· PAS 代码 · 共 931 行 · 第 1/2 页

procedure TfmMain.SortLamps;
var Sorted: boolean;
    i: integer;
    Lamp: pointer;
begin
 // Bubble sorting
 repeat
  Sorted := true;
  for i:=1 to FLamps.Count-1 do
   if TFlexControl(FLamps[i]).Tag < TFlexControl(FLamps[i-1]).Tag then begin
    Lamp := FLamps[i];
    FLamps[i] := FLamps[i-1];
    FLamps[i-1] := Lamp;
    Sorted := false;
   end;
 until Sorted;
end;

procedure TfmMain.PaintActive(AsActive: boolean);
var Style: TColorStyles;
    i, ZoneId, Index: integer;
begin
 if not Assigned(FLastActive) then begin
  FLastActiveStyle := csNone;
  exit;
 end;
 Index := FLastActive.UserData.IndexOfName('ZoneID');
 if Index >= 0 then begin
  Style := csZone;
  if Options.ShowZoneCaptions = zsSelected then begin
   // Show or hide associated ZoneNames
   ZoneId := StrToIntDef(FLastActive.UserData.ValuesByIndex[Index], 0);
   for i:=0 to FZoneNames.Count-1 do
    if TFlexControl(FZoneNames[i]).Tag = ZoneId then
     TFlexControl(FZoneNames[i]).Visible := AsActive;
  end;
 end else
 if FLastActive = FCopyright then
  Style := csCopyright
 else
 if FLastActive.ParentScheme.Name = 'MainPlan'
  then Style := csBuildings
  else Style := csButtons;
 PaintControl(AsActive, FLastActive, Style);
 FLastActiveStyle := Style;
end;

procedure TfmMain.PaintSchemeBtn(AsActive: boolean);
begin
 PaintControl(AsActive, FSchemeBtn, csSchemeBtn);
end;

function TfmMain.GetSchemeBtn(PTabIndex: PInteger = Nil): TFlexControl;
const
  Names: array[0..9, 0..1] of string = (
    ( 'MainPlan', '' ),
    ( 'AdmGrandFloor', 'BtnGrand' ),
    ( 'AdmFloor1', 'BtnFloor1' ),
    ( 'AdmFloor2', 'BtnFloor2' ),
    ( 'ControlPost', '' ),
    ( 'ProdGrandFloor', 'BtnGrand' ),
    ( 'ProdFloor1', 'BtnFloor1' ),
    ( 'ProdFloor2', 'BtnFloor2' ),
    ( 'TechGrandFloor', 'BtnGrand' ),
    ( 'TechFloor1', 'BtnFloor1' )
  );
var
  i: integer;
  Scheme: TFlexCustomScheme;
begin
 if Assigned(PTabIndex) then PTabIndex^ := -1;
 Result := Nil;
 Scheme := fpMain.ActiveScheme;
 if not Assigned(Scheme) then exit;
 for i:=0 to High(Names) do
  if CompareText(Names[i,0], Scheme.Name) = 0 then begin
   if Assigned(PTabIndex) then
    case i of
     0    : PTabIndex^ := 0;
     1..3 : PTabIndex^ := 2;
     4    : PTabIndex^ := 1;
     5..7 : PTabIndex^ := 3;
     8, 9 : PTabIndex^ := 4;
    end;
   if Names[i, 1] <> '' then Result := Scheme.FindByName(Names[i, 1]);
   break;
  end;
end;

procedure TfmMain.fpMainNotify(Sender: TObject; Control: TFlexControl;
  Notify: TFlexNotify);
var BtnControl: TFlexControl;
    TabIdx: integer;
    Id, Index: integer;
    Card: TFlexCard;
begin
 if csDestroying in ComponentState then exit;
 case Notify of
  fnRect:
    if (fpMain.ToolMode = ftmMoving) and
       (Control.UserData.Values['Type'] = 'Card') then begin
     Card := FindFlexCard(Nil, Control);
     if Assigned(Card) then Card.SavePosition;
    end;
  fnLoaded:
    begin
     // Checking Lamp
     if Control.Name = 'Lamp' then begin
      FLamps.Add(Control);
     end else
     // Checking copyright string
     if Control.Name = 'Copyright' then
      FCopyright := TFlexText(Control)
     else
     // Checking ZoneNames layer
     if (Control is TFlexLayer) and (Control.Name = 'ZoneNames') then
      FZoneNamesLayer := TFlexLayer(Control)
     else
     // Checking door control
     if Control is TFlexDoor then begin
      FDoors.Add(Control);
      TFlexDoor(Control).DoorState := dsClosed;
     end else
     // Checking ZoneName controls
     if Control.Name = 'ZoneName' then begin
      FZoneNames.Add(Control);
      Control.Visible := False;
      TFlexText(Control).WordWrap := true;
      Id := StrToIntDef(Control.UserData.Values['ZoneID'], 0);
      Control.Tag := Id;
      Index := dmMain.FindZone(Id);
      if Index >= 0 then
       TFlexText(Control).TextProp.Text := PZone(dmMain.Zones[Index]).Name;
     end else
     // Checking zone controls
     if (Control.UserData.IndexOfName('ZoneID') >= 0) and
        (Control.UserData.IndexOfName('Level') >= 0) then begin
      FZones.Add(Control);
      Id := StrToIntDef(Control.UserData.Values['ZoneID'], 0);
      Index := dmMain.FindZone(Id);
      if Index >= 0 then
       Control.Hint := PZone(dmMain.Zones[Index]).Name;
     end;
    end;
  fnSchemes:
    begin
     if Assigned(FSelected) then
      if fpMain.ActiveScheme <> FSelected.ParentScheme
       then tmSelected.Enabled := false
       else tmSelected.Enabled := true;
     PaintActive(False);
     FLastActive := Nil;
     // Scheme button checking
     BtnControl := GetSchemeBtn(@TabIdx);
     if BtnControl <> FSchemeBtn then begin
      PaintSchemeBtn(False);
      FSchemeBtn := BtnControl;
      PaintSchemeBtn(True);
     end;
     tbMain.TabIndex := TabIdx;
     HideAllPersonCards;
    end;
  fnScale:
    begin
     sbtZoomIn.Enabled := fpMain.Scale < 400;
     sbtZoomOut.Enabled := fpMain.Scale > 50;
    end;
 end;

end;

procedure TfmMain.fpMainMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var Id, Index: integer;
    s: string;

 function IsActive(Control: TFlexControl): boolean;
 begin
  Result := Assigned(Control);
  if not Result then exit;
  Result :=  Assigned(Control.Reference) or
             (Control.UserData.IndexOfName('ZoneID') >= 0) or
             (Control = FCopyright);
 end;

begin
 if not Assigned(fpMain.ActiveScheme) then exit;
 // Checking last active control (button or building on main scheme)
 if fpMain.MouseControl <> FLastActive then begin
  PaintActive(False);
  if IsActive(fpMain.MouseControl) then begin
   FLastActive := fpMain.MouseControl;
   PaintActive(True);
  end else
   FLastActive := Nil;
 end;
 // Update status bar
 s := '';
 if Assigned(FLastActive) then
  case FLastActiveStyle of
   csBuildings:
     begin
      if CompareText(FLastActive.Name, 'Administrate') = 0 then
       s := 'Go to Administrative building plans'
      else
      if CompareText(FLastActive.Name, 'Production') = 0 then
       s := 'Go to Production building plans'
      else
      if CompareText(FLastActive.Name, 'Tech center') = 0 then
       s := 'Go to Technical center plans'
      else
      if CompareText(FLastActive.Name, 'Control Post') = 0 then
       s := 'Go to Control post plan';
      if s <> '' then
       FLastActive.Hint := s;
     end;
   csZone:
     begin
      Id := StrToIntDef(FLastActive.UserData.Values['ZoneID'], 0);
      Index := dmMain.FindZone(id);
      if Index >= 0 then with PZone(dmMain.Zones[Index])^ do
       s := Format('Zone %d: %s', [Id, Name])
      else
       s := 'Unknown zone';
     end;
  end;
 sbMain.SimpleText := s;
end;

procedure TfmMain.fpMainMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if Sender = fpMain then begin
  fpMain.SetFocus;
  if not fpMain.Focused then Windows.SetFocus(fpMain.Handle);
 end;
 if fpMain.ToolMode <> ftmSelect then exit;
 if (Button = mbLeft) and Assigned(fpMain.MouseSubControl) then begin
  if (FZones.IndexOf(fpMain.MouseSubControl) >= 0) or
     (FDoors.IndexOf(fpMain.MouseSubControl) >= 0) then
   Selected := fpMain.MouseSubControl
  else
  if fpMain.MouseSubControl = FCopyright then begin
   PaintActive(False);
   FLastActive := Nil;
   sbtAbout.Click
  end else
  if fpMain.MouseControl.UserData.Values['Type'] = 'Card' then begin
   fpMain.UnselectAll;
   fpMain.Select(fpMain.MouseControl);
   fpMain.ToolMode := ftmMoving;
  end else
  if not Assigned(fpMain.MouseControl.Reference) then
   Selected := Nil;
 end else
  Selected := Nil;
end;

procedure TfmMain.sbtExitClick(Sender: TObject);
begin
 Close;
end;

procedure TfmMain.sbtControlClick(Sender: TObject);
begin
 ShowLists;
end;

procedure TfmMain.fpMainExit(Sender: TObject);
begin
 PaintActive(False);
 FLastActive := Nil;
end;

procedure TfmMain.sbtOptionsClick(Sender: TObject);
begin
 if EditOptions then begin
  SetOptions;
  SaveOptions;
 end;
end;

procedure TfmMain.sbtZoomClick(Sender: TObject);
begin
 if Sender = sbtZoomIn then
  fpMain.Zoom(fpMain.Scale * 2, Nil)
 else
 if Sender = sbtZoomOut then
  fpMain.Zoom(fpMain.Scale div 2, Nil)
end;

procedure TfmMain.sbtAboutClick(Sender: TObject);
begin
 ShowAbout;
end;

procedure TfmMain.EventsChange(Sender: TObject);
begin
 if Assigned(fmControl) then fmControl.RefreshEvents;
end;

procedure TfmMain.SetDoorTimeOut(Door: TFlexDoor; PassId: integer);
var i: integer;
    TimeOut: PDoorTimeOut;
begin
 // Find door in persent timeouts
 TimeOut := Nil;
 for i:=0 to FDoorsTimeOuts.Count-1 do
  if PDoorTimeOut(FDoorsTimeOuts[i]).Door = Door then begin
   TimeOut := PDoorTimeOut(FDoorsTimeOuts[i]);
   break;
  end;
 if not Assigned(TimeOut) then begin
  // Create new timeout
  New(TimeOut);
  FillChar(TimeOut^, SizeOf(TimeOut^), 0);
  TimeOut.Door := Door;
  FDoorsTimeOuts.Add(TimeOut);
 end;
 TimeOut.PassId := PassId;
 TimeOut.TimeToClose := Now + SecToDT(3);
end;

function TfmMain.DoPass(PassId, PersonId: integer; DoOpen: boolean): boolean;
var Door: TFlexControl;
    Info: string;
    Index: integer;
    IsBlocked: boolean;
    NewDoorState: TDoorState;
    NewDoorEvent: TDoorEvent;
    NewAccessDir: TDoorAccessDirection;
begin
 Result := false;
 Door := fmMain.FindPass(PassId);
 if Assigned(Door) then with TFlexDoor(Door) do begin
  IsBlocked := DoorEvent = deBroken;
  // Define direction
  if PassAProp.Value = PassId
   then NewAccessDir := ddForward
   else NewAccessDir := ddBackward;
  // Define state
  if DoOpen then begin
   NewDoorState := dsOpened;
   if IsBlocked
    then Info := 'Attempt to open blocked door %d by '
    else Info := 'Door %d opened by ';
  end else begin
   NewDoorState := dsClosed;
   if IsBlocked
    then Info := 'Attempt to close blocked door %d by '
    else Info := 'Door %d closed by ';
  end;
  // Define person
  if PersonId = -1 then begin
   // is time out
   NewDoorEvent := DoorEvent; //deInactive;
   Info := Info + 'timeout';
  end else
  if PersonId = 0 then begin
   // is operator
   NewDoorEvent := deInactive;
   Info := Info + 'operator';
  end else begin
   // is person
   Index := dmMain.FindPerson(PersonId);
   if Index >= 0 then with PPerson(dmMain.Personnel[Index])^ do begin
    Info := Info + FirstName + ' ' + LastName;
    NewDoorEvent := deValid;
   end else begin
    // Alert. Unknown person
    Info := Info + '<unknown>';
    NewDoorEvent := deError;
   end;
  end;
  if not IsBlocked then begin
   // Set new state
   AccessDir := NewAccessDir;
   DoorEvent := NewDoorEvent;
   DoorState := NewDoorState;
   if DoorState = dsOpened then SetDoorTimeOut(TFlexDoor(Door), PassId);
   if not FMinimized {(WindowState <> wsMinimized)} and
      Options.ShowPersonsCards then
    if Options.ShowCardsInFlex then begin
     // Flex card
     if DoorState = dsOpened
      then ShowFlexCard(PassId, PersonId, Door)
      else DestroyFlexCard(Door);
    end else
    // Card as form
    if Door.ParentScheme = fpMain.ActiveScheme then
     if DoorState = dsOpened
      then ShowPersonCard(PassId, PersonId, Door)
      else HidePersonCard(Door);
   Result := true;
  end else begin
   // Alarm state
   Result := DoorState = dsOpened;
   if not Result then
    if Options.ShowCardsInFlex then
     // Flex card
     ShowFlexCard(PassId, PersonId, Door, True)
    else
    // Card as form
    if Door.ParentScheme = fpMain.ActiveScheme then
     ShowPersonCard(PassId, PersonId, Door, True);
  end;
  // Add event
  dmMain.AddEvent(Format(Info, [PassId]), PassId, 0, PersonId);
 end;
end;

procedure TfmMain.DoBlock(PassId: integer; IsBlock: boolean);
var Door: TFlexDoor;
    Info: string;
    IsBlocked: boolean;
begin
 Door := TFlexDoor(fmMain.FindPass(PassId));
 if not Assigned(Door) then exit;
 IsBlocked := Door.DoorEvent = deBroken;
 if IsBlocked = IsBlock then exit;
 if IsBlock then begin
  Info := 'Door %d blocked by operator';
  Door.DoorEvent := deBroken;
 end else begin
  Info := 'Door %d unblocked by operator';
  Door.DoorEvent := deInactive;
 end;
 // Add event
 dmMain.AddEvent(Format(Info, [PassId]), PassId, 0, 0);
end;

procedure TfmMain.tmTimeOutsTimer(Sender: TObject);
var i: integer;
begin
 for i:=FDoorsTimeOuts.Count-1 downto 0 do
  with PDoorTimeOut(FDoorsTimeOuts[i])^ do
   if Now - TimeToClose >= 0 then begin
    DoPass(PassId, -1, False);
    Dispose(PDoorTimeOut(FDoorsTimeOuts[i]));
    FDoorsTimeOuts.Delete(i);
   end;
end;

procedure TfmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (Key = VK_MENU) and (fpMain.ToolMode = ftmSelect) and
    not Assigned(fpMain.CreatingControlClass) then
  fpMain.ToolMode := ftmPan
 else
 if Key = vk_F1 then sbtAbout.Click;
end;

procedure TfmMain.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (Key = VK_MENU) and
   ((fpMain.ToolMode = ftmPan) or (fpMain.ToolMode = ftmPanning)) then
  fpMain.ToolMode := ftmSelect;
end;

end.