fcontrol.pas

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

unit fControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, StdCtrls, ComCtrls, FlexBase, ExtCtrls, Buttons;

type
  TfmControl = class(TForm)
    pgTables: TPageControl;
    tsPersonnel: TTabSheet;
    lbPersonnel: TListBox;
    tsPasses: TTabSheet;
    tsZones: TTabSheet;
    imgIcons: TImageList;
    lbPasses: TListBox;
    lbZones: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lbLocation: TLabel;
    lbTimeEnter: TLabel;
    lbTimeLeave: TLabel;
    Panel2: TPanel;
    Label4: TLabel;
    Label5: TLabel;
    lbPassName: TLabel;
    lbPassZoneFrom: TLabel;
    bbPassOpen: TBitBtn;
    bbPassClose: TBitBtn;
    Label6: TLabel;
    lbPassZoneTo: TLabel;
    Panel3: TPanel;
    Label7: TLabel;
    lbZoneCount: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    lbZoneTotal: TLabel;
    tsEvents: TTabSheet;
    lbEvents: TListBox;
    bbPassBlock: TBitBtn;
    bbPassUnblock: TBitBtn;
    Panel4: TPanel;
    chEventsAutoScroll: TCheckBox;
    Panel5: TPanel;
    Splitter1: TSplitter;
    Panel6: TPanel;
    Label8: TLabel;
    Panel7: TPanel;
    lbPersInZone: TListBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lbDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lbDblClick(Sender: TObject);
    procedure lbPersonnelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lbPassesMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lbZonesMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure bbPassOpenClick(Sender: TObject);
    procedure bbPassCloseClick(Sender: TObject);
    procedure bbPassBlockClick(Sender: TObject);
    procedure bbPassUnblockClick(Sender: TObject);
    procedure pgTablesChange(Sender: TObject);
  private
    { Private declarations }
    FLastPersonIndex: integer;
    FLastPassIndex: integer;
    FLastZoneIndex: integer;
  public
    { Public declarations }
    procedure RefreshPersonInfo;
    procedure RefreshPassInfo;
    procedure RefreshZoneInfo;
    procedure RefreshEvents;
    procedure RefreshInfo;
  end;

var
  fmControl: TfmControl;

procedure ShowLists;

implementation

uses dMain, fMain, ACCtrls;

{$R *.DFM}

procedure ShowLists;
begin
 if not Assigned(fmControl) then fmControl := TfmControl.Create(Application);
 fmControl.Show;
end;

procedure TfmControl.FormCreate(Sender: TObject);
var i: integer;
begin
 // Filling lbPersonnel
 for i:=0 to dmMain.Personnel.Count-1 do
  lbPersonnel.Items.AddObject('', dmMain.Personnel[i]);
 // Filling lbPasses
 for i:=0 to dmMain.Passes.Count-1 do
  lbPasses.Items.AddObject('', dmMain.Passes[i]);
 // Filling lbZones
 for i:=0 to dmMain.Zones.Count-1 do
  lbZones.Items.AddObject('', dmMain.Zones[i]);
 RefreshPersonInfo;
 RefreshPassInfo;
 RefreshZoneInfo;
 RefreshEvents;
end;

procedure TfmControl.FormDestroy(Sender: TObject);
begin
 fmControl := Nil;
end;

procedure TfmControl.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

procedure TfmControl.lbDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var Info, s: string;
    ImgIndex, LineId: integer;
    Time: TDateTime;
    Ind: integer;
begin
 with TListBox(Control).Canvas, Rect do begin
  // Clear line
  FillRect(Rect);
  // Define data
  Time := 0;
  LineId := 0;
  if Control = lbPersonnel then with PPerson(dmMain.Personnel[Index])^ do begin
   // Extract person data
   ImgIndex := 4;
   LineId := Id;
   Info := FirstName + ' ' + LastName;
  end else
  if Control = lbPasses then with PPass(dmMain.Passes[Index])^ do begin
   // Extract pass data
   if Id and 1 = 0
    then ImgIndex := 6
    else ImgIndex := 5;
   LineId := Id;
   Info := Name;
  end else
  if Control = lbZones then with PZone(dmMain.Zones[Index])^ do begin
   // Extract zone data
   ImgIndex := 7;
   LineId := Id;
   Info := Name;
  end else
  if Control = lbEvents then begin
   // Extract event data
   ImgIndex := 8;
   Time := PEvent(dmMain.Events[Index])^.Time;
   Info := PEvent(dmMain.Events[Index])^.Info;
  end else
  if Control = lbPersInZone then
   with PPerson(lbPersInZone.Items.Objects[Index])^ do begin
    // Extract person data
    ImgIndex := 4;
    LineId := Id;
    Info := FirstName + ' ' + LastName;
   end
  else
   exit;
  // Paint line
  imgIcons.Draw(TListBox(Control).Canvas, Left+2, Top+1, ImgIndex);
  if Time = 0 then begin
   s := IntToStr(LineId);
   Ind := 50;
  end else begin
   s := TimeToStr(Time);
   Ind := 70;
  end;
  Font.Style := Font.Style + [fsBold];
  TextOut(Left+Ind - TextWidth(s), Top+1, s);
  Font.Style := Font.Style - [fsBold];
  TextOut(Left+Ind+4, Top+1, Info);
 end;
end;

procedure TfmControl.lbDblClick(Sender: TObject);
var Event: PEvent;
begin
 if Sender = lbPersonnel then begin
  // Find person location
  fmMain.Selected :=
    fmMain.FindZone(
      PPerson(lbPersonnel.Items.Objects[lbPersonnel.ItemIndex]).ZoneId);
  pgTables.ActivePage := tsPersonnel;
 end else
 if Sender = lbZones then begin
  // Find zone
  fmMain.Selected :=
    fmMain.FindZone(PZone(lbZones.Items.Objects[lbZones.ItemIndex]).Id);
 end else
 if Sender = lbPasses then begin
  // Find pass
  fmMain.Selected :=
    fmMain.FindPass(PPass(lbPasses.Items.Objects[lbPasses.ItemIndex]).Id);
 end else
 if (Sender = lbEvents) and (lbEvents.ItemIndex >= 0) then begin
  // Find event object
  Event := PEvent(dmMain.Events[lbEvents.ItemIndex]);
  if Event.PassId > 0 then
   fmMain.Selected := fmMain.FindPass(Event.PassId)
  else
  if Event.ZoneId > 0 then
   fmMain.Selected := fmMain.FindPass(Event.ZoneId);
  pgTables.ActivePage := tsEvents;
 end;
end;

procedure TfmControl.lbPersonnelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
 if lbPersonnel.ItemIndex = FLastPersonIndex then exit;
 RefreshPersonInfo;
end;

procedure TfmControl.lbPassesMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
 if lbPasses.ItemIndex = FLastPassIndex then exit;
 RefreshPassInfo;
end;

procedure TfmControl.lbZonesMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if lbZones.ItemIndex <> FLastZoneIndex then begin
  FLastZoneIndex := lbZones.ItemIndex;
  RefreshZoneInfo;
 end;
end;

procedure TfmControl.RefreshPassInfo;
var Index, Idx: integer;
    Pass: PPass;
begin
 Index := lbPasses.ItemIndex;
 if Index < 0 then begin
  lbPassName.Caption := '';
  lbPassZoneFrom.Caption := '';
  lbPassZoneTo.Caption := '';
  bbPassOpen.Enabled := false;
  bbPassClose.Enabled := false;
  bbPassBlock.Enabled := false;
  bbPassUnBlock.Enabled := false;
 end else begin
  Pass := PPass(lbPasses.Items.Objects[Index]);
  lbPassName.Caption := Pass.Name;
  Idx := dmMain.FindZone(Pass.ZoneFromId);
  if Idx >= 0
   then lbPassZoneFrom.Caption := PZone(dmMain.Zones[Idx]).Name
   else lbPassZoneFrom.Caption := '';
  Idx := dmMain.FindZone(Pass.ZoneToId);
  if Idx >= 0
   then lbPassZoneTo.Caption := PZone(dmMain.Zones[Idx]).Name
   else lbPassZoneTo.Caption := '';
  bbPassOpen.Enabled := true;
  bbPassClose.Enabled := true;
  bbPassBlock.Enabled := true;
  bbPassUnBlock.Enabled := true;
 end;
 FLastPassIndex := Index;
end;

procedure TfmControl.RefreshPersonInfo;
var Index: integer;
    Person: PPerson;
begin
 Index := lbPersonnel.ItemIndex;
 if Index < 0 then begin
  lbLocation.Caption := '';
  lbTimeEnter.Caption := '';
  lbTimeLeave.Caption := '';
 end else begin
  Person := PPerson(lbPersonnel.Items.Objects[Index]);
  if Person.ZoneId > 0
   then lbLocation.Caption := dmMain.ZonesById[Person.ZoneID].Name
   else lbLocation.Caption := '[outside]';
  if Person.TimeEnter > 0
   then lbTimeEnter.Caption := DateTimeToStr(Person.TimeEnter)
   else lbTimeEnter.Caption := '';
  if Person.TimeLeave > 0
   then lbTimeLeave.Caption := DateTimeToStr(Person.TimeLeave)
   else lbTimeLeave.Caption := '';
 end;
 FLastPersonIndex := Index;
end;

procedure TfmControl.RefreshZoneInfo;
var i, Index: integer;
    Total: integer;
    Zone, SubZone, CheckZone: PZone;
    StrList: TStringList;
begin
 Index := lbZones.ItemIndex;
 if Index < 0 then begin
  lbZoneCount.Caption := '';
  lbZoneTotal.Caption := '';
  lbPersInZone.Items.Clear;
 end else begin
  Zone := PZone(lbZones.Items.Objects[Index]);
  lbZoneCount.Caption := IntToStr(Zone.PersonCount);
  Total := 0; //Zone.PersonCount;
  for i:=0 to dmMain.Zones.Count-1 do begin
   CheckZone := PZone(dmMain.Zones[i]);
   //if CheckZone = Zone then continue;
   SubZone := CheckZone;
   while Assigned(SubZone) do
    if SubZone = Zone then begin
     // The CheckZone is child for Zone
     inc(Total, CheckZone.PersonCount);
     break;
    end else
     // Move to parent
     SubZone := dmMain.ZonesById[SubZone.ParentId];
  end;
  lbZoneTotal.Caption := IntToStr(Total);
  // Fill PersInZone
  StrList := TStringList.Create;
  try
   for i:=0 to dmMain.Personnel.Count-1 do with PPerson(dmMain.Personnel[i])^ do
    if ZoneId = Zone.Id then StrList.AddObject('', dmMain.Personnel[i]);
   lbPersInZone.Items.Assign(StrList);
  finally
   StrList.Free;
  end;
 end;
end;

procedure TfmControl.RefreshEvents;
var i: integer;
begin
 if lbEvents.Items.Count < dmMain.Events.Count then begin
  for i:=lbEvents.Items.Count to dmMain.Events.Count-1 do
   lbEvents.Items.Add('');
 end else
 while lbEvents.Items.Count > dmMain.Events.Count do
  lbEvents.Items.Delete(lbEvents.Items.Count-1);
 if chEventsAutoScroll.Checked then
  lbEvents.ItemIndex := lbEvents.Items.Count-1; 
end;

procedure TfmControl.bbPassOpenClick(Sender: TObject);
var Index: integer;
    Pass: PPass;
begin
 Index := lbPasses.ItemIndex;
 if Index < 0 then exit;
 Pass := PPass(lbPasses.Items.Objects[Index]);
 fmMain.DoPass(Pass.Id, 0, true);
end;

procedure TfmControl.bbPassCloseClick(Sender: TObject);
var Index: integer;
    Pass: PPass;
begin
 Index := lbPasses.ItemIndex;
 if Index < 0 then exit;
 Pass := PPass(lbPasses.Items.Objects[Index]);
 fmMain.DoPass(Pass.Id, 0, false);
end;

procedure TfmControl.bbPassBlockClick(Sender: TObject);
var Index: integer;
    Pass: PPass;
begin
 Index := lbPasses.ItemIndex;
 if Index < 0 then exit;
 Pass := PPass(lbPasses.Items.Objects[Index]);
 fmMain.DoBlock(Pass.Id, true);
end;

procedure TfmControl.bbPassUnblockClick(Sender: TObject);
var Index: integer;
    Pass: PPass;
begin
 Index := lbPasses.ItemIndex;
 if Index < 0 then exit;
 Pass := PPass(lbPasses.Items.Objects[Index]);
 fmMain.DoBlock(Pass.Id, false);
end;

procedure TfmControl.RefreshInfo;
begin
 if pgTables.ActivePage = tsPersonnel then RefreshPersonInfo else
 if pgTables.ActivePage = tsPasses    then RefreshPassInfo else
 if pgTables.ActivePage = tsZones     then RefreshZoneInfo else
 if pgTables.ActivePage = tsEvents    then RefreshEvents;
end;

procedure TfmControl.pgTablesChange(Sender: TObject);
begin
 RefreshInfo;
end;

end.