{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                   应用程序类单元                        ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FApp;
Interface

Uses
  Dos,Graph,FGraph,FView,FMouse,FEvent,
  FMenu,FDialog,Memory,FXmsdrv;

type
  PApplication=^TApplication;
  TApplication=object(TWindow)
   constructor Init(GDrv,GMod:Integer);
   destructor  Done;virtual;
   procedure DosShell;virtual;
   procedure PaintBack;virtual;
   procedure Paint;virtual;
   procedure ErrorEvent(var Event:TEvent);virtual;
   procedure GetEvent(var Event:TEvent);virtual;
   procedure HandleEvent(var Event:TEvent);virtual;
   procedure Run(var Event:TEvent);virtual;
  end;

Implementation
constructor TApplication.Init;
var
  R:TRect;
begin
  InitMemory;
  XmsCanUse:=TestXms;
  GraphDrivers;
  Graph_Initialize(GDrv,GMod);
  GroundMinx:=0;
  GroundMiny:=18;
  GroundMaxx:=GetMaxx;
  GroundMaxy:=GetMaxy-24;
  InitializeMouse;
  InitEvent;
  AssignRect(R,0,0,GetMaxx,GetMaxy);
  Inherited Init(R,'',False);
  Option:=Option + opCantClose - opCanMove - opShadow;
  AssignRect(R,0,GetMaxy-22,GetMaxx,GetMaxy);
  StatusLine:=New(PStatusLine,Init(R,slBroad+slSaveBack+slSetActive,''));
  Insert(StatusLine);
end;

destructor TApplication.Done;
begin
  DoneEvent;
  ResetMouse;
  DoneMemory;
  Inherited Done;
  CloseGraph;
  if not IsValid then
   Writeln('Found some error,perhaps XMS not enough.');
end;

procedure TApplication.DosShell;
begin
  DoneEvent;
  ResetMouse;
  RestoreCrtMode;
  DoneDosMem;
  Writeln('Type EXIT to return...');
  SwapVectors;
  Exec(GetEnv('COMSPEC'), '');
  SwapVectors;
  InitDosMem;
  SetGraphMode(GetGraphMode);
  Initializemouse;
  InitEvent;
  Paint;
end;

procedure TApplication.PaintBack;
begin
end;

procedure TApplication.Paint;
begin
  if not IsValid then Exit;
  PaintBack;
  Group^.PaintZOrder;
end;

procedure TApplication.ErrorEvent;
begin
  case Event.What of
  evCommand:case Event.Command of
            cmClose,cmCloseWin :
                          begin
                            CloseCurWin;
                            if not SureToCloseWin then Exit;
                            Paint;
                          end;
            cmOutofMemory:begin
                            RunView(New(PMsgDialog,Init(
                            '安全区告警','内存不够,必需关闭当前窗口!'
                            ,mbOkOnly)),Event);
                            Group^.DeleteCurrent;
                            if not SureToCloseWin then Exit;
                            Paint;
                          end;
            else Exit;
            end;
  else Exit;
  end;
end;

procedure TApplication.GetEvent;
begin
  FEvent.GetEvent(Event);
  if (Event.What=evKeyDown)and(Event.KeyCode=kbAltX) then
  begin
    Event.What:=evCommand;
    Event.Command:=cmQuit;
  end else
  if Event.What=evNothing then
    Idle;
end;

procedure TApplication.HandleEvent;
begin
  Group^.ThisEvent(Event);
  case Event.What of
  evCommand :begin
               case Event.Command of
               cmPrevWin :begin Group^.PrevActive;Group^.Paint; end;
               cmNextWin :begin Group^.NextActive;Group^.Paint; end;
               else Exit;
               end;
             end;
  else Exit;
  end;
  ClearEvent(Event);
end;

procedure TApplication.Run;
label CircleEvent;
begin
  if not IsValid then Exit;
 CircleEvent:
  ClearEvent(Event);
  repeat
    if Event.What<>evNothing then
      ErrorEvent(Event);
    ClearEvent(Event);
    GetEvent(Event);
    HandleEvent(Event);
    if (Event.InfoPtr<>nil)and(Group^.GetThis<>nil) then
    if (Event.InfoPtr<>@Self) and (Event.InfoPtr<>Group^.GetThis) and
      ((PView(Event.InfoPtr)^.Option and opCantSelect)=0) then
      Group^.SelectView(Event.InfoPtr);
  until (Event.What=evCommand)and(Event.Command=cmQuit);
  SureToCloseWin:=True;
  CloseSelf;
  if not SureToCloseWin then goto CircleEvent;
end;

end.