unit charinp;

{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2003, SHIRAISHI Kazuo *)
(***************************************)


interface

uses
   SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
   myutils,base, LResources;

type
  TCharInput = class(TForm)
    Label1: TLabel;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
  public
    c:ansistring;
    TimeLimit:TDateTime;
    LineNumber:integer;
    function execute(option:IOoptions):ansistring;
    procedure init;
  end;

var
  CharInput: TCharInput;

implementation
uses  texthand,struct;
{$R *.lfm}

procedure TCharInput.FormKeyPress(Sender: TObject; var Key: Char);
begin
   c:=c+key;
end;


function TCharInput.execute(option:IOoptions):ansistring;
var
   svCtrlBreakHit:boolean;
   i:integer;
begin
   controlword:=OriginalCw;   //2014.1.20
   SetFPUMask(OriginalCW);     //2014.1.20  Ver.0.6.3.6

   svCtrlBreakHit:=CtrlBreakHit;
   CtrlBreakHit:=false;
   IdleImmediately;

   if not(ioNoWait in option) then
      SelectLine(TextHand.memo,LineNumber);
   caption:=TextHand.getMemoLine(LineNumber);
   Label1.visible:=true;

   if ioClear in option then
      c:='';

   show;
   BringTofront;
   IdleImmediately;
   While not((ioNoWait in option) or (Length(c)>0) or CtrlBreakHit or (now>=timelimit)) do
     begin
      sleep(10);IdleImmediately;
     end;

   if Length(c)>0 then
      begin
         if ioCharacterByte in option then
           begin
              result:=c[1];
              delete(c,1,1);
           end
         else
           begin
              i:=1;
              ReadMBC(i,c);
              result:=copy(c,1,i);
              delete(c,1,i);
           end;
      end
   else
      result:='';

   CtrlBreakHit:=CtrlBreakHit or svCtrlbreakHit;
   //texthand.memo.sellength:=0;
   Label1.visible:=false;
   caption:='';

   controlword:= NormalCW;       //2014.1.20
   SetFPUMask(controlword);    //2014.1.20  Ver.0.6.3.6

   if (now>=timelimit) then setexception(8401);
end;


procedure TCharInput.FormCreate(Sender: TObject);
begin
  init;

   left:=0;
   top:=0;
   width:=4;
   {$IFDEF Darwin}
    height:=12;
   {$ELSE}
    height:=1;
   {$ENDIF}


end;

procedure TCharInput.Init;
begin
   c:='';
   Label1.caption:='';
end;

initialization


end.

