KEYENCE KV COM+ I/O チェッカー (2019/03/13, 24)

2019/03/24 Android アプリで手動操作のときのブザー音を追加
2019/03/13 初版作成

 現場での I/O チェックに特化したツールです。KEYENCE KV COM+ を使っています。
 パソコンでの単体使用のほか、パソコンに内蔵の Bluetooth 経由で Android スマホからでも利用可能です。
 パソコン <-> KV 間の通信は、KV COM + で行い、250 msec 周期でポーリングを行い、先頭アドレスから 160 点のビットデータを記憶します。
 Android へは、Bluetooth でそのデータを転送しています。このため、Android 単体での使用はできません。
 「KV STUDIO」 との併用も可能です。

 ・状態変化のあった最後のデバイスの ON/OFF を表示。音声合成で読み上げ。
 ・操作可能なデバイスの ON/OFF 反転。
 ・あらかじめコメントファイルを作成しておくことで、たコメントの表示、音声合成で読み上げ。
 以上のことが、パソコン、Android 端末で利用可能です。

 使用するには
  ・パソコンに KV COM+ library、 または KV COM+ for EXCEL のインストールが必要です。
   こちらで使用しているバージョンは、Ver.1.35 です。初期のバージョンでは使えない可能性があります。
   KV COM+ for EXCEL の60分体験版でも使用可能と思いますが、検証はしていません。

  Android の場合、上記に加えて、
  ・内蔵または外付けの Bluetooth で、「Bluetoothデバイスの追加」、「Bluetooth 経由のシリアルポート」の追加が必要です。
  ※仮想シリアルポートの追加は 「Bluetooth の設定」 から行えます。
  ・使用前に一度だけペアリングが必要です。

 使い方
  ・下のスクリーンショットの2つのコンボボックスを設定。
  左側:「Bluetooth 経由のシリアルポート」の COM ポート番号を選択。
  右側:通信先の KV のシリーズ名を選択(すべて USB 接続です)
 ・[OPEN] ボタンをクリックすると、KVと繋がりポーリングを開始します。
 ・デバイスの先頭番号の変更は、[+10000], [-10000], [+1000], [-1000] ボタンで行います。
 ・手動操作の対象デバイスは、[+100], [-100], [+1], [-1] ボタンで行い、[ 反転 ] ボタンで ON/OFF が反転します。
  グリッドの対象セルをクリックしても、手動操作対象のデバイス番号が変わります。
  モニタ中の160点以外のデバイスでも指定可能です。
 ※割りつけられている入力デバイスは、ON/OFF できません。
 ・音声、コメントのチェックボックスは、音声合成読み上げ用です。
  (Windows 8.1/ 10 では、音声合成が利用可能でした。)
  ※音声が終わるまで、次の処理ができませんので、作業効率が悪くなります。


 

 Android 側の使い方
 ・あらかじめ、パソコンと Android 端末をペアリングしておいてください。
 ・パソコン側のアプリで、KV と通信中にしておいてください。
 ・始めて起動すると、接続に失敗します。
  ↓のスクリーンショットで、一番うえのコンボボックスから接続先のパソコンを選択して、[保存]ボタンをタップし、終了します。
  2回目以降は、設定したパソコン名が見つかると、それに接続されます。
 ・接続に失敗する場合は、一度終了し、パソコン側で [CLOSE] -> [OPEN] 後、実行してください。
 ・右上のスイッチは、音声合成読み上げ用です。

 
 
■著作権、免責事項等
 本ツールはフリーウェア扱いですが、著作権は作者 f.izawa が所有し、これを主張します。
 本ツールをインストール、使用したことによる事故、損害等の一切について、作者はその責を負いません。

■作者連絡先
 ・e-mail : f.izawa@dream.com (@を小文字に変えて下さい)
 ・URL : http://www.izawa-web.com/

■開発、動作確認環境
 ・Windows 10 64bit / Delphi 10.2.3 Community Edition
 ・Keyence KV-5000, KV-N14 他

■ダウンロード
  ・KvCom_IO.zip Windows用EXE 本体のみ 2019/03/13
  ・KVCOM_IO.apk Android 用 APK 本体のみ 2019/03/24(手動操作時のブザー音追加版)


// ----------------------
// Windows側
// ----------------------

unit KvComPlusUnit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls,
  DATABUILDERAXLibEx_TLB, Vcl.OleServer, Vcl.Buttons,
  Vcl.Grids, Vcl.ExtCtrls, OoMisc, AdPort, AdSelCom, AdPacket, IniFiles,
  Vcl.ComCtrls, Vcl.ExtDlgs, System.UITypes, ClipBrd,
  SpeechLib_TLB, ComObj;
type

  TWordAry = array [0.. 9] of Word;
  TBoolAry = array [0.. 159] of boolean;
type
  TForm4 = class(TForm)
    DBCommManager1: TDBCommManager;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Timer1: TTimer;
    ApdComPort1: TApdComPort;
    ApdDataPacket1: TApdDataPacket;
    Label1: TLabel;
    Edit1: TEdit;
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    ComboBox1: TComboBox;
    Button2: TButton;
    Button3: TButton;
    ComboBox2: TComboBox;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Button4: TButton;
    OpenTextFileDialog1: TOpenTextFileDialog;
    Edit5: TEdit;
    Button5: TButton;
    SaveTextFileDialog1: TSaveTextFileDialog;
    Button6: TButton;
    Edit6: TEdit;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label5: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
    procedure Edit1Change(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure StringGrid2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button6Click(Sender: TObject);
    procedure Edit7Change(Sender: TObject);
    procedure Edit8Change(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    GB_SgTextScale : double;
    GB_SgWidthScale : double;

    procedure ReadCommentFile(const FileName : TFileName);
    procedure SaveCommentFile(const FileName : TFileName);
    function GetDeviceComment(const devStr : string): string;
  end;

var
  Form4: TForm4;
  WordAryNew : TWordAry;
  WordAryOld : TWordAry;

  BoolAryNew : TBoolAry;
  BoolAryOld : TBoolAry;

  SpVoice: OleVariant;
  TTSFlag : boolean;

const
  DEV_RLY_B = $00;
  DEV_RLY_W = $19;
  DEV_CR_W  = $64;
  DEV_CR    = $0A;

implementation

{$R *.dfm}

uses KvComPlusUnit5;

// n の k 乗 (Math ユニット不要)
function IntPower(n, k : integer):integer;
var
  i : integer;
begin
  result := 1;
  for i := 1 to k do result := result * n;
end;

// *****************************
// StringGrid でのキー操作
// *****************************
procedure SgKeyDown(SG: TSTringGrid; var Key: Word; Shift: TShiftState);
var
  i, j, k, n : integer;
  sl : TStringList;
  s, s1 : string;
  xflag : boolean;
begin
  if Key = VK_DELETE then begin
    with SG do begin
      if (Selection.Top <> Selection.Bottom) or
         (Selection.Left <> Selection.Right) then begin
        Key := 0;
        for i := Selection.Top to Selection.Bottom do
          for j := Selection.Left to Selection.Right do
            Cells[j, i] := '';
      end;
    end;
  end;
  if ssCtrl in Shift then begin
    if true then begin
      xflag := (Key = Ord('X')) or (Key = Ord('x'));
      if (Key = Ord('C')) or (Key = Ord('c')) or xflag then begin
        Key := 0;
        Clipboard.AsText := '';
        with SG do begin
          for i := Selection.Top to Selection.Bottom do begin
            for j := Selection.Left to Selection.Right do begin
              Clipboard.AsText := Clipboard.AsText + Cells[j, i];
              if j < Selection.Right then
                Clipboard.AsText := Clipboard.AsText + #9
              else Clipboard.AsText :=
                Clipboard.AsText + #13#10;
            end;
          end;
          if xflag then begin
            for i := Selection.Top to Selection.Bottom do
              for j := Selection.Left to Selection.Right do
                Cells[j, i] := '';
          end;
        end;
      end
      else if (Key = Ord('V')) or (Key = Ord('v')) then begin
        //with SG do
        //  if EditorMode then EditorMode := false;
        Key := 0;
        with SG do begin
          sl := TStringList.Create;
          try
            s := Clipboard.AsText;
            while true do begin
              k := Pos(#13#10, s);
              if k = 0 then break
              else begin
                sl.Add(Copy(s, 1, k - 1));
                Delete(s, 1, k + 1);
              end;
            end;
            for i := 0 to sl.Count-1 do begin
              s := SL[i];
              j := 0;
              while true do begin
                k := Pos(#9, s);
                if k = 0 then
                  s1 := Copy(s, 1, Length(s))
                else begin
                  s1 := Copy(s, 1, k - 1);
                  Delete(s, 1, k);
                end;
                Cells[Selection.Left + j, Selection.Top + i] := s1;
                n := 1;
                while true do begin
                  if Selection.Bottom < Selection.Top + i + (sl.Count * n) then
                    break
                  else
                    Cells[Selection.Left + j, Selection.Top + i + (sl.Count * n)] := s1;
                  Inc(n);
                end;
                if k = 0 then break;
                Inc(j);
              end;
            end;
          finally
            sl.Free;
          end;
        end;
      end;
    end;
  end;
end;
// --------------------------------------------

function NumToSpeechText(const hex : string): string;
var
  i : integer;
  s : string;
begin
  result := '';
  for i := 1 to hex.Length do begin
    s := Copy(hex, i, 1);
    if s = '0' then result := result + 'ゼロ'
    else if s = '1' then result := result + 'イチ'
    else if s = '2' then result := result + 'ニイ'
    else if s = '3' then result := result + 'サン'
    else if s = '4' then result := result + 'ヨン'
    else if s = '5' then result := result + 'ゴオ'
    else if s = '6' then result := result + 'ロク'
    else if s = '7' then result := result + 'ナナ'
    else if s = '8' then result := result + 'ハチ'
    else if s = '9' then result := result + 'キュウ'

    else if s = 'A' then result := result + 'エイ'
    else if s = 'B' then result := result + 'ビイ'
    else if s = 'C' then result := result + 'シイ'
    else if s = 'D' then result := result + 'デー'
    else if s = 'E' then result := result + 'イイ'
    else if s = 'F' then result := result + 'エフ'
    else result := result + s;
    result := result + ' ';
  end;
end;

procedure TForm4.ReadCommentFile(const FileName : TFileName);
// コメントファイル読み込み

var
  sl : TStringList;
  cnt : integer;
  i, n : integer;
  s, s1, s2 :string;

begin
  cnt := 0;
  sl := TStringList.Create;
  try
    sl.LoadFromFile(FileName);
    for i := 0 to sl.Count - 1 do begin
      n := Pos(',', sl[i]);

      s1 := Copy(sl[i], 1, n- 1);
      s2 := Copy(sl[i], n + 1);
      s := Uppercase(Copy(s1, 1, 1));
      with StringGrid2 do begin
        Inc(cnt);
        if RowCount <= cnt then
          RowCount := RowCount + 1;
        Cells[0, cnt] := s1;
        Cells[1, cnt] := s2;
      end;
    end;
  finally
    sl.Free;
  end;
  with StringGrid2 do begin
    if cnt > 0 then begin
      if cnt < RowCount then
        RowCount := cnt;
    end
    else begin
      RowCount := 2;
      Cells[0, 1] := '';
      Cells[1, 1] := '';
    end;
  end;
end;

procedure TForm4.SaveCommentFile(const FileName : TFileName);
// コメントファイル保存
var
  sl : TStringList;
  i : integer;
begin
  sl := TStringList.Create;
  try
    with StringGrid2 do begin
      for i := 1 to RowCount -1 do
        sl.Add(Cells[0, i] + ',' + Cells[1, i]);
    end;
    sl.SaveToFile(FileName);
  finally
    sl.Free;
  end;
end;

function TForm4.GetDeviceComment(const devStr : string): string;
// Gdid2 からコメントを取得
var
  i, n : integer;
  s : string;
begin
  result := '';
  n := StrToIntDef(devStr, 0);
  with StringGrid2 do begin
    for i := 1 to RowCount - 1 do begin
      s := Cells[0, i];
      if (s <> '') and (n = StrToIntDef(s, 0)) then begin
        result := Cells[1, i];
        break;
      end;
    end;
  end;
end;
procedure TForm4.ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
// スマホ Bluetooth から受信
var
  cmd, s, res : string;
  i, ret, ret1 : integer;
begin
  cmd := Trim(string(Data));
  Label5.Caption := cmd;
  if cmd = 'CPU' then begin
    res := ComboBox1.Text;
    ApdComPort1.PutString(res + #13#10);
  end
  else if cmd = 'RD' then begin
    res := '';
    // 今回値
    for i := 0 to 9 do
      res := res + WordAryNew[i].ToHexString(4);
    // 前回値
    for i := 0 to 9 do
      res := res + WordAryOld[i].ToHexString(4);
    // 先頭番号
    res := res + ' ' + Edit1.Text;
    // コメント
    // 表示中のアドレス
    if Edit2.Text <> '' then begin
      s := GetDeviceComment(Edit2.Text);
      if s <> '' then res := res + ' ' + s;
    end;
    ApdComPort1.PutString(res + #13#10);
    //Caption := res;
    // 前回値を更新
    WordAryOld := WordAryNew;
  end
  else if Pos('WR ', cmd) = 1 then begin
    s := Copy(cmd, 4);
    ret := DBCommManager1.ReadDevice(DEV_RLY_B, s);
    DBCommManager1.WriteDevice(DEV_RLY_B, s, abs(ret - 1));
    ret1 := DBCommManager1.ReadDevice(DEV_RLY_B, s);
    if ret1 = 1 then res := 'ON'
    else res := 'OFF';
    ApdComPort1.PutString(res + #13#10);
  end
  else if Pos('CF ', cmd) = 1 then begin
    Edit1.Text := Copy(cmd, 4);
    ApdComPort1.PutString('OK' + #13#10);
  end
  else
    ApdComPort1.PutString('??' + #13#10);
end;

procedure TForm4.Button1Click(Sender: TObject);
// 手動反転操作
var
  ret, idx, ans : integer;
  s : string;
begin
  try
    if DBCommManager1.Active then begin
      idx := StrToIntDef(Edit4.Text, 0);
      ret := DBCommManager1.ReadDevice(DEV_RLY_B, idx.Tostring);
      DBCommManager1.WriteDevice(DEV_RLY_B, idx.Tostring, abs(ret - 1));
      ans := DBCommManager1.ReadDevice(DEV_RLY_B, idx.Tostring);
      if ret = ans then
        Edit4.Font.Color := clYellow
      else if ans = 1 then
        Edit4.Font.Color := clRed
      else
        Edit4.Font.Color := clLime;
    end;
  except
    on E: Exception do begin
      s := E.ClassName + sLineBreak + E.Message;
      Application.MessageBox(PChar(s), '情報', MB_ICONINFORMATION);
    end;
  end;
end;

procedure TForm4.Button2Click(Sender: TObject);
// 接続
var
  plcType : integer;
  s : string;
begin
  with ApdComPort1 do begin
    s := Copy(ComboBox2.Text, 4);
    s := Copy(s, 1, Length(s) -1);
    ComNumber := StrToIntDef(s, 4);
    Baud := 9600;
    StopBits := 1;
    DataBits := 8;
    Parity := TParity.pNone;
    SWFlowOptions := TSWFlowOptions.swfNone;
  end;
  with  ApdDataPacket1 do begin
    Enabled := False;
    EndCond := [ecString];
    EndString := #13#10;
    StartCond := scAnyData;
    TimeOut := 500;
  end;
  try
    ApdComPort1.Open := True;
    if  ApdComPort1.Open then begin
      ApdDataPacket1.Enabled := True;
      ComboBox2.Enabled := False;
    end;
  except
    ShowMessage('ComPort Open Error');
  end;
  // KV Com +
  plcType := -1;
  with ComboBox1 do begin
    if ItemIndex >= 0 then
      plcType := Integer(Items.Objects[ItemIndex]);
  end;
  if plcType >= 0 then begin
    DBCommManager1.Peer := 'USB';
    DBCommManager1.PLC := plcType;
    try
      // 接続
      DBCommManager1.Connect;
      ComboBox1.Enabled := not DBCommManager1.Active;
      Timer1.Enabled := DBCommManager1.Active;
    except
      on E: Exception do begin
        s := E.ClassName + sLineBreak + E.Message;
        Application.MessageBox(PChar(s), '情報', MB_ICONINFORMATION);
      end;
    end;
  end;
end;

procedure TForm4.Button3Click(Sender: TObject);
// 切断
begin
  // KV Com + 切断
  if DBCommManager1.Active then begin
    DBCommManager1.Disconnect;
    ComboBox1.Enabled := not DBCommManager1.Active;
  end;
  // Bluetooth SPP 通信(仮想 COM ポート)切断
  if  ApdComPort1.Open then begin
    ApdComPort1.Open := False;
    ComboBox2.Enabled := True;
  end;
end;

procedure TForm4.Button4Click(Sender: TObject);
// コメントファイル読み込み
begin
  OpenTextFileDialog1.InitialDir := ExtractFileDir(Edit5.Text);
  if OpenTextFileDialog1.Execute then begin
    Edit5.Text := OpenTextFileDialog1.FileName;
    ReadCommentFile(Edit5.Text);
  end;
end;

procedure TForm4.Button5Click(Sender: TObject);
// コメントファイル保存
var
  fname : TFileName;
  flag : boolean;
begin
  if (StringGrid2.Cells[0, 1] <> '') then begin
    SaveTextFileDialog1.InitialDir := ExtractFileDir(Edit5.Text);
    if SaveTextFileDialog1.Execute then begin
      fname := SaveTextFileDialog1.FileName;
      if ExtractFileExt(fname) = '' then fname := fname + '.csv';
      flag := True;
      if FileExists(fname) then
        flag := MessageDlg('すでにファイルが存在します.上書きしますか?', mtInformation, [mbYes, mbNo], 0) = mrYes;
      if flag then begin
        SaveCommentFile(fname);
        Edit5.Text := fname;
      end;
    end;
  end;
end;

procedure TForm4.Button6Click(Sender: TObject);
// コメント用デバイス番号作成
var
  ret, st, ed, i, j, cnt : integer;
begin
  with Form5 do begin
    ret := ShowModal;
    if ret <> mrCancel then begin
      st := StrToInt(Edit1.Text);
      ed := StrToInt(Edit2.Text);
      cnt := 0;
      with Form4.StringGrid2 do begin
        RowCount := ((ed - st) div 100 + 1)  * 16 + 1;
        for i := st div 100  to ed div 100 do begin
          for j := 0 to 15 do begin
            Cells[0, cnt + 1] := Format('%.4d', [i * 100 + j]);
            Inc(cnt);
          end;
        end;
      end;
      if ret = mrYes then begin
        st := StrToInt(Edit3.Text);
        ed := StrToInt(Edit4.Text);
        with Form4.StringGrid2 do begin
          RowCount := RowCount + ((ed - st) div 100 + 1)  * 16;
          for i := st div 100  to ed div 100 do begin
            for j := 0 to 15 do begin
              Cells[0, cnt + 1] := Format('%.4d', [i * 100 + j]);
              Inc(cnt);
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure TForm4.Edit1Change(Sender: TObject);
// 先頭アドレス変更された
var
  i, idx : integer;
begin
  idx := StrToIntDef(Edit1.Text, 0);

  with StringGrid1 do begin
    for i := 0 to 9 do
      Cells[0, i +1] := Format('%.4d', [idx + i*100]);
  end;
  // 初期化
  for i := 0 to 9 do WordAryNew[i] := 0;
  WordAryOld := WordAryNew;
  for i := 0 to 159 do BoolAryNew[i] := False;
  BoolAryOld := BoolAryNew;
  Edit2.Text := '';
  Edit3.Text := '';
end;

procedure TForm4.Edit7Change(Sender: TObject);
// Grid1 文字サイズの調整
begin
  GB_SgTextScale := StrToFloatDef(Edit7.Text, 2.0);
  StringGrid1.Repaint;
end;

procedure TForm4.Edit8Change(Sender: TObject);
// Grid2 列幅の調整
begin
  GB_SgWidthScale := StrToFloatDef(Edit8.Text, 1.0);
  StringGrid2.ColWidths[1] := Trunc(250 * GB_SgWidthScale);
  StringGrid2.Repaint;
end;

procedure TForm4.FormCreate(Sender: TObject);
// フォーム生成
var
  i : integer;
  ini : TIniFile;
begin
  GB_SgTextScale := 2.0;
  GB_SgWidthScale := 2.0;
  Edit5.Text := '';
  Edit6.Text := '';
  Label2.Caption := '';
  Label5.Caption := '';
  AdSelCom.ShowPortsInUse := False;
  for i := 0 to 32 do
    if AdSelCom.IsPortAvailable(i) then
      ComboBox2.Items.Add (AdPort.ComName(i) + '.');

  with ComboBox1 do begin
    Items.AddObject('KV-7000', TObject(StrToInt('$020D')));
    Items.AddObject('KV-7000 <XYM>', TObject(StrToInt('$120D')));
    Items.AddObject('KV-5500/ 5000/ 3000', TObject(StrToInt('$0203')));
    Items.AddObject('KV-5500/ 5000/ 3000 <XYM>', TObject(StrToInt('$1203')));
    Items.AddObject('KV-1000/ 700', TObject(StrToInt('$0007')));
    Items.AddObject('KV-1000 <XYM>', TObject(StrToInt('$1007')));
    Items.AddObject('KV Nano [KV-N*]', TObject(StrToInt('$0208')));
    Items.AddObject('KV Nano [KV-N*] <XYM>', TObject(StrToInt('$1208')));
  end;
  with StringGrid1 do begin
    Cells[0, 0] := 'R';
    for i := 0 to 15 do
      Cells[i +1, 0] := i.ToString;
    for i := 0 to 9 do
      Cells[0, i +1] := Format('%.4d', [i*100]);
  end;
  with StringGrid2 do begin
    ColWidths[1] := Trunc(250 * GB_SgWidthScale);
    Cells[0, 0] := ' デバイス';
    Cells[1, 0] := ' コメント';
  end;
  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    i := ini.ReadInteger('COM', 'PortIndex', 0);
    if ComboBox2.Items.Count > i then  ComboBox2.ItemIndex := i;
    i := ini.ReadInteger('KVCOM', 'PLCIndex', 0);
    if ComboBox1.Items.Count > i then  ComboBox1.ItemIndex := i;
    Edit5.Text := ini.ReadString('Comment', 'FileName', '');
    Edit7.Text := ini.ReadString('Grid', 'TextScale', GB_SgTextScale.ToString);
    Edit8.Text := ini.ReadString('Grid', 'WidthScale', GB_SgWidthScale.ToString);
  finally
    ini.Free;
  end;
  TTSFlag := False;
  try
    SpVoice := CreateOleObject('SAPI.SpVoice');
    TTSFlag := True;
    CheckBox1.Enabled := True;
    CheckBox2.Enabled := True;
  except
    ;
  end;
end;

procedure TForm4.FormDestroy(Sender: TObject);
// フォーム破棄
var
  ini: TIniFile;
begin
  if DBCommManager1.Active then DBCommManager1.Disconnect;
  if ApdComPort1.Open then ApdComPort1.Open := False;
  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    ini.WriteInteger('COM', 'PortIndex', ComboBox2.ItemIndex);
    ini.WriteInteger('KVCOM', 'PLCIndex', ComboBox1.ItemIndex);
    ini.WriteString('Comment', 'FileName', Edit5.Text);
    ini.WriteString('Grid', 'TextScale', Edit7.Text);
    ini.WriteString('Grid', 'WidthScale', Edit8.Text);
  finally
    ini.Free;
  end;
end;

procedure TForm4.FormShow(Sender: TObject);
begin
  if (Edit5.Text <> '') and FileExists(Edit5.Text) then begin
    if MessageDlg(
      '前回終了時のコメントファイル' + #13 +
         Edit5.Text + #13 + 'を、読み込みますか?',
         mtInformation, [mbYes, mbNo], 0) = mrYes then
       ReadCommentFile(Edit5.Text)
    else if MessageDlg(
      '前回終了時のコメントファイル名' + #13 +
         Edit5.Text + #13 + 'を、削除しますか?',
         mtInformation, [mbYes, mbNo], 0) = mrYes then
      Edit5.Text := '';
  end;
end;

procedure TForm4.SpeedButton1Click(Sender: TObject);
// 先頭アドレス +10000, +1000
var
  idx : integer;
begin
  idx := StrToIntDef(Edit1.Text, 0);
  if Sender as TSpeedButton = SpeedButton1 then
    idx := idx + 1000
  else
    idx := idx + 10000;
  if idx > 59000 then idx := 59000;
  Edit1.Text := Format('%.4d', [idx]);
end;

procedure TForm4.SpeedButton3Click(Sender: TObject);
// 先頭アドレス -10000, -1000
var
  idx : integer;
begin
  idx := StrToIntDef(Edit1.Text, 0);
  if Sender as TSpeedButton = SpeedButton3 then
    idx := idx - 1000
  else
    idx := idx - 10000;
  if idx < 0 then idx := 0;
  Edit1.Text := Format('%.4d', [idx]);
end;

procedure TForm4.SpeedButton7Click(Sender: TObject);
// 反転対象 + 100, +1
var
  idx : integer;
  dv, md : integer;
begin
  idx := StrToIntDef(Edit4.Text, 0);
  dv := idx div 100;
  md := idx mod 100;
  if Sender as TSpeedButton = SpeedButton7 then begin
    Inc(dv);
    if dv > 599 then dv := 599;
  end
  else begin
    Inc(md);
    if md > 15 then begin
      Inc(dv);
      if dv > 599 then begin
        dv := 599;
        md := 15;
      end
      else begin
        md := 0;
      end;
    end;
  end;
  Edit4.Text := Format('%.4d', [dv * 100 + md]);
  Edit4.Font.Color := clWhite;
end;

procedure TForm4.SpeedButton8Click(Sender: TObject);
// 反転対象 -100, -1
var
  idx : integer;
  dv, md : integer;
begin
  idx := StrToIntDef(Edit4.Text, 0);
  dv := idx div 100;
  md := idx mod 100;
  if Sender as TSpeedButton = SpeedButton8 then begin
    Dec(dv);
    if dv < 0 then dv := 0;
  end
  else begin
    Dec(md);
    if (md < 0) and (dv > 0) then begin
      md := 15;
      Dec(dv);
      if dv < 0 then begin
        dv := 0;
        md := 0;
      end;
    end;
  end;
  if dv < 0 then dv := 0;
  if md < 0 then md := 0;

  Edit4.Text := Format('%.4d', [dv * 100 + md]);
  Edit4.Font.Color := clWhite;
end;

procedure TForm4.StringGrid1Click(Sender: TObject);
// 手動反転操作の対象を変える
var
  idx : integer;
begin
  idx := StrToIntDef(Edit1.Text, 0);
  with StringGrid1 do
    Edit4.Text := Format('%.4d', [idx + (Row - 1) * 100 + Col -1]);
  Edit4.Font.Color := clWhite;
end;

procedure TForm4.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
// Grid 描画
var
  ARect : TRect;
  s : string;
  scale : double;
  flag : boolean;
  n : integer;
  idx : integer;
begin
  flag := False;
  scale := GB_SgTextScale;
  ARect := Rect;
  ARect.Top := Rect.Top + 1;
  ARect.Bottom := Rect.Bottom - 1;
  ARect.Left := Rect.Left + 1;
  ARect.Right := Rect.Right - 1;

  with StringGrid1 do begin
    s := Cells[ACol, ARow];
    if (ARow = 0) or (ACol = 0) then begin
      if (ARow = 0) and (ACol = 0) then begin
        Canvas.Brush.Color := clLime;
        Canvas.FillRect(Rect);
        Canvas.Font.Height := Trunc(20 * scale);
        Canvas.Font.Color := clBlack;
      end
      else begin
        Canvas.Brush.Color := clSilver;
        Canvas.FillRect(Rect);
        Canvas.Font.Height := Trunc(20 * scale);
        Canvas.Font.Color := clGray;
      end;
      DrawText(Canvas.Handle, PChar(s), Length(s), ARect, DT_CENTER);
    end
    else begin
      if (Edit3.Text = 'ON') or (Edit3.Text = 'OFF') then begin
        idx := StrToIntDef(Edit1.Text, 0);
        n := StrToIntDef(Edit2.Text, -1);
        if n >= idx then begin
          n := n - idx;
          if (ARow = n div 100 + 1) and (ACol = n mod 100 + 1) then begin
            flag := True;
            if Edit3.Text = 'ON' then begin
              Canvas.Brush.Color := clRed;
              Canvas.FillRect(ARect);
              Canvas.Font.Height := Trunc(20 * scale);
              Canvas.Font.Color := clWhite;
            end
            else begin
              Canvas.Brush.Color := clLime;
              Canvas.FillRect(ARect);
              Canvas.Font.Height := Trunc(20 * scale);
              Canvas.Font.Color := clBlack;
              s := Edit2.Text;
            end;
          end;
        end;
      end;
      if not flag and (s <> '') then begin
        Canvas.Brush.Color := RGB($FF, $A5, $00);
        Canvas.FillRect(ARect);
        Canvas.Font.Height := Trunc(20 * scale);
        Canvas.Font.Color := clWhite;
      end;
      if s <> '' then
        DrawText(Canvas.Handle, PChar(s), Length(s), ARect, DT_CENTER);
    end;
  end;
end;

procedure TForm4.StringGrid2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
// コメント編集でのキー操作
begin
  SgKeyDown(StringGrid2, Key, Shift);
end;

procedure TForm4.Timer1Timer(Sender: TObject);
// ポーリング
var
  i, idx : integer;
  j: Integer;
  s , devNo : string;
  SpeechFlag : boolean;
begin
  SpeechFlag := False;
  Timer1.Enabled := False;
  try
    if DBCommManager1.Active then begin
      idx := StrToIntDef(Edit1.Text, 0);
      for i := 0 to 9 do
        WordAryNew[i] := DBCommManager1.ReadDevice(DEV_RLY_W, Format('%.4d', [idx + i * 100]));
      // 内部データに
      for i := 0 to 9 do begin
        for j := 0 to 15 do
          BoolAryNew[i * 16 + j] := WordAryNew[i] and IntPower(2, j) > 0;
      end;
      // 比較
      for i := 0 to 159 do begin
        devNo := Format('%.4d', [idx + (i div 16) * 100 + i mod 16]);
        // OFF -> ON
        if not BoolAryOld[i] and BoolAryNew[i] then begin
          Edit2.Text := devNo;
          Edit3.Text := 'ON';
          Edit2.Font.Color := clRed;
          Edit3.Font.Color := clRed;
          Edit6.Text := GetDeviceComment(devNo);
          SpeechFlag := True;
        end
        // ON -> OFF
        else if BoolAryOld[i] and not BoolAryNew[i] then begin
          Edit2.Text := devNo;
          Edit3.Text := 'OFF';
          Edit2.Font.Color := clLime;
          Edit3.Font.Color := clLime;
          Edit6.Text := GetDeviceComment(devNo);
          SpeechFlag := True;
        end
        else begin
          with StringGrid1 do begin
            if BoolAryNew[i] then
              Cells[i mod 16 +1, i div 16 +1] := devNo
            else
              Cells[i mod 16 +1, i div 16 +1] := '';
          end;
        end;
      end;
      // 前回値を更新
      BoolAryOld := BoolAryNew;
      if Label2.Caption = '' then Label2.Caption := '■'
      else Label2.Caption := '';
      // テキストスピーチ
      if CheckBox1.Checked and SpeechFlag and TTSFlag then begin
        Repaint;
        StringGrid1.Repaint;
        Application.ProcessMessages;

        s := NumToSpeechText(Edit2.Text);
        if CheckBox2.Checked then s := s + Edit6.Text + #13;
        if Edit3.Text = 'ON' then s := s + '、オオン'
        else s := s + '、オフ';
        SpVoice.Speak(s, SVSFDefault);
      end;
    end;
    Timer1.Enabled := True;
  except
    on E: Exception do begin
      s := E.ClassName + sLineBreak + E.Message;
      Application.MessageBox(PChar(s), '情報', MB_ICONINFORMATION);
    end;
  end;
end;

end.

// ------------------
// Android 側
// ------------------
// Android 側
// 2019/02/17 FX5U にてテスト
// 2019/02/20 PC 名のコンボボックスを追加

unit Unit4;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Bluetooth, System.Bluetooth.Components, FMX.ScrollBox, FMX.Memo,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.Edit, System.Rtti,
  FMX.Grid.Style, FMX.Grid,{ Math,} FMX.Objects, System.UIConsts, FMX.ListBox,
  System.IOUtils, System.IniFiles,
  // for TTS
  Androidapi.JNI.TTS,AndroidAPI.JNIBridge;
type
  TBitAry = array [0..159] of Boolean;
type
  TBtThread = class(TThread)
  private
    { Private 宣言 }
    procedure BtOpen;

  protected
    procedure Execute; override;
  public
    constructor Create; virtual;
  end;
type
  TForm4 = class(TForm)
    ScaledLayout1: TScaledLayout;
    Bluetooth1: TBluetooth;
    Button6: TButton;
    Timer1: TTimer;
    StringGrid1: TStringGrid;
    StringColumn1: TStringColumn;
    StringColumn2: TStringColumn;
    StringColumn3: TStringColumn;
    StringColumn4: TStringColumn;
    StringColumn5: TStringColumn;
    StringColumn6: TStringColumn;
    StringColumn7: TStringColumn;
    StringColumn8: TStringColumn;
    StringColumn9: TStringColumn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Rectangle1: TRectangle;
    Label4: TLabel;
    Label5: TLabel;
    Rectangle2: TRectangle;
    Rectangle3: TRectangle;
    Rectangle4: TRectangle;
    Rectangle5: TRectangle;
    Label7: TLabel;
    StringColumn10: TStringColumn;
    StringColumn11: TStringColumn;
    StringColumn12: TStringColumn;
    StringColumn13: TStringColumn;
    StringColumn14: TStringColumn;
    StringColumn15: TStringColumn;
    StringColumn16: TStringColumn;
    StringColumn17: TStringColumn;
    Label11: TLabel;
    Rectangle9: TRectangle;
    ComboBox3: TComboBox;
    Button2: TButton;
    Switch1: TSwitch;
    Rectangle6: TRectangle;
    Label8: TLabel;
    Rectangle7: TRectangle;
    Label9: TLabel;
    Rectangle8: TRectangle;
    Label6: TLabel;
    Rectangle10: TRectangle;
    Label10: TLabel;
    Rectangle11: TRectangle;
    Label12: TLabel;
    Label13: TLabel;
    procedure Button6Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Rectangle1Click(Sender: TObject);
    procedure Rectangle2Click(Sender: TObject);
    procedure StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas;
      const Column: TColumn; const Bounds: TRectF; const Row: Integer;
      const Value: TValue; const State: TGridDrawStates);
    procedure StringGrid1DrawColumnHeader(Sender: TObject;
      const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF);
    procedure StringGrid1CellClick(const Column: TColumn; const Row: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Rectangle7Click(Sender: TObject);
    procedure Rectangle10Click(Sender: TObject);
   // TTS
    type
      TttsOnInitListener = class(TJavaLocal, JTextToSpeech_OnInitListener)
      private
        [weak] FParent : TForm4;
      public
        constructor Create(AParent : TForm4);
        procedure onInit(status: Integer); cdecl;
      end;
  private
    { private 宣言 }
    ttsListener : TttsOnInitListener;
    tts : JTextToSpeech;
    procedure SpeakOut(const s :string);
    procedure InitTTS;
  public
    { public 宣言 }
    BitAryOld : TBitAry;
    BitAryNew : TBitAry;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure SendDeviceStartIndex;
  end;

var
  Form4: TForm4;

  ADevice : TBluetoothDevice;
  ASocket : TBluetoothSocket;

  GThdMode : integer;
  GCmdMode : integer;

  ThBt : TBtThread;
  OpenNGcnt : integer;
  OpenMsecCnt : integer;
  Counter : integer;
  BtDeviceHead : string;

const
  // SPP(Serial Port Profile) による通信のUUID
  ServiceUUID = '{00001101-0000-1000-8000-00805F9B34FB}';

  thdTHSTART   = 1000;
  thdTHTERM    = 2000;
  cmdSCCREATE  = 200;
  cmdSCCONNECT = 201;
  cmdSCNG = 202;

implementation

uses Androidapi.JNI.JavaTypes, FMX.Helpers.Android
{$IF CompilerVersion >= 27.0}
, Androidapi.Helpers
{$ENDIF}
;

{$R *.fmx}

// n の k 乗 (Math ユニット不要)
function IntPower(n, k : integer):integer;
var
  i : integer;
begin
  result := 1;
  for i := 1 to k do result := result * n;
end;

// -----------------------------------------------------------------------------
// Bluetooth を Open し、接続する
procedure TBtThread.BtOpen;
var
  ABluetoothManager : TBluetoothManager;
  APairedDevices : TBluetoothDeviceList;
  ADevice : TBluetoothDevice;
  idx, i : integer;
begin
  GThdMODE := thdTHSTART;
  try
    try
      ABluetoothManager := TBluetoothManager.Current;
      if ABluetoothManager.ConnectionState = TBluetoothConnectionState.Connected then begin
        // 過去にペアリングされたデバイスの一覧から、ターゲット を探す
        APairedDevices := ABluetoothManager.GetPairedDevices;
        if APairedDevices.Count > 0 then begin
          idx := -1;
          for i := 0 to APairedDevices.Count -1 do begin
            Synchronize(procedure() begin
                with Form4.ComboBox3 do begin
                  BeginUpdate;
                  Items.Add(APairedDevices[i].DeviceName );
                  EndUpdate;
                end;
            end);
            if (BTDeviceHead = APairedDevices[i].DeviceName) then begin
              Synchronize(procedure() begin
                  with Form4.ComboBox3 do begin
                    ItemIndex := i;
                  end;
              end);
              idx := i;
              //break;  // リストアップを続ける
            end;
          end;
          if idx >= 0 then begin
            ADevice := APairedDevices[idx];
            if ADevice <> nil then begin
              ASocket := ADevice.CreateClientSocket(StringToGUID(ServiceUUID), False);
              if ASocket <> nil then begin
                GCMDMODE := cmdSCCREATE;
                // 接続
                ASocket.Connect;
                if ASocket.Connected then GCMDMODE := cmdSCCONNECT;
              end;
            end;
          end;
        end;
      end;
    except
      on E : Exception do begin
        GCMDMODE := cmdSCNG;
      end;
    end;
  finally
    // 明示的にスレッドを終了(破棄される)
    // スレッド実行中にアプリを終了した時エラーになるため
    Terminate;
    WaitFor;
    FreeAndNil(ThBt);
    GThdMODE := thdTHTERM;
  end;
end;

constructor TBtThread.Create;
begin
  // スレッドを生成、直ちに実行
  inherited Create(False);
  // スレッド終了時、スレッドオブジェクトを破棄
  FreeOnTerminate := True;
end;

procedure TBtThread.Execute;
begin
  BtOpen;
end;

// -----------------------------------------------------------------------------
procedure TForm4.InitTTS;
begin
  tts := TJTextToSpeech.JavaClass.init(TAndroidHelper.Context, ttsListener);
end;
procedure TForm4.SpeakOut(const s : string);
var
  text : JString;
begin
  text := StringToJString(s);
  tts.speak(text, TJTextToSpeech.JavaClass.QUEUE_FLUSH, nil);
end;

{ TForm4.TttsOnInitListener }
constructor TForm4.TttsOnInitListener.Create(AParent: TForm4);
begin
  inherited Create;
  FParent := AParent
end;

procedure TForm4.TttsOnInitListener.onInit(status: Integer);
var
  Result : Integer;
begin
  if (status = TJTextToSpeech.JavaClass.SUCCESS) then
  begin
   //result := FParent.tts.setLanguage(TJLocale.JavaClass.US);
   result := FParent.tts.setLanguage(TJLocale.JavaClass.JAPAN);
   if (result = TJTextToSpeech.JavaClass.LANG_MISSING_DATA) or
      (result = TJTextToSpeech.JavaClass.LANG_NOT_SUPPORTED) then
     ShowMessage('This Language is not supported');
  end
  else
    ShowMessage('Initilization Failed!');
end;
constructor TForm4.Create(AOwner: TComponent);
begin
  inherited;
  ttsListener := TttsOnInitListener.Create(self);
end;

destructor TForm4.Destroy;
begin
  if Assigned(tts) then begin
    tts.stop;
    tts.shutdown;
    tts := nil;
  end;
end;
// -----------------------------------------------------------------------------

function ASocketReceiveData(ASocket: TBluetoothSocket; ATimeout: Cardinal): string;
var
  AData : TBytes;
  ReadData : TBytes;
  i : integer;
  res : string;
  Ticks : Cardinal;
  idx : integer;
  loop : boolean;
  cnt : integer;
begin
  res := '';
  cnt := 0;
  SetLength(ReadData, 1024);
  idx := 0;
  Ticks := TThread.GetTickCount;
  loop := True;
  while loop and (cnt < 500) do begin
    Sleep(1);
    AData := ASocket.ReceiveData;
    if Length(AData) > 0 then begin
      for i := 0 to Length(AData) - 1 do begin
        ReadData[idx] := AData[i];
        Inc(idx);
        if (AData[i] = Ord(#10)) or (idx >= 1024) then begin
          loop := False;
          break;
        end;
      end;
    end;
    Inc(cnt);
    if loop then
      loop := TThread.GetTickCount - Ticks < ATimeout;
  end;
  SetLength(ReadData, idx);
  res := TEncoding.ANSI.GetString(ReadData);
  result := Trim(res); // 制御コードを含まない
end;

procedure TForm4.SendDeviceStartIndex;
// PC へ先頭番号を送信
var
  AData : TBytes;
  res : string;
  ATimeout: Cardinal;
  i : integer;
begin
  // PC 側へ先頭アドレスを送信するだけ
  if (ASocket <> nil) and ASocket.Connected then begin
    // 初期化
    for i := 0 to 159 do BitAryNew[i] := False;
    BitAryOld := BitAryNew;

    // PC の値を変更
    ATimeout := 250;
    // デバイス名
    AData := TEncoding.ANSI.GetBytes('CF ' + Label8.Text + #13#10);
    // 送信
    ASocket.SendData(AData);
    res := ASocketReceiveData(ASocket, ATimeout);
    // アドレス表示部
    Rectangle4.Fill.Color := TAlphaColorRec.Black;
    // ON/OFF表示部
    Rectangle5.Fill.Color := TAlphaColorRec.Black;
  end;
end;
procedure TForm4.Button2Click(Sender: TObject);
// 接続先保存
var
  IniFile: TMemIniFile;
begin
  IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
    System.IOUtils.TPath.GetDocumentsPath, 'MXC4_IO.ini'), TEncoding.UTF8);
  with IniFile do begin
    try
      with ComboBox3 do begin
        if ItemIndex >= 0 then begin
          WriteString('Target', 'PCName', Items[ItemIndex]);
          ShowMessage('接続先: ' + Items[ItemIndex] + 'を保存しました.' + #13#10 +
            '次回起動時から有効になります.' + #13#10 + 'このアプリを再起動して下さい.');
        end
        else
          ShowMessage('接続先が選択されていません.');
      end;
      IniFile.UpdateFile;
    finally
      Free;
    end;
  end;
end;

procedure TForm4.Button6Click(Sender: TObject);
// デバイスの値をセット
var
  AData : TBytes;
  res : string;
  ATimeout: Cardinal;
begin
  if (ASocket <> nil) and ASocket.Connected then begin
    Timer1.Enabled := False;
    ATimeout := 250;
    AData := TEncoding.ANSI.GetBytes('WR ' + Label3.Text + #13#10);
    // 送信
    ASocket.SendData(AData);
    // 受信
    res := ASocketReceiveData(ASocket, ATimeout);
    with Label3.TextSettings do begin
      if res = 'ON' then FontColor := TAlphaColorRec.Red
      else if res = 'OFF' then FontColor := TAlphaColorRec.Lime
      else FontColor := TAlphaColorRec.White;
    end;
    Timer1.Enabled := True;
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
var
  IniFile: TMemIniFile;   // uses .... System.IniFiles;
  i : integer;
begin
  Label7.Text := '';
  Label13.Text := '';
  StringColumn1.Header := 'R';
  StringColumn2.Header := '0';
  StringColumn3.Header := '1';
  StringColumn4.Header := '2';
  StringColumn5.Header := '3';
  StringColumn6.Header := '4';
  StringColumn7.Header := '5';
  StringColumn8.Header := '6';
  StringColumn9.Header := '7';
  StringColumn10.Header := '8';
  StringColumn11.Header := '9';
  StringColumn12.Header := '10';
  StringColumn13.Header := '11';
  StringColumn14.Header := '12';
  StringColumn15.Header := '13';
  StringColumn16.Header := '14';
  StringColumn17.Header := '15';

  with StringGrid1 do begin
    for i := 0 to 9 do
      Cells[0, i] := Format('%.4d', [i*100]);
  end;
  // 縦画面に固定
  Application.FormFactor.Orientations :=
    [TFormOrientation.Portrait, TFormOrientation.InvertedPortrait];

  // use ..... System.IOUtils;
  IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
    System.IOUtils.TPath.GetDocumentsPath, 'MXC4_IO.ini'), TEncoding.UTF8);
  with IniFile do begin
    try
      BtDeviceHead := ReadString('Target', 'PCName', '');
    finally
      Free;
    end;
  end;
  // TTS
  InitTTS;

  // Bruetooth スレッド
  Timer1.Interval := 10;
  Timer1.Enabled := True;
  ThBt := TBtThread.Create;

end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
  if ASocket <> nil then begin
    ASocket.Close;
    ASocket.Free;
    ASocket := nil;
  end;
end;

procedure TForm4.Rectangle10Click(Sender: TObject);
// [-10000, -1000]
var
  idx, i: integer;
begin
  idx := Label8.Text.ToInteger();
  if Sender as TRectangle = Rectangle10 then
    idx := idx - 1000
  else
    idx := idx - 10000;
  if idx < 0 then idx := 0;
  Label8.Text := Format('%.4d', [idx]);

  with StringGrid1 do begin
    for i := 0 to 9 do
      Cells[0, i]:= Format('%.4d', [idx + i * 100]);
    Row := 0;
    Col := 1;
  end;
  // 先頭アドレスを PC に送信
  SendDeviceStartIndex;
end;

procedure TForm4.Rectangle1Click(Sender: TObject);
// [ + 1]
var
  n, md, dv, idx : integer;
begin
  n := Label3.Text.ToInteger();
  dv := n div 100;
  md := n mod 100;
  if md >= 15 then begin
    Inc(dv);
    md := 0;
  end
  else
    Inc(md);

  if dv * 100 + md <= 59915 then begin
    with Label3 do begin
      Text := Format('%.4d', [dv * 100 + md]);
      TextSettings.FontColor := TAlphaColorRec.Orange;
    end;
    idx := Label8.Text.ToInteger();
    n := dv * 100 + md - idx;
    if n >= 0 then begin
      with StringGrid1 do begin
        OnCellClick := nil;
        Row := n div 100;
        Col := n mod 100 + 1;
        OnCellClick := StringGrid1CellClick;
        SetFocus;
      end;
    end;
  end;
end;

procedure TForm4.Rectangle2Click(Sender: TObject);
// [ - ]
var
  n, md, dv, idx : integer;
begin
  n := Label3.Text.ToInteger;
  dv := n div 100;
  md := n mod 100;
  if md > 0 then Dec(md)
  else begin
    Dec(dv);
    md := 15;
  end;
  if dv < 0 then begin
    dv := 0;
    md := 0;
  end;
  with Label3 do begin
    Text := Format('%.4d', [dv * 100 + md]);
    TextSettings.FontColor := TAlphaColorRec.Orange;
  end;
  idx := Label8.Text.ToInteger();
  n := dv * 100 + md - idx;
  if n >= 0 then begin
    with StringGrid1 do begin
      OnCellClick := nil;
      Row := n div 100;
      Col := n mod 100 + 1;
      OnCellClick := StringGrid1CellClick;
      SetFocus;
    end;
  end;
end;

procedure TForm4.Rectangle7Click(Sender: TObject);
//[+10000, +1000]
var
  idx: integer;
  i: Integer;
begin
  idx := Label8.Text.ToInteger();
  if Sender as TRectangle = Rectangle7 then
    idx := idx + 10000
  else
    idx := idx + 1000;
  if idx > 59000 then idx := 59000;

  Label8.Text := Format('%.4d', [idx]);
  with StringGrid1 do begin
    for i := 0 to 9 do
      Cells[0, i]:= Format('%.4d', [idx + i * 100]);
    Row := 0;
    Col := 1;
  end;
  Label1.Text := '';
  Label2.Text := '';
  Label11.Text := '';
  // 先頭アドレスを PC に送信
  SendDeviceStartIndex;
end;

procedure TForm4.StringGrid1CellClick(const Column: TColumn;
  const Row: Integer);
// セルクリックで、反転対象のアドレスを変更
var
  n : integer;
begin
  // 出力反転の対象
  n := StrToIntDef(StringGrid1.Cells[0, Row], 0) + StrToIntDef(Column.Header, 0);
  with Label3 do begin
    Text := Format('%.4d', [n]);
    TextSettings.FontColor := TAlphaColorRec.Orange;
  end;
end;

procedure TForm4.StringGrid1DrawColumnCell(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
// AlphaColor uses ... System.UIConsts;
var
  s : string;
  n : integer;
  flag : boolean;
  idx : integer;
begin
  if not Value.IsEmpty then s := Value.ToString
  else s := '';
  with Canvas do begin
    if Column.Index = 0 then begin
      if s <> '' then begin
        Fill.Color := claSilver;//claAqua;//claSilver;//Yellow;
        FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
        Fill.Color := claBlack;
        Font.Size := 15;
        FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
      end;
    end
    else begin
      flag := False;
      if (Label2.Text = 'OFF') or  (Label2.Text = 'ON') then begin
        // 先頭アドレス
        idx := Label8.Text.ToInteger();
        // 現在のアドレス
        n := StrToIntDef(Label1.Text, -1);
        if (n >= idx) then begin
          n := n - idx;
          if (Row = n div 100) and (Column.Index = n mod 100 + 1) then begin

            if Label2.Text = 'OFF' then begin
              Fill.Color := claGray;//Black;
              FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
              Fill.Color := claLime;
            end;
            if Label2.Text = 'ON' then begin
              Fill.Color := claRed;
              FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
              Fill.Color := claWhite;
            end;
            s := (n mod 100).ToString;
            Font.Size := 16;
            FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
            flag := true;
          end;
        end;
      end;
      if not flag and (s <> '') then begin
        Fill.Color := claOrange;//Red;
        FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
        Fill.Color := claWhite;
        Font.Size := 16;
        FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
      end;
    end;
  end;
end;

procedure TForm4.StringGrid1DrawColumnHeader(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF);
var
  s: string;
begin
  s := Column.Header;
  if s <> '' then begin
    with Canvas do begin
      if Column.Index = 0 then begin
        Fill.Color := claLime;
        FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
        Fill.Color := claBlack;
        Font.Size := 18;
        FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
      end
      else begin
        Fill.Color := claSilver;
        FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
        Fill.Color := claBlack;
        Font.Size := 15;
        FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
      end;
    end;
  end;
end;

function NumToSpeechText(const hex : string): string;
var
  i : integer;
  s : string;
begin
  result := '';
  for i := 1 to hex.Length do begin
    s := Copy(hex, i, 1);
    if s = '0' then result := result + 'ゼロ'
    else if s = '1' then result := result + 'イチ'
    else if s = '2' then result := result + 'ニイ'
    else if s = '3' then result := result + 'サン'
    else if s = '4' then result := result + 'ヨン'
    else if s = '5' then result := result + 'ゴー'
    else if s = '6' then result := result + 'ロク'
    else if s = '7' then result := result + 'ナナ'
    else if s = '8' then result := result + 'ハチ'
    else if s = '9' then result := result + 'キュウ'

    else if s = 'A' then result := result + 'エイ'
    else if s = 'B' then result := result + 'ビイ'
    else if s = 'C' then result := result + 'シイ'
    else if s = 'D' then result := result + 'デー'
    else if s = 'E' then result := result + 'イイ'
    else if s = 'F' then result := result + 'エフ'
    else result := result + s;
    result := result + ' ';
  end;
end;

procedure TForm4.Timer1Timer(Sender: TObject);
var
  ATimeout : Cardinal;
  AData : TBytes;
  res : string;
  i : integer;
  Ticks : Cardinal;
  j : integer;
  s : string;
  n, idx, stIndex : integer;
  flag : boolean;
  ttsFlag : boolean;
begin
  ttsFlag := False;
  if not ((GCMDMODE = cmdSCCONNECT) and ASocket.Connected) then begin
    Inc(OpenMsecCnt);
    Label7.Text := IntToStr(OpenMsecCnt * 10) + 'msec';
    if GCMDMODE = cmdSCNG then begin
      Inc(OpenNgCnt);
      if OpenNgCnt > 4 then begin
        Timer1.Enabled := False;
        ShowMessage(BTDeviceHead + ' に、接続できません.');
      end;
    end;
    if OpenMsecCnt > 100 then begin
      Timer1.Enabled := False;
      ShowMessage('接続先が無効です.');
    end;
  end;

  if (GCMDMODE = cmdSCCONNECT) and ASocket.Connected then begin
    Timer1.Interval := 250;
    flag := True;
    Timer1.Enabled := False;
    try
      Ticks := TThread.GetTickCount;
      ATimeout := 250;
      // 初回は CPU TYPE 取得のみ
      if Label13.Text = '' then begin
        AData := TEncoding.ANSI.GetBytes('CPU' + #13#10);
        // 送信
        ASocket.SendData(AData);
        // 受信
        res := ASocketReceiveData(ASocket, ATimeout);
        Label13.Text := res;
        flag := res <> '';
      end
      else begin
        // 先頭アドレス
        stIndex := Label8.Text.ToInteger();
        if Flag then begin
          // デバイス一括読み出しコマンド
          AData := TEncoding.ANSI.GetBytes('RD' + #13#10);
          // 送信
          ASocket.SendData(AData);
          // 受信
          res := ASocketReceiveData(ASocket, ATimeout);
          flag := res <> '';
          // データ格納
          if res.Length >= 80 then begin   // 10 x 4 = 40, 40 x 2 = 80
            for i := 0 to 9 do begin
              s := Copy(res, i * 4 + 1, 4);
              n := StrToIntDef('$' + s, 0);
              for j := 0 to 15 do
                BitAryNew[i * 16 + j] := n and IntPower(2, j) > 0;

              s := Copy(res, i * 4 + 1 + 40, 4);
              n := StrToIntDef('$' + s, 0);
              for j := 0 to 15 do
                BitAryOld[i * 16 + j] := n and IntPower(2, j) > 0;
            end;
            s := Copy(res, 82); // スペース1個ある
            if s <> '' then begin
              // デバイス番号
              n := Pos(' ', s);
              if n = 0 then begin
                idx := StrToIntDef(s, 0);
                Label11.Text := ''; // コメント
              end
              else begin
                // 先頭デバイス番号(PC からの応答は 10 進表記)
                idx := StrToIntDef(Copy(s, 1, n - 1), 0);
                // コメント
                Label11.Text := Copy(s, n + 1);
              end;

              if (stIndex <> idx) then begin
                stIndex := idx;
                // アドレス番号を変える
                Label8.Text := stIndex.ToString;
                with StringGrid1 do begin
                  for i := 0 to 9 do
                    Cells[0, i] := Format('%.4d', [stIndex + i * 100]);
                  Row := 0;
                  Col := 1;
                end;

                // 内部データを初期化
                for i := 0 to 159 do BitAryNew [i] := False;
                BitAryOld := BitAryNew;

                // デバイス ON/OFF の表示を初期化
                Label1.Text := '';
                Label2.Text := '';
                Rectangle4.Fill.Color := TAlphaColorRec.Black;
                Rectangle5.Fill.Color := TAlphaColorRec.Black;
                // 反転デバイス番号を更新
                Label3.Text := Format('%.4d', [stIndex]);
              end;
            end;
          end;
        end;
        // 表示
        with StringGrid1 do begin
          for i := 0 to 159 do begin
            if BitAryNew[i] then begin
              s := (i mod 16).ToString;
              if Cells[i mod 16 + 1, i div 16] <> s then
                Cells[i mod 16 + 1, i div 16] := s ;
            end
            else begin
              if Cells[i mod 16 + 1, i div 16] <> '' then
                Cells[i mod 16 + 1, i div 16] := '';
            end;
          end;
        end;
        // 比較
        // 内部データ数 = 128, FX は先頭 64 データのみ表示される
        for i := 0 to 159 do begin
          //idx := i + stIndex;
          if BitAryNew[i] and not BitAryOld[i] then begin
            Rectangle4.Fill.Color := TAlphaColorRec.Red;
            with Label1 do begin
              Text := Format('%.4d', [(i div 16) * 100 + i mod 16 + stIndex]);
              TextSettings.FontColor := TAlphaColorRec.White;
            end;
            Rectangle5.Fill.Color := TAlphaColorRec.Red;
            with Label2 do begin
              Text := 'ON';
              TextSettings.FontColor := TAlphaColorRec.White;
            end;
            ttsFlag := True;
          end
          else if not BitAryNew[i] and BitAryOld[i] then begin
            Rectangle4.Fill.Color := TAlphaColorRec.Black;
            with Label1 do begin
              Text := Format('%.4d', [(i div 16) * 100 + i mod 16 + stIndex]);
              TextSettings.FontColor := TAlphaColorRec.Lime;
            end;
            Rectangle5.Fill.Color := TAlphaColorRec.Black;
            with Label2 do begin
              Text := 'OFF';
              TextSettings.FontColor := TAlphaColorRec.Lime;
            end;
            ttsFlag := True;
          end;
          if ttsFlag then begin
            s := NumToSpeechText(Label1.Text);
            if Switch1.IsChecked then
              s := s + '。' + Label11.Text;
            if Label2.Text = 'ON' then s := s + '。' + 'オン'
            else s := s + '。' + 'オフ';
            SpeakOut(s);
          end;
        end;
      end;
      if flag then
        Label7.Text := (TThread.GetTickCount - Ticks).ToString
      else
        Label7.Text := 'PC 接続失敗';

      if flag then
        Timer1.Enabled := True;
    except
      Label7.Text := 'PC 応答なし';
      Timer1.Enabled := True;
    end;
  end;
end;

end.