{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                      菜单单元                           ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FMenu;
Interface
Uses
  Graph,FGraph,FEvent,FMouse,FView,FWrite;

Const
  slBroad      = $0001;
  slSaveBack   = $0002;
  slSetActive  = $0004;

Const
  MenuMoveActive:Boolean=False;
  StatusLineActive:Boolean=False;

Type
  MenuStr=string[30];
  PMenu=^TMenu;
  Subm=record
    Ms:MenuStr;
    Mk:Word;
    Mc:Word;
    Mr:TRect;
    Sub:PMenu;
  end;
  SubMenu=array[0..15] of Subm;

  PMenuItem=^TMenuItem;
  TMenuItem=record
    Ms:MenuStr;
    Mk:Word;
    Mc:Word;
    Sub:PMenu;
    Next:PMenuItem;
  end;

  TMenu=object(TView)
   OwnerIndex:Integer;
   Pot:TPoint;
   Len,Num,Pos:Integer;
   Mm:SubMenu;
   FRect:TRect;
   Img:Pointer;
   ImgSize:Word;
   MenuActive:Boolean;
   Constructor Init(AMenu:PMenuItem);
   Destructor Done;virtual;
   Procedure Insert(S:MenuStr;K,C:Word;Sub:PMenu);virtual;
   Procedure MoveTo(X,Y:Integer);virtual;
   Procedure Paint;virtual;
   Procedure DrawMark;
   Procedure UnActive;virtual;
   Procedure ChangeMark(N,Dlt:Integer);
   Procedure HotKeyEvent(var Event:TEvent);
   Procedure RunSubMenu(var Event:TEvent);
   Procedure HandleEvent(var Event:TEvent);virtual;
   Procedure Run(var Event:TEvent);virtual;
  end;

  PMainMenu=^TMainMenu;
  TMainMenu=object(TMenu)
   SysRect:TRect;
   SysFlag:Boolean;
   NowX:Integer;
   Constructor Init(R:TRect;Sf:Boolean;AMenu:PMenuItem);
   Procedure Insert(S:MenuStr;K,C:Word;Sub:PMenu);virtual;
   Procedure SetBroad(R:TRect);virtual;
   Procedure MoveTo(X,Y:Integer);virtual;
   Procedure Paint;virtual;
   Procedure LeftMenu(var Event:TEvent);
   Procedure RightMenu(var Event:TEvent);
   Procedure HandleMainMenu(var Event:TEvent);virtual;
   Procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PStatusLine=^TStatusLine;
  TStatusLine=object(TView)
   Style:Word;
   BakImg:Pointer;
   BakSize:Word;
   Str:string;
   Constructor Init(R:TRect;Sty:Word;S:string);
   Destructor Done;virtual;
   Procedure Paint;virtual;
   Procedure Hide;virtual;
   Procedure Show;virtual;
   Procedure Modify(S:string);
   Procedure SwapLine(var S:string);
  end;

var
  StatusLine:PStatusLine;

Function NewMenuItem(S:MenuStr;K,C:Word;Sub:PMenu;Next:PMenuItem):PMenuItem;
Function NewSubMenu(S:MenuStr;K:Word;Sub:PMenu;Next:PMenuItem):PMenuItem;
Implementation
Function NewMenuItem(S:MenuStr;K,C:Word;Sub:PMenu;Next:PMenuItem):PMenuItem;
var
  P:PMenuItem;
begin
  New(P);
  P^.Ms:=S;
  P^.Mk:=K;
  P^.Mc:=C;
  P^.Sub:=Sub;
  P^.Next:=Next;
  NewMenuItem:=P;
end;

Function NewSubMenu(S:MenuStr;K:Word;Sub:PMenu;Next:PMenuItem):PMenuItem;
var
  P:PMenuItem;
begin
  New(P);
  P^.Ms:=S;
  P^.Mk:=K;
  P^.Mc:=0;
  P^.Sub:=Sub;
  P^.Next:=Next;
  NewSubMenu:=P;
end;

Constructor TMenu.Init;
var
  Temp:PMenuItem;
begin
  Inherited Init;
  AssignRect(FRect,0,0,0,0);
  Len:=70;
  Num:=0;
  MoveTo(0,0);
  MenuActive:=False;
  Pos:=0;
  while AMenu<>nil do
  begin
    Insert(AMenu^.Ms,AMenu^.Mk,AMenu^.Mc,AMenu^.Sub);
    Temp:=AMenu;
    AMenu:=AMenu^.Next;
    Dispose(Temp);
  end;
end;

Destructor TMenu.Done;
var
  i:Integer;
begin
  for i:=0 to Num-1 do
  if Mm[i].Sub<>nil then
    Dispose(Mm[i].Sub,Done);
  Inherited Done;
end;

Procedure TMenu.Insert;
begin
  if Len<GetcLen(S)*8+20 then
    Len:=GetcLen(S)*8+20;
  Mm[Num].Ms:=S;
  Mm[Num].Mk:=K;
  Mm[Num].Mc:=C;
  Mm[Num].Sub:=Sub;
  if Sub<>nil then
  begin
    Sub^.Owner:=@Self;
    Sub^.OwnerIndex:=Num;
  end;
  Inc(Num);
  Broad.b.x:=Broad.a.x+Len;
  Broad.b.y:=Broad.a.y+Num*18+12;
end;

Procedure TMenu.MoveTo(X,Y:Integer);
begin
  if X+Len>GetMaxx then
    X:=GetMaxx-Len;
  if Y+Num*18+12>GetMaxy then
    Y:=GetMaxy-Num*18-12;
  Origin.x:=X;
  Origin.y:=Y;
  AssignRect(Broad,X,Y,X+Len,Y+Num*18+12);
  Pot.x:=X+10;
  Pot.y:=Y+6;
end;

Procedure TMenu.Paint;
var
  i:Integer;
begin
  if Num<=0 then Exit;
  if Owner<>nil then
  begin
    if TypeOf(Owner^)=TypeOf(TMenu) then
      MoveTo(PMenu(Owner)^.Broad.b.x+1,PMenu(Owner)^.Mm[OwnerIndex].Mr.a.y-6)
    else if TypeOf(Owner^)=TypeOf(TMainMenu) then
      MoveTo(PMainMenu(Owner)^.Mm[OwnerIndex].Mr.a.x,PMainMenu(Owner)^.Broad.b.y+1);
  end;
  HideMouse;
  Img:=SaveImage(Broad.a.x,Broad.a.y,Broad.b.x+10,Broad.b.y+10,ImgSize);
  DrawBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,1);
  DrawShadow(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,10);
  for i:=0 to Num-1 do
  begin
    if Mm[i].Ms='' then
      DoubleLine(Broad.a.x+5,Pot.y+i*18+7,Broad.b.x-5,Pot.y+i*18+7)
    else
      WritecStr(Pot.x,Pot.y+i*18,Mm[i].Ms,$00,$04);
    if Mm[i].Sub<>nil then
      Writecs(Broad.b.x-9,Pot.y+i*18+1,#16,4);
    AssignRect(Mm[i].Mr,Broad.a.x+10,Pot.y+i*18,Broad.b.x-10,Pot.y+(i+1)*18);
  end;
  ShowMouse;
  DrawMark;
  MenuActive:=True;
  if Owner<>nil then
    FRect:=PMenu(Owner)^.Mm[OwnerIndex].Mr;
end;

Procedure TMenu.DrawMark;
var
  i:Integer;
begin
  if MouIn(Broad) then HideMouse;
  SetWriteMode(1);
  SetColor(7);
  PutPixel(0,0,0);
  for i:=0 to 15 do
  Line(Broad.a.x+10,Pot.y+Pos*18+i,Broad.b.x-10,Pot.y+Pos*18+i);
  SetWriteMode(0);
  ShowMouse;
end;

Procedure TMenu.UnActive;
begin
  if not MenuActive then Exit;
  HideMouse;
  PutImage(Broad.a.x,Broad.a.y,Img^,Copyput);
  FreeMem(Img,ImgSize);
  ShowMouse;
  MenuActive:=False;
end;

Procedure TMenu.ChangeMark;
begin
  if Pos=N then Exit;
  DrawMark;
  Pos:=N;
  if Pos>=Num then Pos:=0;
  if Pos<0 then Pos:=Num-1;
  if Mm[Pos].Ms='' then
    Inc(Pos,Dlt);
  DrawMark;
end;

Procedure TMenu.HotKeyEvent;
var
  i:Integer;
begin
  if Event.What<>evKeyDown then Exit;
  for i:=0 to Num-1 do
  if (Event.KeyCode<>kbNoKey) and (Event.KeyCode=Mm[i].Mk) then
  begin
    if Mm[i].Sub<>nil then
    begin
      Pos:=i;
      RunSubMenu(Event);
    end else
    begin
      Event.What:=evCommand;
      Event.Command:=Mm[i].Mc;
      Pos:=i;
      UnActive;
    end;
    Exit;
  end else
  if Mm[i].Sub<>nil then
    Mm[i].Sub^.HotKeyEvent(Event);
end;

Procedure TMenu.RunSubMenu;
begin
  Mm[Pos].Sub^.Run(Event);
  if Event.What=evCommand then
    UnActive;
end;

Procedure TMenu.HandleEvent;
var
  i:Integer;
begin
  HotKeyEvent(Event);
  if not MenuActive then Exit;
  case Event.What of
  evCommand:UnActive;
  evKeyDown :case Event.KeyCode of
             kbUp : ChangeMark(Pos-1,-1);
             kbDown:ChangeMark(Pos+1,1);
             kbLeft:begin
                      Event.What:=evCommand;
                      Event.Command:=cmLeftMenu;
                      UnActive;
                    end;
             kbRight:begin
                      Event.What:=evCommand;
                      Event.Command:=cmRightMenu;
                      UnActive;
                    end;
             kbEnter:begin
                      if Mm[Pos].Sub<>nil then
                        RunSubMenu(Event)
                      else begin
                        Event.What:=evCommand;
                        Event.Command:=Mm[Pos].mc;
                        UnActive;
                      end;
                    end;
             kbEsc:begin
                     ClearEvent(Event);
                     UnActive;
                   end;
             end;
  evMouseDown:if not IsIn(Event.Where,Broad) then
                UnActive
              else
              for i:=0 to Num-1 do
              if IsIn(Event.Where,Mm[i].Mr)and(Mm[i].Ms<>'') then
                ChangeMark(i,0);
  evMouseUp:  if (not IsIn(Event.Where,Broad))and(not IsIn(Event.Where,FRect)) then
                UnActive
              else
              for i:=0 to Num-1 do
              if IsIn(Event.Where,Mm[i].Mr)and(Mm[i].Ms<>'') then
              begin
                ChangeMark(i,0);
                if Mm[Pos].Sub<>nil then
                  RunSubMenu(Event)
                else begin
                  Event.What:=evCommand;
                  Event.Command:=Mm[i].Mc;
                  UnActive;
                  Exit;
                end;
              end;
  evMouseMove:begin
               for i:=0 to Num-1 do
               if IsIn(Event.Where,Mm[i].Mr)and(Mm[i].Ms<>'') then
                 ChangeMark(i,0);
               if Owner<>nil then
               if (Event.Buttons=mbLeftButton) and
                  IsIn(Event.Where,PMenu(Owner)^.Broad) and
                  (not IsIn(Event.Where,FRect)) then
                 UnActive;
              end;
  end;
end;

Procedure TMenu.Run;
begin
  Paint;
  repeat
    ClearEvent(Event);
    GetEvent(Event);
    HandleEvent(Event);
  until not MenuActive;
end;


Constructor TMainMenu.Init;
var
  Temp:PMenuItem;
begin
  Inherited Init(nil);
  Option:=Option or opFirstPros;
  GrowMode:=gfGrowHiX;
  Size.x:=R.b.x-R.a.x;
  Size.y:=R.b.y-R.a.y;
  MoveTo(R.a.x,R.a.y);
  SysFlag:=Sf;
  NowX:=2;
  if SysFlag then NowX:=16;
  while AMenu<>nil do
  begin
    Insert(AMenu^.Ms,AMenu^.Mk,AMenu^.Mc,AMenu^.Sub);
    Temp:=AMenu;
    AMenu:=AMenu^.Next;
    Dispose(Temp);
  end;
end;

Procedure TMainMenu.Insert;
begin
  Mm[Num].Ms:=S;
  Mm[Num].Mk:=K;
  Mm[Num].Mc:=C;
  Mm[Num].Sub:=Sub;
  AssignRect(Mm[Num].Mr,Broad.a.x+NowX,Broad.a.y,
             Broad.a.x+NowX+GetcLen(Mm[Num].Ms)*8,Broad.b.y);
  Inc(NowX,(GetcLen(Mm[Num].Ms)+2)*8);
  if Sub<>nil then
  begin
    Sub^.Owner:=@Self;
    Sub^.OwnerIndex:=Num;
  end;
  Inc(Num);
end;

Procedure TMainMenu.SetBroad;
begin
  Size.x:=R.b.x-R.a.x;
  Size.y:=R.b.y-R.a.y;
  MoveTo(R.a.x,R.a.y);
end;

Procedure TMainMenu.MoveTo;
var
  i,Temp:Integer;
begin
  Origin.x:=X;
  Origin.y:=Y;
  AssignRect(Broad,x,y,x+Size.x,y+Size.y);
  AssignRect(SysRect,x+3,y+3,x+14,y+14);
  Temp:=2;
  if SysFlag then Temp:=16;
  for i:=0 to Num-1 do
  begin
    AssignRect(Mm[i].Mr,Broad.a.x+Temp,Broad.a.y,
          Broad.a.x+Temp+GetcLen(Mm[i].Ms)*8,Broad.b.y);
    Inc(Temp,(GetcLen(Mm[i].Ms)+2)*8);
  end;
end;

Procedure TMainMenu.Paint;
var
  i:Integer;
begin
  HideMouse;
  SignBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,1);
  if SysFlag then
  begin
    SignBroadc(SysRect.a.x,SysRect.a.y,SysRect.b.x,SysRect.b.y,0,15);
    SetColor(4);
    Line(SysRect.a.x+1,SysRect.a.y+1,SysRect.b.x-1,SysRect.b.y-1);
    Line(SysRect.b.x-1,SysRect.a.y+1,SysRect.a.x+1,SysRect.b.y-1);
  end;
  for i:=0 to Num-1 do
  WritecStr(Mm[i].Mr.a.x,Mm[i].Mr.a.y+1,Mm[i].Ms,$00,$04);
  ShowMouse;
end;

Procedure TMainMenu.LeftMenu;
begin
  Dec(Pos);
  if Pos<0 then Pos:=Num-1;
  RunSubMenu(Event);
end;

Procedure TMainMenu.RightMenu;
begin
  Inc(Pos);
  if Pos>=Num then Pos:=0;
  RunSubMenu(Event);
end;

Procedure TMainMenu.HandleMainMenu;
label Start;
var
  i:Integer;
begin
 Start:
  HotKeyEvent(Event);
  case Event.What of
  evMouseUp: if SysFlag and IsIn(Event.Where,SysRect)and(Event.Buttons=mbLeftButton) then
             begin
               Event.What:=evCommand;
               Event.Command:=cmQuit;
             end;
  evMouseDown,evMouseMove:
             begin
              if (not MenuMoveActive)and(Event.Buttons=0) then Exit;
              for i:=0 to Num-1 do
              if IsIn(Event.Where,Mm[i].Mr) then
              begin
                Pos:=i;
                RunSubMenu(Event);
                goto Start;
              end;
             end;
  end;
end;

Procedure TMainMenu.HandleEvent;
label Start;
var
  i:Integer;
begin
  repeat
  Start:
    HandleMainMenu(Event);
    if Event.What=evCommand then
    case Event.Command of
    cmLeftMenu:begin LeftMenu(Event);goto Start; end;
    cmRightMenu:begin RightMenu(Event);goto Start; end;
    else for i:=0 to Num-1 do
         if (Event.Command<>0)and(Event.Command=Mm[i].Mc) then
         begin
           if Mm[i].Sub<>nil then
             Mm[i].Sub^.Run(Event);
           goto Start;
         end;
    end;
  until (Event.What<>evCommand)or(not (Event.Command in [cmLeftMenu,cmRightMenu]));
  for i:=0 to Num-1 do
  if Mm[i].Sub<>nil then
    Mm[i].Sub^.HandleEvent(Event);
end;


constructor TStatusLine.Init;
begin
  Inherited Init;
  GrowMode:=gfGrowHiX+gfGrowLoY+gfGrowHiY;
  Style:=Sty;
  Size.X:=R.B.X-R.A.X;
  Size.Y:=R.B.Y-R.A.Y;
  MoveTo(R.A.X,R.A.Y);
  Str:=S;
  BakImg:=nil;
end;

destructor TStatusLine.Done;
begin
  Hide;
  Inherited Done;
end;

Procedure TStatusLine.Paint;
var
  Rec:TRect;
  i,Temp:Integer;
  TempStr:string;
  ErrorFlag:Boolean;
begin
  if Length(Str)=0 then
  begin
    Hide;
    Exit;
  end;
  HideMouse;
  if (BakImg=nil)and((Style and slSaveBack)<>0) then
    BakImg:=SaveImage(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,BakSize);
  if (Style and slBroad)<>0 then
    SignBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,1)
  else
    Full(Broad.a.x+2,Broad.a.y+2,Broad.b.x-2,Broad.b.y-2,7);
  Temp:=5;
  TempStr:='';
  ErrorFlag:=False;
  for i:=1 to Length(Str) do
  if (Str[i]=#1) then
    ErrorFlag:=True
  else if (i=Length(Str))or(Str[i]=#0) then
  begin
    if (i=Length(Str))and(Str[i]<>#0) then
      TempStr:=TempStr+Str[i];
    AssignRect(Rec,Broad.a.x+Temp,Broad.a.y+3,
                   Broad.a.x+Temp+GetcLen(TempStr)*8+4,Broad.b.y-3);
    if (i=Length(Str))and(Str[i]=#0) then
      Rec.b.x:=Broad.b.x-5;
    if ErrorFlag then
    begin
      SignBroadc(Rec.a.x,Rec.a.y,Rec.b.x,Rec.b.y,0,4);
      WritecStr(Rec.a.x+2,Rec.a.y,TempStr,$F,$E);
    end else
    begin
      SignBroad(Rec.a.x,Rec.a.y,Rec.b.x,Rec.b.y,0);
      WritecStr(Rec.a.x+2,Rec.a.y,TempStr,$0,$4);
    end;
    Inc(Temp,GetcLen(TempStr)*8+10);
    TempStr:='';
  end else
    TempStr:=TempStr+Str[i];
  ShowMouse;
  if (Style and slSetActive)<>0 then
    StatusLineActive:=True;
end;

Procedure TStatusLine.Hide;
begin
  if BakImg=nil then Exit;
  HideMouse;
  PutImage(Broad.a.x,Broad.a.y,BakImg^,CopyPut);
  ShowMouse;
  FreeMem(BakImg,BakSize);
  BakImg:=nil;
  if (Style and slSetActive)<>0 then
    StatusLineActive:=False;
end;

Procedure TStatusLine.Show;
begin
  Paint;
end;

Procedure TStatusLine.Modify;
begin
  if Str=S then Exit;
  Str:=S;
  Paint;
end;

Procedure TStatusLine.SwapLine;
var
  TempStr:string;
begin
  if Str=S then Exit;
  TempStr:=S;
  S:=Str;
  Str:=TempStr;
  Paint;
end;

end.