{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                  基本视图对象单元                       ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FView;
Interface
Uses
  FObject,Dos,Graph,FGraph,FWrite,FTool,FMouse,FEvent,FXmsDrv;

Const
  { Option Code }
  opNull       = $0000;
  opFirstPros  = $0080;
  opResize     = $0100;
  opNoTitle    = $0200;
  opSaveBack   = $0400;
  opCantSelect = $0800;
  opCanMove    = $1000;
  opCantClose  = $2000;
  opAligen8    = $4000;
  opShadow     = $8000;

  { GrowMode Code }
  gfGrowLoX    = $01;
  gfGrowLoY    = $02;
  gfGrowHiX    = $04;
  gfGrowHiY    = $08;
  gfGrowAll    = $0F;
  gfGrowRel    = $10;

  { TButton Style }
  btShowHint   = $0001;

  { TScrollBar Style }
  sbHor        = $0000;
  sbVer        = $0001;

  { TGraphComponent Style }
  gcHideMouse  = $8000;
  gcLine       = $0001;
  gcRect       = $0002;
  gcBroad      = $0003;
  gcDLine      = $0004;
  gcDBroad     = $0005;
  gcTBroad     = $0006;

Const
  GroundMinx:Integer=0;
  GroundMiny:Integer=18;
  GroundMaxx:Integer=639;
  GroundMaxy:Integer=455;
  WinMinWidth:Integer=200;
  WinMinHeight:Integer=120;
  ScrollBarColor:Byte=3;
  SureToCloseWin:Boolean=True;

Type
  ArrCharType  = array[0..$FF00] of Char;
  ArrByteType  = array[0..$FF00] of Byte;
  ArrIntType   = array[0..32000] of Integer;
  LongByteType = array[0..3] of Byte;
  String80     = string[80];

  PView=^TView;
  TView=object(TObject)
   Owner:PView;
   Origin,Size,GrowDlt:TPoint;
   Broad:TRect;
   Option:Word;
   GrowMode:Byte;
   IsValid,IsHot,IsShow:Boolean;
   Constructor Init;
   Constructor Load(var S: TStream);
   Procedure Store(var S: TStream);
   Procedure Awaken;virtual;
   Function Valid:Boolean;virtual;
   Procedure CloseSelf;virtual;
   Procedure ClearEvent(var Event:TEvent);virtual;
   Procedure GetEvent(var Event:TEvent);virtual;
   Procedure HandleEvent(var Event:TEvent);virtual;
   Procedure NewView;virtual;
   Procedure Paint;virtual;
   Procedure ShowView;virtual;
   Procedure HideView;virtual;
   Procedure Active;virtual;
   Procedure MoveTo(x,y:Integer);virtual;
   Procedure GetBroad(var R:TRect);virtual;
   Procedure SetBroad(R:TRect);virtual;
   Procedure ChangeBroad(X,Y:Integer);virtual;
   Procedure GetTitle(var S:string);virtual;
   Procedure SetData;virtual;
   Procedure Idle;virtual;
   Procedure Run(var Event:TEvent);virtual;
  end;

  PViewItem=^TViewItem;
  TViewItem=record
   Prev,Next:PViewItem;
   View:PView;
  end;

  PGroup=^TGroup;
  TGroup=object(TView)
   First,Last,This:PViewItem;
   Constructor Init;
   Constructor Load(var S: TStream);
   Destructor Done;virtual;
   Procedure Awaken;virtual;
   Procedure FreeLian;
   Procedure ReplaceView(P,P2:PView);
   Procedure Insert(P:PView);
   Procedure Delete(P:PView);
   Procedure DeleteCurrent;
   Procedure DeleteAll;
   Procedure InsertView(P:PView);
   Procedure NextActive;
   Procedure PrevActive;
   Function  TestView:Boolean;
   Function  ViewCount:Integer;
   Procedure SelectAsNum(Num:Integer);
   Procedure Select(P:PView);
   Procedure SelectView(P:PView);
   Function  GetThis:PView;
   Function  CompView(P:PView):Boolean;
   Procedure Idle;virtual;
   Procedure NewView;virtual;
   Procedure Paint;virtual;
   Procedure PaintAll;
   Procedure PaintZOrder;
   Procedure CloseSelf;virtual;
   Procedure MoveTo(X,Y:Integer);virtual;
   Procedure ChangeBroad(X,Y:Integer);virtual;
   Procedure SetData;virtual;
   Procedure ThisEvent(var Event:TEvent);virtual;
   Procedure HandleEvent(var Event:TEvent);virtual;
   Procedure RunView(P:PView;var Event:TEvent);virtual;
  end;

  PWindow=^TWindow;
  TWindow=object(TView)
   SysRect,TitRect,RsRect,RectDrag:TRect;
   PotMov:TPoint;
   BackImg:Pointer;
   BackImgSize:Word;
   SaveImg:ImageSaveType;
   XmsHandle:Word;
   ImgSaveFlag,SaveInXms,RunFlag:Boolean;
   Caption:string80;
   Group:PGroup;
   Constructor Init(R:TRect;Tit:string;SaveBack:Boolean);
   Destructor Done;virtual;
   Procedure CloseSelf;virtual;
   Procedure CloseCurWin;
   Procedure InitMenu;virtual;
   Procedure HandleEvent(var Event:TEvent);virtual;
   Procedure SaveBackGnd(x1,y1,x2,y2:Integer);
   Procedure ModifyTitle(T:string);
   Procedure Paint;virtual;
   Procedure Hide;virtual;
   Procedure Move;virtual;
   Procedure MoveTo(X,Y:Integer);virtual;
   Procedure ChangeBroad(X,Y:Integer);virtual;
   Procedure ReSize(R:TRect);virtual;
   Procedure ShowRect;
   Procedure MoveTemp(T:TPoint);
   Procedure MoveWin(Mode:Integer;var Event:TEvent);virtual;
   Procedure ResizeTemp(T:TPoint);
   Procedure ResizeWin(Mode:Integer;var Event:TEvent);virtual;
   Procedure SetData;virtual;
   Procedure Idle;virtual;
   Procedure Next;
   Procedure Insert(P:PView);
   Procedure InsertView(P:PView);
   Procedure RunView(P:PView;var Event:TEvent);virtual;
   Function  OpenFile(var FName:PathStr;FTit,FExt:string):Boolean;
   Function  SureWin(P:PView;var Event:TEvent):Boolean;virtual;
   Procedure Run(var Event:TEvent);virtual;
   Procedure Center;virtual;
  end;

  PButton=^TButton;
  TButton=object(TView)
   R,HRec:TRect;
   Style:Word;
   Str:String30;
   TColor:Integer;
   HotKey,ButCom:Word;
   Statu:Boolean;
   Hint:String30;
   HintImg:Pointer;
   HintSize:Word;
   Constructor Init(x1,y1,x2,y2:Integer;S:string;Key,Com:Word);
   Procedure Paint;virtual;
   Procedure Draw;virtual;
   Procedure DrawPush;virtual;
   Procedure MoveTo(x,y:Integer);virtual;
   Procedure Active;virtual;
   Procedure SetHint(S:string);
   Procedure DrawHint;
   Procedure HideHint;
   Procedure HandleHint(var Event:TEvent);virtual;
   Function  Push(Mode:Byte):Boolean;
   Procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PBitBut=^TBitBut;
  TBitBut=object(TButton)
   Img1,Img2,Img3,Img4:Pointer;
   Constructor Init(T:TRect;S:string;Key,Com:Word;Im1,Im2,Im3,Im4:Pointer);
   Procedure Draw;virtual;
   Procedure DrawPush;virtual;
  end;

  PStatuBut=^TStatuBut;
  TStatuBut=object(TBitBut)
   Index:Integer;
   Constructor Init(T:TRect;S:string;Key,Com:Word;Im1,Im2,Im3,Im4:Pointer;Ind:Integer);
   Procedure SetStatu(St:Boolean);
   Procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PScrollBar=^TScrollBar;
  TScrollBar=object(TView)
   Pos,OldPos:Integer;
   Total:Integer;
   Posr:real;
   Wid:Integer;
   Style:Word;
   LRec,RRec,Rec:TRect;
   Constructor Init(S:Word;R:TRect;P:Real);
   Procedure SetBroad(R:TRect);virtual;
   Procedure ChangeBroad(X,Y:Integer);virtual;
   Procedure NewPos(P:Real);
   Procedure MovePos(P:Real);
   Procedure DrawArror(R:TRect;Arrow:Word);
   Procedure Paint;virtual;
   Procedure Draw;virtual;
   Procedure ReDraw;
   Procedure MoveTo(X,Y:Integer);virtual;
   Procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PShape=^TShape;
  TShape=object(TView)
   Mode:Word;
   Par1,Par2,Par3,Par4:Integer;
   Str1:string;
   Constructor Init(M:Word;R:TRect;P1,P2,P3,P4:Integer;S1:string);
   Procedure Paint;virtual;
  end;

  PTimer=^TTimer;
  TTimer=object(TView)
   TimerWork:Boolean;
   TotalTime:LongInt;
   OldH,OldM,OldS,OldSe:Word;
   NowH,NowM,NowS,NowSe:Word;
   Constructor Init(T:LongInt);
   Procedure Reset;
   Procedure SetTime(T:LongInt);
   Procedure StopTimer;
   Function CurTime:LongInt;
   Function EndTime:Boolean;
   Procedure HandleEvent(var Event:TEvent);virtual;
  end;

Function Message(Receiver:PView;Command:Word;InfoPtr:Pointer):Pointer;

procedure RegisterViews;

const
  RView: TStreamRec = (
     ObjType: 1;
     VmtLink: Ofs(TypeOf(TView)^);
     Load:    @TView.Load;
     Store:   @TView.Store
  );

const
  RGroup: TStreamRec = (
     ObjType: 2;
     VmtLink: Ofs(TypeOf(TGroup)^);
     Load:    @TGroup.Load;
     Store:   @TGroup.Store
  );

const
  RWindow: TStreamRec = (
     ObjType: 3;
     VmtLink: Ofs(TypeOf(TWindow)^);
     Load:    @TWindow.Load;
     Store:   @TWindow.Store
  );

const
  RScrollBar: TStreamRec = (
     ObjType: 4;
     VmtLink: Ofs(TypeOf(TScrollBar)^);
     Load:    @TScrollBar.Load;
     Store:   @TScrollBar.Store
  );

const
  RButton: TStreamRec = (
     ObjType: 5;
     VmtLink: Ofs(TypeOf(TButton)^);
     Load:    @TButton.Load;
     Store:   @TButton.Store
  );

const
  RBitBut: TStreamRec = (
     ObjType: 6;
     VmtLink: Ofs(TypeOf(TBitBut)^);
     Load:    @TBitBut.Load;
     Store:   @TBitBut.Store
  );

const
  RStatuBut: TStreamRec = (
     ObjType: 7;
     VmtLink: Ofs(TypeOf(TStatuBut)^);
     Load:    @TStatuBut.Load;
     Store:   @TStatuBut.Store
  );

const
  RShape: TStreamRec = (
     ObjType: 8;
     VmtLink: Ofs(TypeOf(TShape)^);
     Load:    @TShape.Load;
     Store:   @TShape.Store
  );

const
  RTimer: TStreamRec = (
     ObjType: 9;
     VmtLink: Ofs(TypeOf(TTimer)^);
     Load:    @TTimer.Load;
     Store:   @TTimer.Store
  );

Implementation
Uses
  FDialog;
{-----------object TView--------------------}
Constructor TView.Init;
begin
  Inherited Init;
  Owner:=nil;
  Option:=0;
  GrowMode:=0;
  GrowDlt.X:=0;
  GrowDlt.Y:=0;
  IsValid:=True;
  IsHot:=True;
  IsShow:=True;
  AssignRect(Broad,0,0,0,0);
end;

Constructor TView.Load(var S: TStream);
begin
  TObject.Init;
  S.Read(Origin,
    SizeOf(TPoint) * 3 +
    SizeOf(TRect) * 1 +
    SizeOf(Word) * 1 +
    SizeOf(Byte) * 1 +
    SizeOf(Boolean) * 3);
end;

Procedure TView.Store(var S: TStream);
begin
  S.Write(Origin,
    SizeOf(TPoint) * 3 +
    SizeOf(TRect) * 1 +
    SizeOf(Word) * 1 +
    SizeOf(Byte) * 1 +
    SizeOf(Boolean) * 3);
end;

Procedure TView.Awaken;
begin
end;

Function TView.Valid:Boolean;
begin
  Valid:=IsValid;
end;

Procedure TView.CloseSelf;
begin
end;

Procedure TView.ClearEvent;
begin
  Event.What := evNothing;
  Event.InfoPtr := @Self;
end;

Procedure TView.GetEvent;
begin
  if Owner<>nil then
    Owner^.GetEvent(Event)
  else
    FEvent.GetEvent(Event);
end;

Procedure TView.HandleEvent;
begin
end;

Procedure TView.NewView;
begin
end;

Procedure TView.Paint;
begin
end;

Procedure TView.ShowView;
begin
  IsShow:=True;
end;

Procedure TView.HideView;
begin
  IsShow:=False;
end;

Procedure TView.Active;
begin
end;

Procedure TView.MoveTo;
begin
  Origin.x:=X;
  Origin.y:=Y;
  AssignRect(Broad,X,Y,X+Size.X,Y+Size.Y);
end;

Procedure TView.GetBroad;
begin
  R:=Broad;
end;

Procedure TView.SetBroad;
begin
  Origin:=R.a;
  Broad:=R;
  Size.X:=R.b.x-R.a.x;
  Size.Y:=R.b.y-R.a.y;
end;

Procedure TView.ChangeBroad;
begin
  if (GrowMode and gfGrowLoX)<>0 then
  begin
    Dec(Size.X,X);
    MoveTo(Origin.X+X,Origin.Y);
  end;
  if (GrowMode and gfGrowLoY)<>0 then
  begin
    Dec(Size.Y,Y);
    MoveTo(Origin.X,Origin.Y+Y);
  end;
  if (GrowMode and gfGrowHiX)<>0 then
  begin
    Inc(Size.X,X);
    MoveTo(Origin.X,Origin.Y);
  end;
  if (GrowMode and gfGrowHiY)<>0 then
  begin
    Inc(Size.Y,Y);
    MoveTo(Origin.X,Origin.Y);
  end;
end;

Procedure TView.GetTitle;
begin
  S:='';
end;

Procedure TView.SetData;
begin
end;

Procedure TView.Idle;
begin
end;

Procedure TView.Run;
begin
end;
{------------end object TView---------------}

{-----------object TGroup-------------------}
Constructor TGroup.Init;
begin
  Inherited Init;
  First:=nil;
  Last:=nil;
  This:=nil;
end;

Constructor TGroup.Load(var S: TStream);
var
  Count, I: Integer;
  V: PView;
begin
  TView.Load(S);
  S.Read(Count, SizeOf(Word));
  for i := 1 to Count do
  begin
    V := PView(S.Get);
    if V <> nil then Insert(V);
  end;
  if Owner = nil then Awaken;
end;

Destructor TGroup.Done;
begin
  FreeLian;
  Inherited Done;
end;

Procedure TGroup.Awaken;
var
  Temp:PViewItem;
begin
  Temp:=First;
  while (Temp<>nil)and(Temp^.View<>nil) do
  begin
    Temp^.View^.Awaken;
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroup.FreeLian;
begin
  This:=First;
  if This=nil then Exit;
  while This^.Next<>nil do
  begin
    This:=This^.Next;
    Dispose(This^.Prev^.View,Done);
    Dispose(This^.Prev);
  end;
  Dispose(This^.View,Done);
  Dispose(This);
  First:=nil;
  Last:=nil;
end;

Procedure TGroup.ReplaceView;
var
  Temp:PViewItem;
begin
  if (This=nil)or(First=nil) then Exit;
  Temp:=First;
  while (Temp^.View<>P)and(Temp^.Next<>nil) do
  Temp:=Temp^.Next;
  if Temp^.View<>P then Exit;
  Temp^.View:=P2;
end;

Procedure TGroup.Insert;
var
  Temp:PViewItem;
  st,st1:PathStr;
begin
  if (P=nil) then Exit;
  if not P^.Valid then
  begin
    Dispose(P,Done);
    Exit;
  end;
  P^.Owner:=@Self;
  if This=nil then
  begin
    New(This);
    This^.View:=P;
    This^.Prev:=nil;
    This^.Next:=nil;
    First:=This;
    Last:=This;
  end else
  begin
    Temp:=First;
    P^.GetTitle(St);
    while Temp<>nil do
    begin
      Temp^.View^.GetTitle(st1);
      if (st<>'')and(st=st1) then
      begin
        This:=temp;
        Exit;
      end;
      Temp:=Temp^.Next;
    end;
    Temp:=This;
    New(This);
    This^.View:=P;
    This^.Prev:=Temp;
    This^.Next:=Temp^.Next;
    if This^.Next<>nil then
      This^.Next^.Prev:=This;
    Temp^.Next:=This;
  end;
  while Last^.Next<>nil do Last:=Last^.Next;
  if This^.View<>nil then
    This^.View^.Owner:=@Self;
end;

Procedure TGroup.InsertView;
begin
  Insert(P);
  NewView;
  Paint;
end;

Procedure TGroup.Delete;
var
  Temp:PViewItem;
begin
  if (This=nil)or(First=nil) then Exit;
  Temp:=First;
  while (Temp^.View<>P)and(Temp^.Next<>nil) do
  Temp:=Temp^.Next;
  if Temp^.View<>P then Exit;
  Dispose(Temp^.View,Done);
  if Temp^.Prev<>nil then
    Temp^.Prev^.Next:=Temp^.Next;
  if Temp^.Next<>nil then
    Temp^.Next^.Prev:=Temp^.Prev;
  if First=Temp then First:=Temp^.Next;
  if Last=Temp then Last:=Temp^.Prev;
  if Temp^.Prev<>nil then
    This:=Temp^.Prev
  else
    This:=Temp^.Next;
  Dispose(Temp);
end;

Procedure TGroup.DeleteCurrent;
begin
  if (This=nil)or((This^.View^.Option and opFirstPros)<>0) then Exit;
  Delete(This^.View);
end;

Procedure TGroup.DeleteAll;
var
  Temp,Temp1:PViewItem;
begin
  Temp:=First;
  SureToCloseWin:=True;
  while SureToCloseWin and (Temp<>nil) do
  begin
    Temp1:=Temp^.Next;
    if ((Temp^.View^.Option and opFirstPros)=0) then
      Delete(Temp^.View);
    Temp:=Temp1;
  end;
end;

Function TGroup.ViewCount:Integer;
var
  Temp:PViewItem;
  Count:Integer;
begin
  Temp:=First;
  Count:=0;
  while Temp<>nil do
  begin
    if (Temp^.View^.Option and opFirstPros)=0 then
      Inc(Count);
    Temp:=Temp^.Next;
  end;
  ViewCount:=Count;
end;

Procedure TGroup.SelectAsNum(Num:Integer);
var
  Temp:PViewItem;
  Count:Integer;
begin
  Temp:=First;
  Count:=0;
  while (Temp<>nil) and (Count<Num) do
  begin
    if (Temp^.View^.Option and opFirstPros)=0 then
      Inc(Count);
    if Count=Num then This:=Temp;
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroup.Select;
var
  Temp:PViewItem;
begin
  if P=nil then Exit;
  Temp:=First;
  while (Temp<>nil)and(Temp^.View<>P) do
  Temp:=Temp^.Next;
  if Temp<>nil then This:=Temp;
end;

Procedure TGroup.SelectView;
var
  Temp:PViewItem;
begin
  if (P=nil) or ((This<>nil)and(P=This^.View)) then Exit;
  Temp:=First;
  while (Temp<>nil)and(Temp^.View<>P) do
  Temp:=Temp^.Next;
  if Temp<>nil then
  begin
    This:=Temp;
    Paint;
  end;
end;

Procedure TGroup.NextActive;
label Start;
begin
  if ViewCount<2 then Exit;
 Start:
  if This^.Next<>nil then
    This:=This^.Next
  else
    This:=First;
  if (This^.View^.Option and opFirstPros)<>0 then
    goto Start;
end;

Procedure TGroup.PrevActive;
label Start;
begin
  if ViewCount<2 then Exit;
 Start:
  if This^.Prev<>nil then
    This:=This^.Prev
  else
    This:=Last;
  if (This^.View^.Option and opFirstPros)<>0 then
    goto Start;
end;

Procedure TGroup.Idle;
begin
  if This<>nil then
    This^.View^.Idle;
end;

Procedure TGroup.NewView;
begin
  if This<>nil then
    This^.View^.NewView;
end;

Procedure TGroup.Paint;
begin
  if (This<>nil) and This^.View^.IsShow then
    This^.View^.Paint;
end;

Procedure TGroup.PaintAll;
var
  Temp:PViewItem;
begin
  Temp:=First;
  while Temp<>nil do
  begin
    if Temp^.View^.IsShow then
      Temp^.View^.Paint;
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroup.PaintZOrder;
var
  Temp:PViewItem;
begin
  if This=nil then Exit;
  Temp:=This^.Next;
  if Temp=nil then Temp:=First;
  while Temp<>This do
  begin
    if Temp^.View^.IsShow then
      Temp^.View^.Paint;
    Temp:=Temp^.Next;
    if Temp=nil then Temp:=First;
  end;
  if This^.View^.IsShow then
    This^.View^.Paint;
end;

Procedure TGroup.CloseSelf;
var
  Temp:PViewItem;
begin
  Temp:=First;
  while Temp<>nil do
  begin
    if not SureToCloseWin then Exit;
    Temp^.View^.CloseSelf;
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroup.MoveTo;
var
  Temp:PViewItem;
begin
  Temp:=First;
  while Temp<>nil do
  begin
    Temp^.View^.MoveTo(Temp^.View^.Origin.x+x,Temp^.View^.Origin.y+y);
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroup.ChangeBroad;
var
  Temp:PViewItem;
begin
  Temp:=First;
  while Temp<>nil do
  begin
    Temp^.View^.ChangeBroad(X,Y);
    Temp:=Temp^.Next;
  end;
end;

Function TGroup.TestView;
begin
  TestView:=ViewCount>0;
end;

Function  TGroup.GetThis;
begin
  if This=nil then
    GetThis:=nil
  else
    GetThis:=This^.View;
end;

Function  TGroup.CompView;
begin
  CompView:=False;
  if P=This^.View then
    CompView:=True;
end;

Procedure TGroup.SetData;
var
  Temp:PViewItem;
begin
  Temp:=First;
  while Temp<>nil do
  begin
    Temp^.View^.SetData;
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroup.RunView;
begin
  if (P=nil) then Exit;
  if not P^.Valid then
  begin
    Dispose(P,Done);
    Exit;
  end;
  InsertView(P);
  P^.Run(Event);
  DeleteCurrent;
end;

Procedure TGroup.ThisEvent;
var
  Temp:PViewItem;
begin
  if This=nil then Exit;
  Temp:=First;
  while Temp<>nil do
  begin
    if (Temp^.View^.Option and opFirstPros)<>0 then
      Temp^.View^.HandleEvent(Event);
    Temp:=Temp^.Next;
  end;
  if (This^.View^.Option and opFirstPros)=0 then
    This^.View^.HandleEvent(Event);
  if (Event.What<>evMouseDown)or(Event.InfoPtr=This^.View) then Exit;
  Temp:=This^.Next;
  if Temp=nil then Temp:=First;
  while Temp<>This do
  begin
    if (Temp^.View^.Option and opFirstPros)=0 then
    if IsIn(Event.Where,Temp^.View^.Broad) then
    begin
      Temp^.View^.HandleEvent(Event);
      Exit;
    end;
    Temp:=Temp^.Next;
    if Temp=nil then Temp:=First;
  end;
end;

Procedure TGroup.HandleEvent;
var
  Temp:PViewItem;
begin
  if This=nil then Exit;
  Temp:=First;
  while Temp<>nil do
  begin
    if (Temp^.View^.Option and opFirstPros)<>0 then
      Temp^.View^.HandleEvent(Event);
    Temp:=Temp^.Next;
  end;
  if (This^.View^.Option and opFirstPros)=0 then
    This^.View^.HandleEvent(Event);
  Temp:=This^.Next;
  if Temp=nil then Temp:=First;
  while Temp<>This do
  begin
    if (Temp^.View^.Option and opFirstPros)=0 then
    Temp^.View^.HandleEvent(Event);
    Temp:=Temp^.Next;
    if Temp=nil then Temp:=First;
  end;
end;
{------------end object TGroup--------------}

{------------object TWindow--------------------}
Constructor TWindow.Init;
begin
  Inherited Init;
  Option:=Option or opCanMove or opShadow;
  Size.X:=R.B.X-R.A.X;
  Size.Y:=R.B.Y-R.A.Y;
  Origin:=R.A;
  if SaveBack then Option:=Option or opSaveBack;
  Caption:=Tit;
  ImgSaveFlag:=False;
  BackImg:=nil;
  RunFlag:=False;
  Group:=New(PGroup,Init);
  Group^.Owner:=@Self;
  MoveTo(R.A.X,R.A.Y);
  InitMenu;
end;

Destructor TWindow.Done;
begin
  Dispose(Group,Done);
  Hide;
  Inherited Done;
end;

Procedure TWindow.CloseSelf;
begin
  Group^.CloseSelf;
end;

Procedure TWindow.CloseCurWin;
begin
  if Group^.GetThis=nil then Exit;
  SureToCloseWin:=True;
  Group^.GetThis^.CloseSelf;
  if not SureToCloseWin then Exit;
  Group^.DeleteCurrent;
end;

Procedure TWindow.InitMenu;
begin
end;

Procedure TWindow.SaveBackGnd;
begin
  ImgSaveFlag:=False;
  if x2>GroundMaxx then x2:=GroundMaxx;
  if y2>GroundMaxy then y2:=GroundMaxy;
  if XmsCanUse and (GetXmsSize>200) then
  begin
    XmsHandle:=SaveImageXms(x1,y1,x2,y2,SaveImg);
    if XmsHandle<>0 then ImgSaveFlag:=True;
    SaveInXms:=True;
  end else
  begin
    BackImg:=SaveImage(x1,y1,x2,y2,BackImgSize);
    if BackImg<>nil then ImgSaveFlag:=True;
    SaveInXms:=False;
  end;
end;

Procedure TWindow.Paint;
var
  TempLen:Integer;
begin
  HideMouse;
  if ((Option and opSaveBack)<>0)and(not ImgSaveFlag) then
  begin
    if (Option and opShadow)<>0 then
      SaveBackGnd(Broad.a.x,Broad.a.y,Broad.b.x+15,Broad.b.y+15)
    else
      SaveBackGnd(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
    if not ImgSaveFlag then Dec(Option,opSaveBack);
  end;
  DrawBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,1);
  if (Option and opShadow)<>0 then
    DrawShadow(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,15);
  if (Option and opNoTitle)=0 then
  begin
    if IsHot then
      SignBroadc(Broad.a.x+4,Broad.a.y+4,Broad.b.x-4,Broad.a.y+23,0,1)
    else
      SignBroadc(Broad.a.x+4,Broad.a.y+4,Broad.b.x-4,Broad.a.y+23,0,7);
    TempLen:=Length(Caption);
    if TempLen>(Size.x div 8)-4 then
      TempLen:=(Size.x div 8)-4;
    WritecMap((Broad.a.x+Broad.b.x) div 2-TempLen*4,Broad.a.y+6,Copy(Caption,1,TempLen),8,15);
    Full(Broad.a.x+5,Broad.a.y+5,Broad.a.x+21,Broad.a.y+22,7);
    Full(Broad.a.x+7,Broad.a.y+12,Broad.a.x+19,Broad.a.y+14,15);
    SetColor(0);
    Rectangle(Broad.a.x+7,Broad.a.y+12,Broad.a.x+19,Broad.a.y+14);
  end;
  if (Option and opResize)<>0 then
  begin
    SetColor(15);
    Line(Broad.B.X-6,Broad.B.Y-6,Broad.B.X-12,Broad.B.Y-6);
    Line(Broad.B.X-6,Broad.B.Y-6,Broad.B.X-6,Broad.B.Y-12);
    Line(Broad.B.X-16,Broad.B.Y-6,Broad.B.X-6,Broad.B.Y-16);
    Line(Broad.B.X-20,Broad.B.Y-6,Broad.B.X-16,Broad.B.Y-6);
    Line(Broad.B.X-6,Broad.B.Y-20,Broad.B.X-6,Broad.B.Y-16);
    SetColor(8);
    Line(Broad.B.X-12,Broad.B.Y-6,Broad.B.X-6,Broad.B.Y-12);
    Line(Broad.B.X-20,Broad.B.Y-6,Broad.B.X-6,Broad.B.Y-20);
  end;
  Group^.PaintAll;
  ShowMouse;
end;

Procedure TWindow.ModifyTitle;
var
  TempLen:Integer;
begin
  Caption:=T;
  TempLen:=Length(Caption);
  if TempLen>(Size.x div 8)-4 then
    TempLen:=(Size.x div 8)-4;
  HideMouse;
  Full(Broad.a.x+22,Broad.a.y+5,Broad.b.x-5,Broad.a.y+22,1);
  WritecMap((Broad.a.x+Broad.b.x) div 2-TempLen*4,Broad.a.y+6,Copy(Caption,1,TempLen),8,15);
  ShowMouse;
end;

Procedure TWindow.Hide;
begin
  if ((Option and opSaveBack)<>0) and ImgSaveFlag then
  begin
    HideMouse;
    if SaveInXms then
    begin
      PutImageXms(Broad.a.x,Broad.a.y,XmsHandle,SaveImg);
      FreeXms(XmsHandle);
    end else
    begin
      PutImage(Broad.a.x,Broad.a.y,BackImg^,CopyPut);
      FreeMem(BackImg,BackImgSize);
    end;
    ShowMouse;
    BackImg:=nil;
    ImgSaveFlag:=False;
  end;
end;

Procedure TWindow.ShowRect;
begin
  SetLineStyle(0,0,1);
  SetColor(11);
  SetWriteMode(1);
  HideMouse;
  PutPixel(0,0,0);
  Rectangle(RectDrag.a.x,RectDrag.a.y,RectDrag.b.x,RectDrag.b.y);
  ShowMouse;
  SetWriteMode(0);
end;

Procedure TWindow.MoveTemp;
var
  Dlt:TPoint;
begin
  Dlt.x:=t.x-PotMov.x;
  Dlt.y:=t.y-PotMov.y;
  ShowRect;
  Inc(RectDrag.a.x,Dlt.x);
  Inc(RectDrag.a.y,Dlt.y);
  if RectDrag.a.x<GroundMinx then RectDrag.a.x:=GroundMinx;
  if RectDrag.a.y<GroundMiny then RectDrag.a.y:=GroundMiny;
  RectDrag.b.x:=RectDrag.a.x+Size.x;
  RectDrag.b.y:=RectDrag.a.y+Size.y;
  if RectDrag.b.x>GroundMaxx then RectDrag.b.x:=GroundMaxx;
  if RectDrag.b.y>GroundMaxy then RectDrag.b.y:=GroundMaxy;
  RectDrag.a.x:=RectDrag.b.x-Size.x;
  RectDrag.a.y:=RectDrag.b.y-Size.y;
  ShowRect;
  PotMov:=t;
end;

Procedure TWindow.Move;
var
  Temp:TPoint;
begin
  Temp:=Origin;
  if (RectDrag.a.x=Broad.a.x)and(RectDrag.a.y=Broad.a.y) then Exit;
  if (Option and opAligen8)<>0 then
    RectDrag.A.X:=RectDrag.A.X div 8 * 8;
  Hide;
  MoveTo(RectDrag.a.x,RectDrag.a.y);
  Paint;
end;

Procedure TWindow.MoveTo;
begin
  Group^.MoveTo(X-Origin.X,Y-Origin.Y);
  Inherited MoveTo(X,Y);
  if (Option and opAligen8)<>0 then
  begin
    Origin.X:=Origin.X div 8 *8;
    Broad.a.x:=Origin.X;
    Broad.b.x:=Broad.a.x+Size.x;
  end;
  AssignRect(SysRect,Broad.a.x+5,Broad.a.y+5,Broad.a.x+21,Broad.a.y+21);
  AssignRect(TitRect,Broad.a.x+22,Broad.a.y+5,Broad.b.x-5,Broad.a.y+21);
  AssignRect(RsRect,Broad.b.x-20,Broad.b.y-20,Broad.b.x,Broad.b.y);
end;

Procedure TWindow.ChangeBroad;
begin
  Inherited ChangeBroad(X,Y);
  Group^.ChangeBroad(X,Y);
end;

Procedure TWindow.ReSize;
var
  Temp:TPoint;
begin
  if (Longint(R.A)=Longint(Broad.A)) and
     (Longint(R.B)=Longint(Broad.B)) then Exit;
  Hide;
  Temp.X:=R.B.X-R.A.X;
  Temp.Y:=R.B.Y-R.A.Y;
  if GrowDlt.X<>0 then
  begin
    if ((Temp.X-Size.X) mod GrowDlt.X)<>0 then
      Inc(Temp.X,GrowDlt.X-((Temp.X-Size.X) mod GrowDlt.X));
    if R.A.X+Temp.X>GroundMaxx then Dec(Temp.X,GrowDlt.X);
  end;
  if GrowDlt.Y<>0 then
  begin
    if ((Temp.Y-Size.Y) mod GrowDlt.Y)<>0 then
      Inc(Temp.Y,GrowDlt.Y-((Temp.Y-Size.Y) mod GrowDlt.Y));
    if R.A.Y+Temp.Y>GroundMaxy then Dec(Temp.Y,GrowDlt.Y);
  end;
  ChangeBroad(Temp.X-Size.X,Temp.Y-Size.Y);
  Size.X:=Temp.X;
  Size.Y:=Temp.Y;
  MoveTo(R.A.X,R.A.Y);
  Paint;
end;

Procedure TWindow.MoveWin;
var
  Temp:TPoint;
  QuitMove:Boolean;
begin
  QuitMove:=False;
  RectDrag:=Broad;
  if Mode=0 then
    PotMov:=Event.Where
  else
    PotMov:=Broad.a;
  Temp:=PotMov;
  ShowRect;
  if Mode=0 then
    SetCursor(CRRARR);
  repeat
    ClearEvent(Event);
    GetEvent(Event);
    if (Mode=0) and (Event.What=evMouseMove) then
      MoveTemp(Event.Where)
    else if (Mode<>0)and(Event.What=evKeyDown) then
    begin
      case Event.KeyCode of
      kbLeft :begin Dec(Temp.x,2);MoveTemp(Temp);end;
      kbRight:begin Inc(Temp.x,2);MoveTemp(Temp);end;
      kbUp   :begin Dec(Temp.y,2);MoveTemp(Temp);end;
      kbDown :begin Inc(Temp.y,2);MoveTemp(Temp);end;
      kbEsc:QuitMove:=True;
      end;
    end;
  until ((Mode=0)and(Event.What=evMouseUp)) or QuitMove or
        ((Mode<>0)and(Event.What=evKeyDown)and(Event.KeyCode=kbEnter));
  SetCursor(Arrow);
  ShowRect;
  if QuitMove then Exit;
  Move;
end;

Procedure TWindow.ResizeTemp;
var
  Dlt:TPoint;
begin
  Dlt.X:=T.X-PotMov.x;
  Dlt.Y:=T.Y-PotMov.y;
  ShowRect;
  Inc(RectDrag.b.x,Dlt.x);
  Inc(RectDrag.b.y,Dlt.y);
  if RectDrag.b.x-RectDrag.a.x<WinMinWidth then
    RectDrag.b.x:=RectDrag.a.x+WinMinWidth;
  if RectDrag.b.y-RectDrag.a.y<WinMinHeight then
    RectDrag.b.y:=RectDrag.a.y+WinMinHeight;
  if RectDrag.b.x>GroundMaxx then RectDrag.b.x:=GroundMaxx;
  if RectDrag.b.y>GroundMaxy then RectDrag.b.y:=GroundMaxy;
  ShowRect;
  PotMov:=t;
end;

Procedure TWindow.ResizeWin;
var
  Temp:TPoint;
  QuitMove:Boolean;
begin
  QuitMove:=False;
  RectDrag:=Broad;
  if Mode=0 then
    PotMov:=Event.Where
  else
    PotMov:=Broad.b;
  Temp:=PotMov;
  ShowRect;
  if Mode=0 then
    SetCursor(CRRARR);
  repeat
    ClearEvent(Event);
    GetEvent(Event);
    if (Mode=0) and (Event.What=evMouseMove) then
      ResizeTemp(Event.Where)
    else if (Mode<>0)and(Event.What=evKeyDown) then
    begin
      case Event.KeyCode of
      kbLeft :begin Dec(Temp.x,2);ResizeTemp(Temp);end;
      kbRight:begin Inc(Temp.x,2);ResizeTemp(Temp);end;
      kbUp   :begin Dec(Temp.y,2);ResizeTemp(Temp);end;
      kbDown :begin Inc(Temp.y,2);ResizeTemp(Temp);end;
      kbEsc:QuitMove:=True;
      end;
    end;
  until ((Mode=0)and(Event.What=evMouseUp)) or QuitMove or
        ((Mode<>0)and(Event.What=evKeyDown)and(Event.KeyCode=kbEnter));
  SetCursor(Arrow);
  ShowRect;
  if QuitMove then Exit;
  ReSize(RectDrag);
end;

Procedure TWindow.SetData;
begin
  Inherited SetData;
  Group^.SetData;
end;

Procedure TWindow.Idle;
begin
  Inherited Idle;
  Group^.Idle;
end;

Procedure TWindow.HandleEvent;
var
  R:TRect;
begin
  Group^.HandleEvent(Event);
  case Event.What of
  evCommand:case Event.Command of
            cmMove:if (Option and opCanMove)<>0 then MoveWin(1,Event);
            cmResize:if (Option and opResize)<>0 then ResizeWin(1,Event);
            cmZoom:if (Option and opResize)<>0 then
                   begin
                     AssignRect(R,GroundMinX,GroundMinY,GroundMaxX,GroundMaxY);
                     ReSize(R);
                   end;
            else Exit;
            end;
  evMouseDown:if (Event.Buttons=mbLeftButton) and IsIn(Event.Where,Broad) then
              begin
                if IsIn(Event.Where,TitRect) and ((Option and opCanMove)<>0) then
                  MoveWin(0,Event)
                else if IsIn(Event.Where,SysRect) and ((Option and opCantClose)=0) then
                  ClearEvent(Event)
                else if IsIn(Event.Where,RsRect) and ((Option and opResize)<>0) then
                  ResizeWin(0,Event)
                else if not RunFlag then
                begin
                  Event.InfoPtr:=@Self;
                  Exit;
                end else Exit;
              end else Exit;
  evMouseUp: if (Event.Buttons=mbLeftButton) and IsIn(Event.Where,SysRect)
                and ((Option and opCantClose)=0) then
             begin
               Event.What:=evCommand;
               Event.Command:=cmCloseWin;
               Event.InfoPtr:=@Self;
               Exit;
             end else Exit;
  evKeyDown:case Event.keycode of
            kbCtrlF5:if (Option and opCanMove)<>0 then
                       MoveWin(1,Event)
                     else Exit;
            kbCtrlF4:if (Option and opResize)<>0 then
                       ResizeWin(1,Event)
                     else Exit;
            kbAltF3:if (Option and opCantClose)=0 then
                     begin
                       Event.What:=evCommand;
                       Event.Command:=cmCloseWin;
                       Exit;
                     end else Exit;
            kbTab:if not RunFlag then
                  begin
                    Group^.NextActive;
                    while (Group^.GetThis^.Option and opCantSelect)<>0 do
                    Group^.NextActive;
                  end else Exit;
            kbShiftTab:if not RunFlag then
                  begin
                    Group^.PrevActive;
                    while (Group^.GetThis^.Option and opCantSelect)<>0 do
                    Group^.PrevActive;
                  end else Exit;
            else Exit;
            end;
  else Exit;
  end;
  ClearEvent(Event);
end;

Procedure TWindow.Next;
begin
  Group^.NextActive;
end;

Procedure TWindow.Insert;
begin
  Group^.Insert(P);
end;

Procedure TWindow.InsertView;
begin
  Group^.InsertView(P);
end;

Procedure TWindow.RunView;
begin
  Group^.RunView(P,Event);
end;

Function TWindow.OpenFile;
var
  Event:TEvent;
begin
  OpenFile:=False;
  InsertView(PView(New(PFileDialog,Init(FExt,FTit))));
  Group^.GetThis^.Run(Event);
  if (Event.What=evCommand)and(Event.Command=cmOk) then
  begin
    FName:=PathStr(Event.InfoPtr^);
    OpenFile:=True;
  end;
  Group^.DeleteCurrent;
end;

Function TWindow.SureWin;
begin
  RunView(P,Event);
  SureWin:=(Event.Command=cmOk);
end;

Procedure TWindow.Run;
label CircleEvent;
begin
  RunFlag:=True;
  if (Group^.GetThis<>nil) then
    Group^.GetThis^.Active;
CircleEvent:
  repeat
   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
   begin
     Group^.GetThis^.Active;
     Group^.Select(Event.InfoPtr);
     Group^.GetThis^.Active;
   end;
   case Event.What of
   evKeyDown:case Event.KeyCode of
             kbEsc:begin
                     Event.What:=evCommand;
                     Event.Command:=cmCancel;
                   end;
             kbTab:if Group^.GetThis<>nil then
                   begin
                     Group^.GetThis^.Active;
                     Group^.NextActive;
                     while (Group^.GetThis^.Option and opCantSelect)<>0 do
                     Group^.NextActive;
                     Group^.GetThis^.Active;
                   end;
             kbShiftTab:if Group^.GetThis<>nil then
                      begin
                        Group^.GetThis^.Active;
                        Group^.PrevActive;
                        while (Group^.GetThis^.Option and opCantSelect)<>0 do
                        Group^.PrevActive;
                        Group^.GetThis^.Active;
                      end;
             end;
   evCommand:case Event.Command of
             cmCloseWin:Event.Command:=cmCancel;
             end;
   end;
  until (Event.What=evCommand) and
   (Event.Command in [cmOk,cmCancel,cmYes,cmNo,cmRetry,cmAbort,cmIgnore]);
  SureToCloseWin:=True;
  CloseSelf;
  if not SureToCloseWin then goto CircleEvent;
  if Event.Command in [cmOk,cmYes] then SetData;
  RunFlag:=False;
end;

Procedure TWindow.Center;
var
  Temp:TPoint;
begin
  Temp.X:=(GetMaxx-Size.X) div 2;
  Temp.Y:=(GetMaxy-Size.Y) div 2;
  if (Option and opAligen8)<>0 then
    Temp.X:=Temp.X div 8 * 8;
  MoveTo(Temp.X,Temp.Y);
end;

{------------end object TWindow----------------}

{-------------object button-----------------}
Constructor TButton.Init;
begin
  Inherited Init;
  Size.x:=X2-X1;
  Size.y:=Y2-Y1;
  MoveTo(X1,Y1);
  Style:=0;
  Str:=S;
  Hint:='';
  TColor:=0;
  HotKey:=Key;
  ButCom:=Com;
  IsHot:=False;
  Statu:=False;
end;

Procedure TButton.Paint;
begin
  if Statu then
    DrawPush
  else
    Draw;
end;

Procedure TButton.Draw;
begin
  HideMouse;
  DrawBroad(r.a.x+1,r.a.y+1,r.b.x-1,r.b.y-1,1);
  SetColor(0);
  Rectangle(r.a.x,r.a.y,r.b.x,r.b.y);
  if Size.y<20 then
  begin
    SetColor(TColor);
    OutTextxy(r.a.x+ Size.x div 2 -getclen(str)*4+1,r.a.y+Size.y div 2-3,str);
  end else
    WritecStr(r.a.x+ Size.x div 2 -getclen(str)*4+1,r.a.y+Size.y div 2-8+1,str,tcolor,4);
  SetColor(7);
  Rectangle(r.a.x-1,r.a.y-1,r.b.x+1,r.b.y+1);
  if IsHot then
  begin
    SetLineStyle(0,0,1);
    SetColor(4);
    Rectangle(r.a.x,r.a.y,r.b.x,r.b.y);
    Rectangle(r.a.x-1,r.a.y-1,r.b.x+1,r.b.y+1);
  end;
  ShowMouse;
end;

Procedure TButton.DrawPush;
begin
  HideMouse;
  DrawBroad(r.a.x+1,r.a.y+1,r.b.x-1,r.b.y-1,0);
  SetColor(0);
  Rectangle(r.a.x,r.a.y,r.b.x,r.b.y);
  if Size.y<20 then
  begin
    SetColor(TColor);
    OutTextxy(r.a.x+ Size.x div 2 -GetcLen(Str)*4+2,r.a.y+Size.y div 2-2,Str);
  end else
    WritecStr(r.a.x+ Size.x div 2 -GetcLen(Str)*4+2,r.a.y+Size.y div 2-8+2,Str,TColor,4);
  ShowMouse;
end;

Procedure TButton.MoveTo;
begin
 Origin.X:=X;
 Origin.Y:=Y;
 AssignRect(R,X,Y,X+Size.X,Y+Size.Y);
end;

Procedure TButton.Active;
begin
  IsHot:=not IsHot;
  Paint;
end;

Procedure TButton.SetHint;
begin
  Hint:=S;
  if Hint<>'' then
    Style:=Style or btShowHint;
end;

Procedure TButton.DrawHint;
begin
  HideMouse;
  AssignRect(HRec,R.a.x+2,R.b.y+1,R.a.x+Length(Hint)*8+5,R.b.y+18);
  if HRec.b.x>GetMaxx then
  begin
    Dec(HRec.a.x,HRec.b.x-GetMaxx);
    Dec(HRec.b.x,HRec.b.x-GetMaxx);
  end;
  HintImg:=SaveImage(HRec.a.x,HRec.a.y,HRec.b.x,HRec.b.y,HintSize);
  Full(HRec.a.x,HRec.a.y,HRec.b.x,HRec.b.y,0);
  Full(HRec.a.x+1,HRec.a.y+1,HRec.b.x-1,HRec.b.y-1,$E);
  Writecs(HRec.a.x+2,HRec.a.y+1,Hint,0);
  ShowMouse;
end;

Procedure TButton.HideHint;
begin
  HideMouse;
  PutImage(HRec.a.x,HRec.a.y,HintImg^,CopyPut);
  FreeMem(HintImg,HintSize);
  ShowMouse;
end;

Procedure TButton.HandleHint;
label Start;
var
  Timer:PTimer;
begin
  if (Event.What=evMouseMove) and IsIn(Event.Where,R) and
     ((Style and btShowHint)<>0) then
  begin
    ClearEvent(Event);
    Timer:=New(PTimer,Init(50));
    Timer^.Owner:=@Self;
  Start:
    repeat
      GetEvent(Event);
      Timer^.HandleEvent(Event);
    until (Event.What<>evNothing);
    if (Event.What=evCommand)and
       (Event.Command=cmTimer)and
       (Event.InfoPtr=Timer) then
    begin
      DrawHint;
      repeat
        ClearEvent(Event);
        GetEvent(Event);
      until (Event.What<>evNothing) and
        (not ((Event.What=evMouseMove) and IsIn(Event.Where,R)));
      HideHint;
    end else
    if (Event.What=evMouseMove) and IsIn(Event.Where,R) then
    begin
      ClearEvent(Event);
      goto Start;
    end;
    Dispose(Timer,Done);
    Event.InfoPtr:=nil;
  end;
end;

Function TButton.Push;
label Circle;
var
  Flag:Boolean;
begin
  Push:=true;
  DrawPush;
  Flag:=True;
Circle:
  repeat
    ClearEvent(Event);
    GetEvent(Event);
    if Event.What=evMouseMove then
    if (not Flag) and IsIn(Event.Where,R) then
    begin
      DrawPush;
      Flag:=True;
    end else
    if Flag and (not IsIn(Event.Where,R)) then
    begin
      Draw;
      Flag:=False;
    end;
  until (Mode<>0)or(Event.What=evMouseUp);
  if Flag then Draw;
  if not IsIn(Event.Where,R) then Push:=False;
end;

Procedure TButton.HandleEvent;
begin
  HandleHint(Event);
  case Event.What of
  evMouseDown:if IsIn(Event.Where,R) and (Event.Buttons=mbLeftButton) then
              if Push(0) then
              begin
                Event.What:=evCommand;
                Event.Command:=ButCom;
                Event.InfoPtr:=@Self;
              end;
  evKeyDown  :if Event.KeyCode=HotKey then
              begin
                Push(1);
                Event.What:=evCommand;
                Event.Command:=ButCom;
                Event.InfoPtr:=@Self;
              end else
              if Event.KeyCode=kbEnter then
              begin
                Push(1);
                Event.What:=evCommand;
                Event.Command:=ButCom;
                Event.InfoPtr:=@Self;
              end;
  end;
end;
{-----------------end object button---------------}

Constructor TBitBut.Init;
begin
  Inherited Init(T.a.x,T.a.y,T.b.x,T.b.y,S,Key,Com);
  Img1:=Im1;
  Img2:=Im2;
  Img3:=Im3;
  Img4:=Im4;
end;

Procedure TBitBut.Draw;
begin
  HideMouse;
  DrawBroad(R.a.x,R.a.y,R.b.x,R.b.y,1);
  if Img2<>nil then PutImage(R.a.x+2,R.a.y+2,Img2^,ANDPut);
  if Img1<>nil then PutImage(R.a.x+2,R.a.y+2,Img1^,ORPut);
  WritecStr(R.a.x+Size.x div 2-GetcLen(Str)*4+1,R.a.y+Size.y div 2-8+1,Str,TColor,4);
  ShowMouse;
end;

Procedure TBitBut.DrawPush;
begin
  HideMouse;
  DrawBroad(R.a.x,R.a.y,R.b.x,R.b.y,2);
  if Img4<>nil then PutImage(R.a.x+2,R.a.y+2,Img4^,ANDPut);
  if Img3<>nil then PutImage(R.a.x+2,R.a.y+2,Img3^,ORPut);
  WritecStr(R.a.x+Size.x div 2-GetcLen(Str)*4+2,R.a.y+Size.y div 2-8+2,Str,TColor,4);
  ShowMouse;
end;


Constructor TStatuBut.Init;
begin
  Inherited Init(T,S,Key,Com,Im1,Im2,Im3,Im4);
  Index:=Ind;
end;

Procedure TStatuBut.SetStatu;
begin
  if Statu=St then Exit;
  Statu:=St;
  Paint;
end;

Procedure TStatuBut.HandleEvent;
begin
  HandleHint(Event);
  case Event.What of
  evMouseDown:if (not Statu) and IsIn(Event.Where,R) and
                 (Event.Buttons=mbLeftButton) then
              begin
                SetStatu(True);
                Message(Owner^.Owner,cmChangeStatu,@Self);
                Event.What:=evCommand;
                Event.Command:=ButCom;
                Event.InfoInt:=Index;
              end;
  evKeyDown  :if (not Statu) and (Event.KeyCode=HotKey) then
              begin
                SetStatu(True);
                Message(Owner^.Owner,cmChangeStatu,@Self);
                Event.What:=evCommand;
                Event.Command:=ButCom;
                Event.InfoInt:=Index;
              end;
  end;
end;

{----------------object TScrollBar---------------}
Constructor TScrollBar.Init;
begin
  Inherited Init;
  Option:=opCantSelect;
  Style:=S;
  if Style=sbHor then
    GrowMode:=gfGrowHiX+gfGrowLoY+gfGrowHiY
  else
    GrowMode:=gfGrowHiY+gfGrowLoX+gfGrowHiX;
  Posr:=P;
  if Posr>1 then Posr:=1;
  if Posr<0 then Posr:=0;
  SetBroad(R);
end;

Procedure TScrollBar.SetBroad;
begin
  Origin:=R.a;
  Size:=R.b;
  if Style=0 then Wid:=Size.y else Wid:=Size.x;
  MoveTo(R.a.x,R.a.y);
  if Style=0 then
    Total:=Abs(Rec.b.x-Rec.a.x)-Wid
  else
    Total:=Abs(Rec.b.y-Rec.a.y)-Wid;
  Pos:=Round(Posr*Total);
  OldPos:=Pos;
end;

Procedure TScrollBar.ChangeBroad;
begin
  Inherited ChangeBroad(X,Y);
  Broad.A:=Origin;
  Broad.B:=Size;
  SetBroad(Broad);
end;

Procedure TScrollBar.MoveTo;
begin
  Origin.X:=X;
  Origin.Y:=Y;
  if Style=0 then
  begin
    AssignRect(Rec,X+Wid+2,Y+1,X+Size.X-Wid-1,Y+Wid);
    AssignRect(LRec,X+1,Y+1,X+Wid,Y+Wid);
    AssignRect(RRec,X+Size.X-Wid+1,Y+1,X+Size.X,Y+Wid);
  end else
  begin
    AssignRect(Rec,X+1,Y+Wid+2,X+Wid,Y+Size.Y-Wid-1);
    AssignRect(LRec,X+1,Y+1,X+Wid,Y+Wid);
    AssignRect(RRec,X+1,Y+Size.Y-Wid+1,X+Wid,Y+Size.Y);
  end;
end;

Procedure TScrollBar.Paint;
begin
  Draw;
  ReDraw;
end;

Procedure TScrollBar.NewPos;
begin
  if p>1 then p:=1;
  if p<0 then p:=0;
  Posr:=p;
  Pos:=round(p*Total);
  if Pos<>OldPos then ReDraw;
  OldPos:=Pos;
end;

Procedure TScrollBar.MovePos;
begin
  NewPos(Posr+p);
end;

Procedure TScrollBar.DrawArror;
const
  MaxPts = 7;
type
  PolygonType = array[1..MaxPts] of PointType;
var
  Poly : PolygonType;
  Widh,Widg,g:Integer;
begin
  Dec(R.a.x);Dec(R.a.y);
  Inc(R.b.x);Inc(R.b.y);
  SetFillStyle(1,0);
  SetColor(0);
  Widh:=Wid div 2+1;
  Widg:=Wid div 10+1;
  if Wid<12 then Dec(Widg);
  g:=4;if Wid<12 then g:=3;
  case Arrow of
  0: begin poly[1].x:=r.a.x+Widh;poly[1].y:=r.a.y+g;
           poly[2].x:=r.a.x+g;poly[2].y:=r.a.y+Widh;
           poly[3].x:=r.a.x+Widh-Widg;poly[3].y:=r.a.y+Widh;
           poly[4].x:=r.a.x+Widh-Widg;poly[4].y:=r.b.y-g;
           poly[5].x:=r.b.x-Widh+Widg;poly[5].y:=r.b.y-g;
           poly[6].x:=r.b.x-Widh+Widg;poly[6].y:=r.a.y+Widh;
           poly[7].x:=r.b.x-g;poly[7].y:=r.a.y+Widh;
      end;
  1: begin poly[1].x:=r.a.x+Widh;poly[1].y:=r.b.y-g;
           poly[2].x:=r.a.x+g;poly[2].y:=r.b.y-Widh;
           poly[3].x:=r.a.x+Widh-Widg;poly[3].y:=r.b.y-Widh;
           poly[4].x:=r.a.x+Widh-Widg;poly[4].y:=r.a.y+g;
           poly[5].x:=r.b.x-Widh+Widg;poly[5].y:=r.a.y+g;
           poly[6].x:=r.b.x-Widh+Widg;poly[6].y:=r.b.y-Widh;
           poly[7].x:=r.b.x-g;poly[7].y:=r.b.y-Widh;
      end;
  2: begin poly[1].x:=r.a.x+g;poly[1].y:=r.a.y+Widh;
           poly[2].x:=r.a.x+Widh;poly[2].y:=r.a.y+g;
           poly[3].x:=r.a.x+Widh;poly[3].y:=r.a.y+Widh-Widg;
           poly[4].x:=r.b.x-g;poly[4].y:=r.a.y+Widh-Widg;
           poly[5].x:=r.b.x-g;poly[5].y:=r.b.y-Widh+Widg;
           poly[6].x:=r.a.x+Widh;poly[6].y:=r.b.y-Widh+Widg;
           poly[7].x:=r.a.x+Widh;poly[7].y:=r.b.y-g;
      end;
  3: begin poly[1].x:=r.b.x-g;poly[1].y:=r.a.y+Widh;
           poly[2].x:=r.b.x-Widh;poly[2].y:=r.a.y+g;
           poly[3].x:=r.b.x-Widh;poly[3].y:=r.a.y+Widh-Widg;
           poly[4].x:=r.a.x+g;poly[4].y:=r.a.y+Widh-Widg;
           poly[5].x:=r.a.x+g;poly[5].y:=r.b.y-Widh+Widg;
           poly[6].x:=r.b.x-Widh;poly[6].y:=r.b.y-Widh+Widg;
           poly[7].x:=r.b.x-Widh;poly[7].y:=r.b.y-g;
      end;
  end;
  FillPoly(MaxPts, Poly);
end;

Procedure TScrollBar.Draw;
begin
  HideMouse;
  DrawBroad(lrec.a.x,lrec.a.y,lrec.b.x,lrec.b.y,1);
  DrawBroad(rrec.a.x,rrec.a.y,rrec.b.x,rrec.b.y,1);
  if Style=0 then
  begin
    DrawArror(lrec,2);
    DrawArror(rrec,3);
  end else
  begin
    DrawArror(lrec,0);
    DrawArror(rrec,1);
  end;
  SetColor(0);
  Rectangle(Origin.x,Origin.y,Origin.x+Size.x+1,Origin.y+Size.y+1);
  Rectangle(LRec.a.x-1,LRec.a.y-1,LRec.b.x+1,LRec.b.y+1);
  Rectangle(RRec.a.x-1,RRec.a.y-1,RRec.b.x+1,RRec.b.y+1);
  Full(Rec.a.x,Rec.a.y,Rec.b.x,Rec.b.y,ScrollBarColor);
  ShowMouse;
end;

Procedure TScrollBar.ReDraw;
begin
  HideMouse;
  Full(Rec.a.x,Rec.a.y,Rec.b.x,Rec.b.y,ScrollBarColor);
  if Style=0 then
    DrawBroad(Rec.a.x+Pos,Rec.a.y,Rec.a.x+Pos+Wid,Rec.b.y,1)
  else
    DrawBroad(Rec.a.x,Rec.a.y+Pos,Rec.b.x,Rec.a.y+Pos+Wid,1);
  ShowMouse;
end;

Procedure TScrollBar.HandleEvent;
var
  Temp:TPoint;
begin
  Inherited HandleEvent(Event);
  case Event.What of
  evMouseDown,evMouseAuto :
    if (Event.Buttons=mbLeftButton) then
    begin
      if IsIn(Event.Where,LRec) then
      begin
        Event.What:=evCommand;
        if Style=sbHor then
          Event.Command:=cmLeft
        else
          Event.Command:=cmUp;
        Event.InfoPtr:=@Self;
      end else
      if IsIn(Event.Where,RRec) then
      begin
        Event.What:=evCommand;
        if Style=sbHor then
          Event.Command:=cmRight
        else
          Event.Command:=cmDown;
        Event.InfoPtr:=@Self;
      end else
      if IsIn(Event.Where,Rec) then
      begin
        Temp:=Event.Where;
        Event.What:=evCommand;
        if Style=sbHor then
          Event.Command:=cmInterHor
        else
          Event.Command:=cmInterVer;
        if Style=sbHor then
          Event.InfoReal:=(Temp.x-Rec.a.x)/(Total+Wid)
        else
          Event.InfoReal:=(Temp.y-Rec.a.y)/(Total+Wid);
        Event.Index:=@Self;
      end;
    end;
  evKeyDown:case Event.KeyCode of
            kbLeft   :if Style=sbHor then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmLeft;
                      end;
            kbRight  :if Style=sbHor then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmRight;
                      end;
            kbUp     :if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmUp;
                      end;
            kbDown   :if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmDown;
                      end;
            kbHome   :if Style=sbHor then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmHome;
                      end;
            kbEnd    :if Style=sbHor then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmEnd;
                      end;
            kbPgUp   :if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmPgUp;
                      end;
            kbPgDn   :if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmPgDn;
                      end;
            kbCtrlHome:if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmCtrlHome;
                      end;
            kbCtrlEnd :if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmCtrlEnd;
                      end;
            kbCtrlPgUp:if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmCtrlPgUp;
                      end;
            kbCtrlPgDn:if Style=sbVer then
                      begin
                        Event.What:=evCommand;
                        Event.InfoPtr:=@Self;
                        Event.Command:=cmCtrlPgDn;
                      end;
            end;
  else Exit;
  end;
end;
{------------------end object TScrollBar------------}

{-----------Object TShape------------------}

Constructor TShape.Init;
begin
  Inherited Init;
  Option:=opCantSelect;
  GrowMode:=gfGrowHiX+gfGrowHiY;
  Mode:=M;
  SetBroad(R);
  Par1:=P1;
  Par2:=P2;
  Par3:=P3;
  Par4:=P4;
  Str1:=S1;
end;

Procedure TShape.Paint;
begin
  if (Mode and gcHideMouse)<>0 then HideMouse;
  case (Mode and $7FFF) of
  gcLine:begin
           SetLineStyle(Par2,0,1);
           SetColor(Par3);
           Line(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
         end;
  gcRect:if Par1=0 then
         begin
           SetLineStyle(Par2,0,1);
           SetColor(Par3);
           Rectangle(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
         end else
         begin
           SetFillStyle(Par2,Par3);
           Bar(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
         end;
  gcBroad:if Par1=0 then
            SignBroadc(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,Par2,Par3)
          else
            DrawBroadc(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,Par2,Par3);
  gcDLine:DoubleLine(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
  gcDBroad:DoubleBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
  gcTBroad:TitBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,Str1,Par1);
  end;
  ShowMouse;
end;

{-----------Object TTimer-----------------------------}
Constructor TTimer.Init;
begin
  Inherited Init;
  Option:=opCantSelect;
  TotalTime:=T;
  GetTime(OldH,OldM,OldS,OldSe);
  TimerWork:=(T<>0);
end;

Procedure TTimer.Reset;
begin
  TimerWork:=True;
  GetTime(OldH,OldM,OldS,OldSe);
end;

Procedure TTimer.SetTime;
begin
  TotalTime:=T;
  Reset;
end;

Procedure TTimer.StopTimer;
begin
  TimerWork:=False;
end;

Function TTimer.CurTime:LongInt;
var
  Temp:LongInt;
begin
  GetTime(NowH,NowM,NowS,NowSe);
  Temp:=Longint(NowSe-OldSe)+
        Longint(NowS-OldS)*100+
        Longint(NowM-OldM)*6000;
  while Temp<0 do Inc(Temp,6000);
  CurTime:=Temp;
end;

Function TTimer.EndTime:Boolean;
begin
  EndTime:=TimerWork and (CurTime>=TotalTime);
end;

Procedure TTimer.HandleEvent;
begin
  if (Event.What=evNothing) and EndTime then
  begin
    Event.What:=evCommand;
    Event.Command:=cmTimer;
    Event.InfoPtr:=@Self;
  end;
end;

Function Message(Receiver:PView;Command:Word;InfoPtr:Pointer):Pointer;
var
  Event:TEvent;
begin
  if Receiver=nil then
  begin
    Message:=nil;
    Exit;
  end;
  Event.What:=evCommand;
  Event.Command:=Command;
  Event.InfoPtr:=InfoPtr;
  Receiver^.HandleEvent(Event);
  if Event.What<>evNothing then
    Message:=nil
  else
    Message:=Event.InfoPtr;
end;

Procedure RegisterViews;
begin
  RegisterType(RView);
  RegisterType(RGroup);
  RegisterType(RWindow);
  RegisterType(RScrollBar);
  RegisterType(RButton);
  RegisterType(RBitBut);
  RegisterType(RStatuBut);
  RegisterType(RShape);
  RegisterType(RTimer);
end;

end.