{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                   选择件对象单元                        ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FControl;
Interface
Uses
  Dos,Graph,FGraph,FMouse,FEvent,FWrite,FView,FTool;

Const
  stChkBox  = 0;
  stRadBut  = 1;

  stFColor  = $80;
  stNormal  = $00;
  stDefault = $01;
  stShadow  = $02;
  stShadow1 = $03;
  stShadow2 = $04;
  stFast    = $05;

Type
  PCluster=^TCluster;
  TCluster=object(TView)
   St:string[30];
   SelectFlag:Boolean;
   ActiveFlag:Boolean;
   Data:^Boolean;
   Style:Word;
   constructor Init(x,y:Integer;S:string;var Sel:Boolean;Sty:Word);
   procedure SetData;virtual;
   procedure MoveTo(x,y:Integer);virtual;
   procedure Paint;virtual;
   function  GetStatus:Boolean;
   procedure SetStatus(Sel:Boolean);
   procedure Active;virtual;
   procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PCheckBox=^TCheckBox;
  TCheckBox=object(TView)
   Title:string;
   Clu:array[1..16] of PCluster;
   Number,Current:Byte;
   ActiveFlag:Boolean;
   constructor Init(x1,y1,x2,y2:Integer;Tit:string);
   destructor Done;virtual;
   procedure Insert(s:string;var sel:Boolean);
   procedure SetData;virtual;
   procedure MoveTo(x,y:Integer);virtual;
   procedure Paint;virtual;
   procedure Active;virtual;
   procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PRadioButton=^TRadioButton;
  TRadioButton=object(TView)
   Title:string;
   Clu:array[1..16] of pCluster;
   Number,Current:Byte;
   Data:^Byte;
   ActiveFlag:Boolean;
   constructor Init(x1,y1,x2,y2:Integer;Tit:string;var Sel:Byte);
   destructor Done;virtual;
   procedure Insert(s:string);
   procedure SetData;virtual;
   procedure MoveTo(x,y:Integer);virtual;
   procedure Paint;virtual;
   procedure Active;virtual;
   procedure HandleEvent(var Event:TEvent);virtual;
  end;

  PStaticText=^TStaticText;
  TStaticText=Object(TView)
   Title: String;
   Color: Byte;
   Style:Byte;
   Hig:Byte;
   Constructor Init(St:Byte;X,Y:Integer;S:String;C:Byte);
   Procedure MoveTo(X,Y:Integer); Virtual;
   Procedure Modify(S:String);
   Procedure ModifyColor(C:Byte);
   Procedure Paint; Virtual;
  end;

  PLabel=^TLabel;
  TLabel=Object(TView)
   Title: String;
   Color: Byte;
   Style:Byte;
   Hig:Byte;
   View: PView;
   Constructor Init(St:Byte;X,Y:Integer;S:String;C:Byte;P:PView);
   Destructor Done; Virtual;
   Procedure SetData; Virtual;
   Procedure MoveTo(X,Y:Integer); Virtual;
   Procedure Paint; Virtual;
   Procedure HandleEvent(Var Event:TEvent); Virtual;
  end;

  GpfHeader=record
   Sign:Array[0..31] of Char;
   GpfType:Word;
   Number:Integer;
   Width:Word;
   Height:Word;
   BlockSize:Word;
  end;

  DPicType=record
   F,B:Pointer;
   Size:Word;
  end;
  ArrDPicType=array[1..1] of DPicType;

  PGpfList=^TGpfList;
  TGpfList=object(TView)
   FileName:PathStr;
   Pic:^ArrDPicType;
   Number,MaxNumber:Integer;
   Constructor Init(Name:PathStr;Num:Integer);
   Destructor Done;virtual;
   Procedure Insert(Num:Integer);
   Function  PicF(Num:Integer):Pointer;
   Function  PicB(Num:Integer):Pointer;
  end;

  PGroupBut=^TGroupBut;
  TGroupBut=Object(TView)
   Group:PGroup;
   Count:Integer;
   Constructor Init(X,Y:Integer);
   Destructor Done; Virtual;
   Procedure MoveTo(X,Y:Integer); Virtual;
   Procedure Paint; Virtual;
   Procedure Insert(R:TRect;S:string;Key,Com:Word;Im1,Im2,Im3,Im4:Pointer;Hint:string);
   Procedure ChangeStatu(P:PView);
   Procedure ChangeIndex(Ind:Integer);
   Function  GetCurrent:Integer;
   Procedure HandleEvent(Var Event:TEvent); Virtual;
  end;

Implementation
Const
  GpfSignArr='Graph Group File of FVision 1.0'#$1A;

constructor TCluster.Init;
begin
  Inherited Init;
  St:=S;
  Data:=@Sel;
  SelectFlag:=Sel;
  Style:=Sty;
  MoveTo(x,y);
  ActiveFlag:=False;
end;

procedure TCluster.SetData;
begin
  Data^:=selectflag;
end;

function  TCluster.GetStatus;
begin
  GetStatus:=SelectFlag;
end;

procedure TCluster.SetStatus;
begin
  if SelectFlag<>Sel then
  begin
    SelectFlag:=Sel;
    Paint;
  end;
end;

procedure TCluster.Paint;
begin
  HideMouse;
  if Style=0 then
  signBroad(Broad.a.x,Broad.a.y,Broad.a.x+15,Broad.b.y,0)
  else begin
    full(Broad.a.x,Broad.a.y,Broad.a.x+16,Broad.b.y,7);
    setcolor(8);
    arc(Broad.a.x+8,Broad.a.y+8,45,225,7);
    setcolor(15);
    arc(Broad.a.x+8,Broad.a.y+8,226,44,7);
  end;
  if ActiveFlag and (SelectFlag or (Style=stChkBox)) then
    writecs(Broad.a.x+20,Broad.a.y,st,15)
  else writecs(Broad.a.x+20,Broad.a.y,st,0);
  if selectflag then begin
    setcolor(4);
    if Style=0 then begin
     line(Broad.a.x+2,Broad.a.y+10,Broad.a.x+6,Broad.b.y-3);
     line(Broad.a.x+6,Broad.b.y-3,Broad.a.x+14,Broad.a.y+4);
    end else begin
      setfillStyle(1,4);
      fillellipse(Broad.a.x+8,Broad.a.y+8,3,3);
    end;
  end;
  showmouse;
end;

procedure TCluster.MoveTo;
begin
  origin.x:=x;
  origin.y:=y;
  Broad.a:=origin;
  Broad.b.x:=Broad.a.x+20+length(st)*8;
  Broad.b.y:=Broad.a.y+15;
end;

Procedure TCluster.Active;
begin
  ActiveFlag:=not ActiveFlag;
  Paint;
end;

procedure tCluster.HandleEvent;
begin
  case Event.what of
  evmousedown:if isin(Event.where,Broad) then
              begin
                if Style<>0 then
                begin
                  if not selectflag then begin
                    Event.what:=evcommand;
                    Event.command:=cmselect;
                    Event.infoptr:=@self;
                    selectflag:=true;
                    Paint;
                  end;
                  exit;
                end else begin
                  selectflag:=not selectflag;
                  Paint;
                  Event.what:=evcommand;
                  Event.command:=cmChkSelect;
                  Event.infoptr:=@self;
                  exit;
                end;
              end else exit;
  evkeydown:case Event.keycode of
            kbspace:if ActiveFlag and (Style=0) then
                    begin
                      selectflag:=not selectflag;Paint;
                    end else exit;
            else exit;
            end;
  else exit;
  end;
  clearEvent(Event);
end;

constructor TCheckBox.Init;
begin
  Inherited Init;
  AssignRect(Broad, x1,y1,x2,y2);
  Origin:=Broad.A;
  Size.x:=x2-x1;
  Size.y:=y2-y1;
  Title:=tit;
  Number:=0;
  Current:=1;
  ActiveFlag:=False;
end;

destructor TCheckBox.Done;
var
  i:Byte;
begin
  for i:=1 to Number do
  Dispose(Clu[i],Done);
  Inherited Done;
end;

procedure TCheckBox.Insert;
begin
  Inc(Number);
  if Number*18<Size.y then
    Clu[Number]:=New(pCluster,
      Init(Origin.x+10,Origin.y+13+(Number-1)*18,S,Sel,stChkbox))
  else
    Clu[Number]:=New(pCluster,Init(Origin.x+Size.x div 2+10,
         Origin.y+13+(Number-Size.y div 18-1)*18,S,Sel,stChkbox));
end;

procedure TCheckBox.SetData;
var i:Byte;
begin
  for i:=1 to Number do Clu[i]^.SetData;
end;

procedure TCheckBox.Paint;
var
  i:Byte;
  TxtColor:Byte;
begin
  if ActiveFlag then
    TxtColor:=4
  else TxtColor:=0;
  HideMouse;
  DoubleBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
  Full(Broad.A.X+10,Broad.A.Y-7,Broad.A.X+9+GetLength(Title)*8,Broad.A.Y+8,7);
  Writecs(Broad.A.X+10,Broad.A.Y-7,Title,TxtColor);
  for i:=1 to Number do
  Clu[i]^.Paint;
end;

procedure TCheckBox.Active;
var
  TxtColor:Byte;
begin
  ActiveFlag:=not ActiveFlag;
  if ActiveFlag then
    TxtColor:=4
  else TxtColor:=0;
  HideMouse;
  Full(Broad.A.X+10,Broad.A.Y-7,Broad.A.X+9+GetLength(Title)*8,Broad.A.Y+8,7);
  Writecs(Broad.A.X+10,Broad.A.Y-7,Title,TxtColor);
  Clu[Current]^.Active;
end;

procedure TCheckBox.MoveTo;
var i:Byte;
begin
  Origin.x:=x;
  Origin.y:=y;
  Broad.a:=Origin;
  Broad.b.x:=Broad.a.x+size.x;
  Broad.b.y:=Broad.a.y+size.y;
  for i:=1 to Number do
  if i*18<Size.y then
    Clu[i]^.MoveTo(Origin.x+10,Origin.y+13+(i-1)*18)
  else
    Clu[i]^.MoveTo(Origin.x+Size.x div 2+10,
                   Origin.y+13+(i-Size.y div 18-1)*18);
end;

procedure TCheckBox.HandleEvent;
var
  i:Byte;
begin
  if Number=0 then exit;
  case Event.what of
  evKeyDown:case Event.KeyCode of
            kbUp:if ActiveFlag then
                 begin
                   Clu[Current]^.Active;
                   if Current>1 then
                     Dec(Current)
                   else Current:=Number;
                   Clu[Current]^.Active;
                   ClearEvent(Event);
                 end;
            kbDown:if ActiveFlag then
                 begin
                   Clu[Current]^.Active;
                   if Current<Number then
                     Inc(Current)
                   else Current:=1;
                   Clu[Current]^.Active;
                   ClearEvent(Event);
                 end;
            kbSpace:if ActiveFlag then
                 begin
                   Clu[Current]^.HandleEvent(Event);
                   ClearEvent(Event);
                 end;
            end;
  end;
  for i:=1 to Number do
  Clu[i]^.HandleEvent(Event);
  case Event.What of
  evMouseDown:if IsIn(Event.Where,Broad) then
              Event.InfoPtr:=@Self;
  evCommand:if (Event.Command=cmChkSelect) then
            begin
              if (Event.InfoPtr<>Clu[Current]) then
              begin
                if ActiveFlag then
                  Clu[Current]^.Active;
                for i:=1 to Number do
                if Event.InfoPtr=Clu[i] then
                  Current:=i;
                if ActiveFlag then
                  Clu[Current]^.Active;
              end;
              ClearEvent(Event);
            end;
  end;
end;

constructor TRadioButton.Init;
begin
  Inherited Init;
  AssignRect(Broad, x1,y1,x2,y2);
  Origin:=Broad.A;
  Size.x:=x2-x1;
  Size.y:=y2-y1;
  Title:=Tit;
  Number:=0;
  Data:=@Sel;
  Current:=Sel;
  ActiveFlag:=False;
end;

destructor TRadioButton.Done;
var
  i:Byte;
begin
  for i:=1 to Number do
  Dispose(Clu[i],Done);
  Inherited Done;
end;

procedure TRadioButton.Insert;
var
  Sele:Boolean;
begin
  Inc(Number);
  Sele:=Number=Current;
  if Number*18<Size.y then
    Clu[Number]:=New(PCluster,
      Init(Origin.x+10,Origin.y+13+(Number-1)*18,S,Sele,StradBut))
  else
    Clu[Number]:=New(PCluster,Init(Origin.x+Size.x div 2+10,
         Origin.y+13+(Number-Size.y div 18-1)*18,S,Sele,StradBut));
end;

procedure TRadioButton.SetData;
begin
  Data^:=Current;
end;

procedure TRadioButton.Paint;
var
  i:Byte;
  TxtColor:Byte;
begin
  if ActiveFlag then
    TxtColor:=4
  else
    TxtColor:=0;
  HideMouse;
  DoubleBroad(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y);
  Full(Broad.A.X+10,Broad.A.Y-7,Broad.A.X+9+GetLength(Title)*8,Broad.A.Y+8,7);
  Writecs(Broad.A.X+10,Broad.A.Y-7,Title,TxtColor);
  for i:=1 to Number do
  Clu[i]^.Paint;
end;

procedure TRadioButton.Active;
var
  i:Integer;
  TxtColor:Byte;
begin
  ActiveFlag:=not ActiveFlag;
  if ActiveFlag then
    TxtColor:=4
  else
    TxtColor:=0;
  HideMouse;
  Full(Broad.A.X+10,Broad.A.Y-7,Broad.A.X+9+GetLength(Title)*8,Broad.A.Y+8,7);
  Writecs(Broad.A.X+10,Broad.A.Y-7,Title,TxtColor);
  for i:=1 to Number do
  Clu[i]^.Active;
end;

procedure TRadioButton.MoveTo;
var
  i:Byte;
begin
  Origin.x:=x;
  Origin.y:=y;
  Broad.a:=Origin;
  Broad.b.x:=Broad.a.x+Size.x;
  Broad.b.y:=Broad.a.y+Size.y;
  for i:=1 to Number do
  if i*18<Size.y then
    Clu[i]^.MoveTo(Origin.x+10,Origin.y+13+(i-1)*18)
  else
    Clu[i]^.MoveTo(Origin.x+Size.x div 2+10,
                   Origin.y+13+(i-Size.y div 18-1)*18);
end;

procedure TRadioButton.HandleEvent;
var
  i:Byte;
begin
  if Number=0 then Exit;
  for i:=1 to Number do
  Clu[i]^.HandleEvent(Event);
  case Event.what of
  evMouseDown:if IsIn(Event.Where,Broad) then
              begin
                Event.InfoPtr:=@Self;
                Exit;
              end else Exit;
  evKeyDown:case Event.KeyCode of
            kbUp:if ActiveFlag then
                 begin
                   Clu[Current]^.SetStatus(False);
                   if Current>1 then
                     Dec(Current)
                   else
                     Current:=Number;
                   Clu[Current]^.SetStatus(True);
                 end;
            kbDown:if ActiveFlag then
                 begin
                   Clu[Current]^.Setstatus(False);
                   if Current<Number then
                     Inc(Current)
                   else
                     Current:=1;
                   Clu[Current]^.SetStatus(True);
                 end;
            else Exit;
            end;
  evCommand:case Event.Command of
            cmSelect:for i:=1 to Number do
                     if Clu[i]=Event.InfoPtr then
                       Current:=i
                     else
                       Clu[i]^.SetStatus(False);
            else Exit;
            end;
  else Exit;
  end;
  ClearEvent(Event);
end;

Constructor TStaticText.Init;
Begin
  Inherited Init;
  Option:=Option or opCantSelect;
  Title:=S;
  Color:=C;
  Style:=St;
  case Style and $0F of
  stNormal,stShadow,stShadow1,stShadow2 :Hig:=15;
  stDefault:Hig:=7;
  end;
  MoveTo(X,Y);
end;

Procedure TStaticText.MoveTo;
Begin
  AssignRect(Broad,X,Y,X+Length(Title)*8-1,Y+Hig);
  Origin:=Broad.a;
end;

Procedure TStaticText.Modify;
begin
  if Title=S then Exit;
  HideMouse;
  if Style in [stFast] then
  begin
    FillChar(Title[1],Length(Title),' ');
    Writec16(Broad.A.X div 8,Broad.A.Y,Title,Color);
  end else
  begin
    if (Style and stFColor)<>0 then
      Full(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,Color shr 4)
    else
      Full(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,7);
  end;
  Title:=S;
  Broad.b.x:=Broad.a.x+Length(Title)*8-1;
  Paint;
end;

Procedure TStaticText.ModifyColor;
begin
  if C=Color then Exit;
  Color:=C;
  Paint;
end;

Procedure TStaticText.Paint;
Begin
  HideMouse;
  if (Style and stFColor)<>0 then
    Full(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,Color shr 4);
  case Style and $0F of
  stNormal :Writecs(Broad.A.X,Broad.A.Y,Title,Color and $0F);
  stShadow :WritecMap(Broad.A.X,Broad.A.Y,Title,Color and $0F,Color and $0F+8);
  stShadow1:WriteShe(Broad.A.X,Broad.A.Y,Title,Color and $0F,Color and $0F+8);
  stShadow2:WriteShe(Broad.A.X,Broad.A.Y,Title,Color and $0F,Color and $0F);
  stFast   :Writec16(Broad.A.X div 8,Broad.A.Y,Title,Color);
  stDefault:begin
              SetColor(Color and $0F);
              SetTextStyle(0,0,1);
              OutTextXY(Broad.A.X,Broad.A.Y,Title);
            end;
  end;
  ShowMouse;
end;

Constructor TLabel.Init;
Begin
  Inherited Init;
  Title:=S;
  Color:=C;
  Style:=St;
  case Style of
  stNormal,stShadow,stShadow1,stShadow2:Hig:=15;
  stDefault:Hig:=7;
  end;
  View:=P;
  MoveTo(X,Y);
end;

Destructor TLabel.Done;
Begin
  if View<>nil then Dispose(View,Done);
end;

Procedure TLabel.SetData;
Begin
  if View<>nil then View^.SetData;
end;

Procedure TLabel.MoveTo;
Begin
  AssignRect(Broad,X,Y,X+Length(Title)*8-1,Y+Hig);
  Origin:=Broad.a;
  if View<>nil then View^.MoveTo(X,Y);
end;

Procedure TLabel.Paint;
Begin
  if View<>nil then View^.Paint;
  HideMouse;
  case Style of
  stNormal :Writecs(Broad.A.X,Broad.A.Y,Title,Color);
  stShadow :WritecMap(Broad.A.X,Broad.A.Y,Title,Color,Color+8);
  stShadow1:WriteShe(Broad.A.X,Broad.A.Y,Title,Color,Color+8);
  stShadow2:WriteShe(Broad.A.X,Broad.A.Y,Title,Color,Color);
  stDefault:begin
              SetColor(Color);
              SetTextStyle(0,0,1);
              OutTextXY(Broad.A.X,Broad.A.Y,Title);
            end;
  end;
  ShowMouse;
end;

Procedure TLabel.HandleEvent;
Begin
  if View<>nil then View^.HandleEvent(Event);
end;

Constructor TGpfList.Init;
begin
  Inherited Init;
  Option:=opCantSelect;
  FileName:=Name;
  MaxNumber:=Num;
  Number:=0;
  GetMem(Pic,SizeOf(ArrDPicType)*MaxNumber);
end;

Destructor TGpfList.Done;
var
  i:Integer;
begin
  for i:=1 to Number do
  begin
    FreeMem(Pic^[i].F,Pic^[i].Size);
    FreeMem(Pic^[i].B,Pic^[i].Size);
  end;
  FreeMem(Pic,SizeOf(ArrDPicType)*MaxNumber);
  Inherited Done;
end;

Procedure TGpfList.Insert;
var
  Fp:File;
  Result:Word;
  Head:GpfHeader;
begin
  if Number>=MaxNumber then Exit;
  Assign(Fp,FileName);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,Head,SizeOf(GpfHeader),Result);
  if Num>Head.Number then Exit;
  Seek(Fp,SizeOf(GpfHeader)+(Num-1)*Head.BlockSize*2);
  if IOResult<>0 then Exit;
  Inc(Number);
  Pic^[Number].Size:=Head.BlockSize;
  GetMem(Pic^[Num].F,Head.BlockSize);
  GetMem(Pic^[Num].B,Head.BlockSize);
  BlockRead(Fp,Pic^[Num].F^,Head.BlockSize,Result);
  BlockRead(Fp,Pic^[Num].B^,Head.BlockSize,Result);
  Close(Fp);
end;

Function TGpfList.PicF;
begin
  if Num>Number then
    PicF:=nil
  else
    PicF:=Pic^[Num].F;
end;

Function TGpfList.PicB;
begin
  if Num>Number then
    PicB:=nil
  else
    PicB:=Pic^[Num].B;
end;




Constructor TGroupBut.Init;
begin
  Inherited Init;
  Origin.X:=X;
  Origin.Y:=Y;
  Group:=New(PGroup,Init);
  Group^.Owner:=@Self;
  Count:=0;
end;

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

Procedure TGroupBut.MoveTo;
begin
  Group^.MoveTo(X-Origin.X,Y-Origin.Y);
  Origin.X:=X;
  Origin.Y:=Y;
end;

Procedure TGroupBut.Paint;
begin
  Group^.PaintAll;
end;

Procedure TGroupBut.Insert;
var
  But:PStatuBut;
begin
  Inc(R.a.x,Origin.x);
  Inc(R.a.y,Origin.y);
  Inc(R.b.x,Origin.x);
  Inc(R.b.y,Origin.y);
  But:=New(PStatuBut,Init(R,S,Key,Com,Im1,Im2,Im3,Im4,Count));
  But^.SetHint(Hint);
  if Count=0 then But^.Statu:=True;
  Group^.Insert(But);
  Inc(Count);
end;

Procedure TGroupBut.ChangeStatu;
var
  Temp:PViewItem;
begin
  Temp:=Group^.First;
  while Temp<>nil do
  begin
    if Temp^.View<>P then
      PStatuBut(Temp^.View)^.SetStatu(False)
    else
      Group^.This:=Temp;
    Temp:=Temp^.Next;
  end;
end;

Procedure TGroupBut.ChangeIndex;
var
  Temp:PViewItem;
begin
  Temp:=Group^.First;
  while Temp<>nil do
  begin
    if PStatuBut(Temp^.View)^.Index<>Ind then
      PStatuBut(Temp^.View)^.SetStatu(False)
    else
    begin
      PStatuBut(Temp^.View)^.SetStatu(True);
      Group^.This:=Temp;
    end;
    Temp:=Temp^.Next;
  end;
end;

Function  TGroupBut.GetCurrent;
begin
  GetCurrent:=0;
  if Group^.GetThis=nil then Exit;
  GetCurrent:=PStatuBut(Group^.GetThis)^.Index;
end;

Procedure TGroupBut.HandleEvent;
begin
  case Event.What of
  evCommand:case Event.Command of
            cmChangeStatu:begin
                            ChangeStatu(Event.InfoPtr);
                            ClearEvent(Event);
                            Exit;
                          end;
            cmChangeIndex:begin
                            ChangeIndex(Event.InfoInt);
                            ClearEvent(Event);
                            Exit;
                          end;
            end;
  end;
  Group^.HandleEvent(Event);
end;

end.