fmain.pas

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

unit fMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FlexBase, FlexUtils, FlexControls, FlexProps, Utils, ComCtrls, StdCtrls,
  ImgList, ExtCtrls, ToolWin, Buttons, ACCtrls, FlexPath;

type
  TfmMain = class(TForm)
    sbMain: TStatusBar;
    tbMain: TTabControl;
    tmSelected: TTimer;
    Panel1: TPanel;
    Panel2: TPanel;
    sbtControl: TSpeedButton;
    sbtZoomIn: TSpeedButton;
    sbtZoomOut: TSpeedButton;
    sbtOptions: TSpeedButton;
    sbtAbout: TSpeedButton;
    sbtExit: TSpeedButton;
    tmLamps: TTimer;
    tmTimeOuts: TTimer;
    fpMain: TFlexPanel;
    procedure FormCreate(Sender: TObject);
    procedure tbMainChange(Sender: TObject);
    procedure fpMainMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure fpMainNotify(Sender: TObject; Control: TFlexControl;
      Notify: TFlexNotify);
    procedure FormDestroy(Sender: TObject);
    procedure sbtExitClick(Sender: TObject);
    procedure sbtControlClick(Sender: TObject);
    procedure fpMainExit(Sender: TObject);
    procedure sbtOptionsClick(Sender: TObject);
    procedure fpMainPaintOver(ACanvas: TCanvas; AControl: TFlexControl;
      ChildrenOnly, SelectedOnly: Boolean);
    procedure tmSelectedTimer(Sender: TObject);
    procedure fpMainMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sbtZoomClick(Sender: TObject);
    procedure sbtAboutClick(Sender: TObject);
    procedure tmLampsTimer(Sender: TObject);
    procedure tmTimeOutsTimer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    FCopyright: TFlexText;
    FSelectionBrush: TBrush;
    FSelected: TFlexControl;
    FSelectedDisp: integer;
    FZoneNamesLayer: TFlexLayer;
    FZoneNames: TList;
    FZones: TList;
    FDoors: TList;
    FLamps: TList;
    FLampsDisp: integer;
    FLastActive: TFlexControl;
    FLastActiveStyle: TColorStyles;
    FSchemeBtn: TFlexControl;
    FDoorsTimeOuts: TList;
    FMinimized: boolean;
    procedure SortLamps;
    function  GetSchemeBtn(PTabIndex: PInteger = Nil): TFlexControl;
    procedure PaintActive(AsActive: boolean);
    procedure PaintSchemeBtn(AsActive: boolean);
    procedure SetSelected(const Value: TFlexControl);
    function  CreateSelectedRegion(ForInvalidate: boolean = false): HRGN;
    procedure RefreshSelected;
    procedure EventsChange(Sender: TObject);
    procedure SetDoorTimeOut(Door: TFlexDoor; PassId: integer);
    procedure AppMinimize(Sender: TObject);
    procedure AppMaximize(Sender: TObject);
    procedure PaintMarquee(DC: HDC);
  public
    { Public declarations }
    procedure SetOptions;
    function  FindZone(ZoneId: integer): TFlexControl;
    function  FindPass(PassId: integer): TFlexControl;
    function  DoPass(PassId, PersonId: integer; DoOpen: boolean): boolean;
    procedure DoBlock(PassId: integer; IsBlock: boolean);
    property  Selected: TFlexControl read FSelected write SetSelected;
  end;

var
  fmMain: TfmMain;

implementation

{$R *.DFM}

uses
  dMain, fControl, fOptions, fAboutPrg, fSplash, fPersCard, FlexCards;

type
  PDoorTimeOut = ^TDoorTimeOut;
  TDoorTimeOut = record
   Door: TFlexDoor;
   PassId: integer;
   TimeToClose: TDateTime;
  end;

procedure TfmMain.FormCreate(Sender: TObject);
var i, NewWidth, NewHeight: integer;
begin
 // Creating lists
 FZoneNames := TList.Create;
 FZones := TList.Create;
 FDoors := TList.Create;
 FLamps := TList.Create;
 FDoorsTimeOuts := TList.Create;
 // Creating selection brush
 FSelectionBrush := CreateSelectionBrush(clNavy);
 // Loading from file
 LoadFlexCursors;
 fpMain.OnProgress := fmSplash.FlexProgress;
 Screen.Cursor := crHourGlass;
 try
  fpMain.LoadFromFile(ExtractFilePath(ParamStr(0))+'access.fxd');
 finally
  fpMain.OnProgress := Nil;
  Screen.Cursor := crDefault;
 end;
 // Cache all schemes bitmap
 for i:=0 to fpMain.Schemes.Count-1 do
  (fpMain.Schemes[i] as TFlexScheme).BrushProp.BitmapCache := true;
 // Sort lamp controls
 SortLamps;
 // Adjust window size
 fpMain.HorzScrollBar.Visible := False;
 fpMain.VertScrollBar.Visible := False;
 NewWidth := Width + (fpMain.DocWidth - fpMain.ClientWidth);
 NewHeight := Height + (fpMain.DocHeight - fpMain.ClientHeight);
 if (NewWidth > Screen.Width) or (NewHeight > Screen.Height) then
  WindowState := wsMaximized
 else begin
  Width := NewWidth;
  Height := NewHeight;
 end;
 fpMain.HorzScrollBar.Visible := True;
 fpMain.VertScrollBar.Visible := True;
 // Making layer "ZoneNames" non selectable
 if Assigned(FZoneNamesLayer) then FZoneNamesLayer.Selectable := false;
 fpMain.Layers.ByName['Building'].Selectable := false;
 FCopyright.Hint := 'About';
 // Load and set options from ini-file
 LoadOptions;
 SetOptions;
 // Start event
 dmMain.OnEventAdd := EventsChange;
 dmMain.AddEvent('System online', 0, 0, 0);
 tmTimeOuts.Enabled := true;
 Application.OnMinimize := AppMinimize;
 Application.OnRestore := AppMaximize;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
 dmMain.tmMovements.Enabled := false;
 DestroyAllFlexCards;
 HideAllPersonCards;
 // Destroy selection brush
 if Assigned(FSelectionBrush) then begin
  FSelectionBrush.Bitmap.Free;
  FSelectionBrush.Bitmap := Nil;
  FSelectionBrush.Free;
  FSelectionBrush := Nil;
 end;
 // Destroy lists
 FZoneNames.Free;
 FZones.Free;
 FDoors.Free;
 FLamps.Free;
 // Destroy door timeouts
 while FDoorsTimeOuts.Count > 0 do begin
  Dispose(PDoorTimeOut(FDoorsTimeOuts[FDoorsTimeOuts.Count-1]));
  FDoorsTimeOuts.Delete(FDoorsTimeOuts.Count-1);
 end;
 FDoorsTimeOuts.Free;
end;

procedure TfmMain.AppMinimize(Sender: TObject);
begin
 FMinimized := true;
 HideAllPersonCards;
end;

procedure TfmMain.AppMaximize(Sender: TObject);
begin
 FMinimized := false;
end;

procedure TfmMain.SetSelected(const Value: TFlexControl);
var Index: integer;
    Rgn: HRGN;
begin
 if Value = FSelected then exit;
 // Invalidate frame around old selected control
 if Assigned(FSelected) then begin
  //RefreshSelected;
  Rgn := CreateSelectedRegion(True);
  InvalidateRgn(fpMain.Handle, Rgn, false);
  DeleteObject(Rgn);
  FSelected := Nil;
 end;
 // Check Value parent scheme
 if Assigned(Value) and (Value.ParentScheme <> fpMain.ActiveScheme) then
  fpMain.ActiveScheme := Value.ParentScheme;
 // Set new selected control
 FSelected:= Value;
 if Assigned(FSelected) then begin
  // Start refresh timer
  tmSelected.Enabled := true;
  // Invalidate frame around new selected control
  RefreshSelected;
  if Assigned(fmControl) then begin
   // Locate object in lists
   if FSelected is TFlexDoor then begin
    // Locate PassA of FlexDoor
    Index := dmMain.FindPass(TFlexDoor(FSelected).PassAProp.Value);
    if Index >= 0 then begin
     fmControl.lbPasses.ItemIndex := Index;
     fmControl.pgTables.ActivePage := fmControl.tsPasses;
    end else
     fmControl.lbPasses.ItemIndex := -1;
    fmControl.RefreshPassInfo;
   end else
   if TFlexControl(FSelected).UserData.Values['ZoneID'] <> '' then begin
    // Locate zone
    Index := StrToIntDef(TFlexControl(FSelected).UserData.Values['ZoneID'], 0);
    Index := dmMain.FindZone(Index);
    if Index >= 0 then begin
     fmControl.lbZones.ItemIndex := Index;
     fmControl.pgTables.ActivePage := fmControl.tsZones;
    end else
     fmControl.lbZones.ItemIndex := -1;
    fmControl.RefreshZoneInfo;
   end;
  end;
 end;
end;

function TfmMain.CreateSelectedRegion(ForInvalidate: boolean = false): HRGN;
var GroupRect: TRect;
    GroupInited: boolean;

 procedure ProcessControl(Control: TFlexControl);
 var i: integer;
     Points: TPointArray;
     Rgn: HRGN;
 begin
  Points := Nil;
  if Control is TFlexGroup then begin
   // Process group controls
   for i:=0 to Control.Count-1 do ProcessControl(Control[i]);
  end else
  if ForInvalidate then begin
   // Create region for bounding box
   if GroupInited then
    UnionRect(GroupRect, GroupRect, Control.PaintRect)
   else begin
    GroupRect := Control.PaintRect;
    GroupInited := true;
   end;
  end else begin
   if Control.PointCount > 0 then with Control.PaintRect do begin
    // Process polyline
    Points := Control.GetTransformPoints(Left, Top, fpMain.Scale);
    Rgn := CreatePolygonRgn(Points[0], Length(Points), ALTERNATE);
   end else
   if Control is TFlexEllipse then
    // Process ellipse
    Rgn := CreateEllipticRgnIndirect(Control.PaintRect)
   else
   if Control is TFlexBox then with Control.PaintRect do begin
    // Process rectangle
    if TFlexBox(Control).RoundnessProp.Value > 0 then begin
     i := ScaleValue(TFlexBox(Control).RoundnessProp.Value, Control.Owner.Scale);
     Rgn := CreateRoundRectRgn(Left, Top, Right+1, Bottom+1, i, i);
    end else
     Rgn := CreateRectRgnIndirect(Control.PaintRect);
   end else
    // Process unknown other control (as rect)
    Rgn := CreateRectRgnIndirect(Control.PaintRect);
   if Rgn = 0 then exit;
   if Result = 0 then
    Result := Rgn
   else begin
    CombineRgn(Result, Result, Rgn, RGN_OR);
    DeleteObject(Rgn);
   end;
  end;
 end;

begin
 Result := 0;
 if not Assigned(FSelected) then exit;
 GroupInited := not ForInvalidate;
 ProcessControl(FSelected);
 if ForInvalidate and GroupInited then with GroupRect do
  Result := CreateRectRgn(Left, Top, Right+1, Bottom+1);
end;

procedure TfmMain.PaintMarquee(DC: HDC);
var Rgn: HRGN;
    P: TPoint;
begin
 // Paint selected frame
 Rgn := CreateSelectedRegion;
 if Rgn = 0 then exit;
 SetBrushOrgEx(DC, 7-FSelectedDisp, 7-FSelectedDisp, @P);
 FrameRgn(DC, Rgn, FSelectionBrush.Handle,
   Options.SelFrameWidth, Options.SelFrameWidth);
 SetBrushOrgEx(DC, P.X, P.Y, Nil);
 DeleteObject(Rgn);
end;

procedure TfmMain.fpMainPaintOver(ACanvas: TCanvas; AControl: TFlexControl;
  ChildrenOnly, SelectedOnly: Boolean);
begin
 if Assigned(FSelected) and tmSelected.Enabled then
  PaintMarquee(ACanvas.Handle);
end;

procedure TfmMain.RefreshSelected;
var DC: HDC;
begin
 if not Assigned(FSelected) then exit;
 DC := GetDC(fpMain.Handle);
 try
  PaintMarquee(DC);
 finally
  ReleaseDC(fpMain.Handle, DC);
 end;
end;

procedure TfmMain.tmSelectedTimer(Sender: TObject);
begin
 dec(FSelectedDisp);
 FSelectedDisp := FSelectedDisp and 7;
 RefreshSelected;
end;

procedure TfmMain.tmLampsTimer(Sender: TObject);
const
  NumColors = 6;
  RunColors: array[0..NumColors-1] of TColor = (
   // $00800000, $00901D0A, $00A84717, $00BF7125, $00D89B32, $00EEC440 );
      $000000FF, $00002AFF, $000064FF, $00009CFF, $0000D5FF, $0000FFFF );
   // $00800000, $00800000, $00800000, $00800000, $00800000, $00FFFFFF );
var i, Idx: integer;
begin
 if FLampsDisp = 0
  then FLampsDisp := NumColors - 1
  else dec(FLampsDisp);
 for i:=0 to FLamps.Count-1 do with TFlexEllipse(FLamps[i]) do
  case Options.LampsEffect of
   leRunning:
     begin
      Idx := (i+FLampsDisp) mod NumColors;
      BrushProp.Color := RunColors[Idx];
     end;
   leFlashing:
     if (i+FLampsDisp) and 1 = 0
      then BrushProp.Color := clNavy
      else BrushProp.Color := clAqua;
  end;
end;

function TfmMain.FindZone(ZoneId: integer): TFlexControl;
var i: integer;
begin
 Result := Nil;
 for i:=0 to FZones.Count-1 do
  if StrToIntDef(TFlexControl(FZones[i]).UserData.Values['ZoneID'], 0) =
     ZoneId then begin
   Result := TFlexControl(FZones[i]);
   break;
  end;
end;

function TfmMain.FindPass(PassId: integer): TFlexControl;
var i: integer;
begin
 Result := Nil;
 for i:=0 to FDoors.Count-1 do
  if (TFlexDoor(FDoors[i]).PassAProp.Value = PassId) or
     (TFlexDoor(FDoors[i]).PassBProp.Value = PassId) then begin
   Result := TFlexControl(FDoors[i]);
   break;
  end;
end;

procedure TfmMain.tbMainChange(Sender: TObject);
var Scheme: TFlexControl;
begin
 Scheme := Nil;
 case tbMain.TabIndex of
  0: Scheme := fpMain.FindControl('MainPlan');
  1: Scheme := fpMain.FindControl('ControlPost');
  2: Scheme := fpMain.FindControl('AdmGrandFloor');
  3: Scheme := fpMain.FindControl('ProdGrandFloor');
  4: Scheme := fpMain.FindControl('TechGrandFloor');
 end;
 if Assigned(Scheme) and (fpMain.ActiveScheme <> TFlexScheme(Scheme)) then begin
  HideAllPersonCards;
  fpMain.ActiveScheme := TFlexScheme(Scheme);
 end;
end;

procedure TfmMain.SetOptions;
var i: integer;
    Layer: TFlexLayer;
begin
 fpMain.ShowHint := Options.ShowHints;
 case Options.ShowZoneCaptions of
  zsNone:
    begin
     // Make ZoneNames layer invisible
     if Assigned(FZoneNamesLayer) then FZoneNamesLayer.Visible := False;
    end;
  zsSelected:
    begin
     // Hide all ZoneName controls
     for i:=0 to FZoneNames.Count-1 do
      TFlexControl(FZoneNames[i]).Visible := False;
     // Make ZoneNames layer visible
     if Assigned(FZoneNamesLayer) then FZoneNamesLayer.Visible := True;
    end;
  zsAll:
    begin
     // Show all ZoneName controls
     for i:=0 to FZoneNames.Count-1 do
      TFlexControl(FZoneNames[i]).Visible := true;
     // Make ZoneNames layer visible
     if Assigned(FZoneNamesLayer) then FZoneNamesLayer.Visible := True;
    end;
 end;
 Layer := fpMain.Layers.ByName['Lamps'];
 case Options.LampsEffect of
  leNone:
    begin
     if Assigned(Layer) then Layer.Visible := false;
    end;
  leFlashing,
  leRunning:
    begin
     if Assigned(Layer) then Layer.Visible := true;
     tmLamps.Enabled := true;
    end;
 end;

 if not Options.ShowPersonsCards or not Options.Emulation then begin
  HideAllPersonCards;
  DestroyAllFlexCards;
 end else
 if Options.ShowCardsInFlex
  then HideAllPersonCards
  else DestroyAllFlexCards;
 // Emualtion
 dmMain.tmMovements.Enabled := Options.Emulation;
end;