{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                     计算器单元                          ***}
{***************************************************************}
{$O+,F+,X+,I-,S-,N+,E+}
Unit FCalc;
Interface
Uses
  FMouse,FEvent,FView,Graph,FGraph,FWrite;

Const
  MaxBut=24;

Type
 PBut=^TBut;
 TBut=object(TView)
  R:TRect;
  Str:string[2];
  Wid,Hig:integer;
  KeyCh:Char;
  constructor Init(Rr:TRect;S:string;Key:Char);
  procedure Paint;virtual;
  procedure DrawPush;
  procedure MoveTo(X,Y:Integer);virtual;
  function  Push:Boolean;
  procedure HandleEvent(var Event:TEvent);virtual;
 end;

  PCalc = ^TCalc;
  TCalc = object(TView)
    Len:Integer;
    Size_:TPoint;
    Status:Word;
    Number:string[30];
    Sign:Char;
    Operator:Char;
    Operand:Extended;
    constructor Init(x,y,l:Integer);
    procedure CalcKey(Key: Char);
    procedure Clear;
    procedure Draw;virtual;
    procedure Paint;virtual;
    procedure MoveTo(x,y:Integer);virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

Function CalculatorWindow:PWindow;
Implementation
const
  csError  = 10;
  csFirst  = 11;
  csValid  = 12;

constructor TBut.Init;
begin
  Inherited Init;
  R:=Rr;
  Origin:=R.A;
  Str:=S;
  Wid:=r.b.x-r.a.x;
  Hig:=r.b.y-r.a.y;
  KeyCh:=Key;
end;

procedure TBut.Paint;
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);
  setcolor(4);
  settextstyle(0,0,1);
  outtextxy(r.a.x+ wid div 2 -length(str)*4,r.a.y+hig div 2-3,str);
  showmouse;
end;

procedure tbut.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);
  setcolor(4);
  settextstyle(0,0,1);
  outtextxy(r.a.x+ wid div 2 -length(str)*4+1,r.a.y+hig div 2-3+1,str);
  showmouse;
end;

procedure tbut.moveto;
begin
  Origin.X:=x;
  Origin.Y:=y;
  r.a.x:=x;r.a.y:=y;
  r.b.x:=r.a.x+wid;
  r.b.y:=r.a.y+hig;
end;

function tbut.push;
label circle;
var event:tevent;
begin
  push:=true;
  drawpush;
  circle:
  repeat
    clearevent(event);
    getevent(event);
  until (event.what=evmouseup)or(event.what=evmousemove);
  if event.what=evmouseup then paint
  else if isin(event.where,r) then goto circle
  else begin paint;push:=false;end;
end;

procedure tbut.handleevent;
begin
  case event.what of
  evmousedown:if isin(event.where,r) and (event.buttons=mbleftbutton) then
              if push then
              begin
                   event.what:=evcommand;
                   event.command:=cmbuttondown;
                   event.infochar:=keych;
              end;
  evkeydown  :if upcase(event.charcode)=keych then
              begin event.what:=evcommand;
                    event.command:=cmbuttondown;
                    event.infochar:=keych;
              end;
  end;
end;


constructor TCalc.Init;
begin
  Inherited Init;
  size_.x:=l;
  len:=l;
  size_.y:=1;
  broad.a.x:=(x div 8)*8;
  broad.a.y:=y;
  broad.b.x:=broad.a.x+8*size_.x;
  broad.b.y:=broad.a.y+15;
  Origin:=Broad.A;
  Clear;
end;

procedure TCalc.CalcKey(Key: Char);
var
  R: Extended;

procedure FlushKey;
begin
  case key of
  'T':key:=#251;
  'S':key:='^';
  'N':key:='@';
  end;
end;

procedure Error;
begin
  Status:=csError;
  Number := 'Error';
  Sign := ' ';
end;

procedure SetDisplay(R: Extended);
var
  S: string[63];
begin
  Str(R: 0: 10, S);
  if S[1] <> '-' then Sign := ' ' else
  begin
    Delete(S, 1, 1);
    Sign := '-';
  end;
  if Length(S) > len then Error
  else
  begin
    while S[Length(S)] = '0' do Dec(S[0]);
    if S[Length(S)] = '.' then Dec(S[0]);
    Number := S;
  end;
end;

procedure GetDisplay(var R: Extended);
var
  E: Integer;
begin
  Val(Sign + Number, R, E);
end;

procedure CheckFirst;
begin
  if Status = csFirst then
  begin
    Status := csValid;
    Number := '0';
    Sign := ' ';
  end;
end;

begin
  Key := UpCase(Key);
  flushkey;
  if (Status = csError) and (Key <> 'C') then Key := ' ';
  case Key of
    '0'..'9':
      begin
        CheckFirst;
        if Number = '0' then Number := '';
        if length(Number)<len-1 then
        Number := Number + Key;
      end;
    '.':
      begin
        CheckFirst;
        if Pos('.', Number) = 0 then Number := Number + '.';
      end;
    #8, #27:
      begin
        CheckFirst;
        if Length(Number) = 1 then Number := '0' else Dec(Number[0]);
      end;
    '_', #241:
      if Sign = ' ' then Sign := '-' else Sign := ' ';
    #251:begin Status := csFirst;
           GetDisplay(R);
           if sign='-' then error
           else SetDisplay(sqrt(R));
           Operator := Key;
           GetDisplay(Operand);
         end;
    '^': begin Status := csFirst;
           getdisplay(r);
           setdisplay(r*r);
           Operator := Key;
           GetDisplay(Operand);
         end;
    '@': begin Status := csFirst;
           getdisplay(r);
           if r=0 then error
           else setdisplay(1/r);
           Operator := Key;
           GetDisplay(Operand);
         end;

    '+', '-', '*', '/', '=', '%', #13:
      begin
        if Status = csValid then
        begin
          Status := csFirst;
          GetDisplay(R);
          if Key = '%' then
            case Operator of
              '+', '-': R := Operand * R / 100;
              '*', '/': R := R / 100;
            end;
          case Operator of
            '+': SetDisplay(Operand + R);
            '-': SetDisplay(Operand - R);
            '*': SetDisplay(Operand * R);
            '/': if R = 0 then Error else SetDisplay(Operand / R);
          end;
        end;
        Operator := Key;
        GetDisplay(Operand);
      end;
    'C':
      Clear;
  end;
  Paint;
end;

procedure TCalc.Clear;
begin
  Status := csFirst;
  Number := '0';
  Sign := ' ';
  Operator := '=';
end;

procedure TCalc.MoveTo;
begin
  Origin.X:=x;
  Origin.Y:=y;
  AssignRect(Broad,(x div 8)*8,y,(x div 8)*8+8*Size_.x,y+15);
end;

procedure TCalc.Draw;
var
  I,j: Integer;
  B: string;
begin
  b:='';
  I := Size_.X - Length(Number);
  for j:=1 to size_.x do b:=b+' ';
  b[i]:=Sign;
  for j:=i+1 to Size_.x do b[j]:=Number[j-i];
  hideMouse;
  Writec16(Broad.a.x div 8,Broad.a.y,b,$0f);
  ShowMouse;
end;

procedure TCalc.Paint;
begin
  HideMouse;
  DrawBroadC(Broad.a.x-2,Broad.a.y-2,Broad.b.x+2,Broad.b.y+2,0,0);
  Draw;
end;

procedure TCalc.HandleEvent(var Event: TEvent);
const
 KeyCan: array[0..30] of Char =
     'C'#27'%'#241#251'789/^456*@123-#0.=+&_TSN'#13#8;
var
  i:Integer;
begin
  case Event.What of
    evCommand:
      if Event.Command = cmButtonDown then
      begin
        CalcKey(Event.InfoChar);
        ClearEvent(Event);
      end;
    evKeyDown:
      for i:=0 to 30 do
      if UpCase(Event.CharCode)=KeyCan[i] then
      begin
        CalcKey(Event.CharCode);
        ClearEvent(Event);
        Exit;
      end;
  end;
end;

{ TCalculator }

Function CalculatorWindow:PWindow;
const
  KeyChar: array[0..maxbut] of Char = 'C'#27'%'#241#251'789/^456*@123-#0.=+&';
var
  I: Integer;
  P: PWindow;
  R: TRect;
begin
  AssignRect(R, 0, 0, 270, 200);
  P:=New(PWindow,Init(R,'Calculator',True));
  P^.Option:=P^.Option or opAligen8;
  for I := 0 to MaxBut do
  begin
    R.A.X := 18+(I mod 5) * 40 ;
    R.A.Y := 55+(I div 5) * 25 ;
    R.B.X := R.A.X + 32;
    R.B.Y := R.A.Y + 20;
    P^.Insert(New(PBut, Init(R, KeyChar[I], KeyChar[I])));
  end;
  P^.Insert(New(PCalc, Init(20,30,30)));
  P^.Next;
  P^.Center;
  CalculatorWindow:=P;
end;

end.