KEYENCE KV Studio Ver.9J を使った Android スマホ PLC I/Oチェッカー (2019/04/07)
KV COM+ は不要です。
KV Sudio の「一括モニタ」画面を 32 行以上表示させた状態で使用します。（「一括モニタ」の横幅は広げておいてください。）
モニタ、ビット反転対象は表示されている 32点 のみです。
■仕組み
・画面に表示中の一括モニタ画面をキャプチャし、特定のピクセル（下のスクリーンショットの赤い点）の色で、
ビットデバイスの ON/ OFF を判断しています。
・Andorid スマホとの通信は、Bluetooth 経由のシリアルポートを使っています.
あらかじめペアリング後、Bluetooth経由のシリアルポートの追加が必要です。
※先頭デバイスは取得していない（できない）ので、実際と合わない場合があります。
■Windows 側アプリ
キャプチャの尺度、範囲が合っているか、確認が必要です。
全体の尺度を 0.44444 ( 1/2.25) 程度にすると、通常の解像度でも使えると思います。
Andoroid 端末の操作を中継するだけなので、画面上に見えていなくても動きます。
■KV Studio 「一括モニタ」
この一部分をキャプチャしています。データ行は 32 行以上。横幅は広げておいてください。
■Android 側アプリ
初回起動時は、通信エラーになります。
一番上のコンボボックスから接続先のPC名を選択し、「保存」をタップし、終了して下さい。
通信ができない時は、終了し、Windows 側で [STOP] -> [START] し、再度起動してみて下さい。
・[+10K], [-10K] ... ボタンで先頭デバイスを変更します。デバイスの変更には、若干時間がかかります。
・グリッドのセルをタップすると、反転対象のデバイス番号が変わります。
■著作権・免責事項等
本ツールの著作権は、作者 f.izawa が所有し、これを主張します。
本ツールをインストール、使用したことによる事故、損害等の一切について、作者はその責を負いません。
■作者連絡先
e-mail : f.izawa＠dream.com (＠は小文字に変えて下さい）
URL : http://www.izawa-web.com/
■ダウンロード
・KVS_IO.zip （Winndows側アプリ EXE 本体のみ）
キャプチャの位置、尺度が合わない場合は、全体の尺度を 0.4445 程度に変えてみて下さい。
ペアリング、Bluetooth 経由の COM ポートの追加については、ネットで検索して下さい。
・KVS_IO.apk （Android 側アプリ APK 本体のみ）
// ****************************
// Windows 側
// ****************************
unit KV_IOUnit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons,
AdPacket, OoMisc, AdPort, AdSelCom, IniFiles;
type
TForm4 = class(TForm)
Image1: TImage;
Button3: TButton;
Edit5: TEdit;
Button4: TButton;
Button5: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
Edit7: TEdit;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
Timer1: TTimer;
Button1: TButton;
Edit12: TEdit;
ApdComPort1: TApdComPort;
ApdDataPacket1: TApdDataPacket;
ComboBox1: TComboBox;
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
private
{ Private 宣言 }
public
{ Public 宣言 }
pickXOff : integer;
pickXOff0 : integer;
pickYOff : integer;
captL : integer;
captW : integer;
captH : integer;
shtScale : double;
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
type
TBitAry = array [0..31] of Boolean;
TWordAry = array [0..1] of Word;
var
BitAryNew : TBitAry;
BitAryOld : TBitAry;
WordAryNew : TWordAry;
WordAryOld : TWordAry;
//******************************************
// 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;
//******************************************
// ウィンドウのタイトル（キャプション）を得る
//******************************************
function GetWindowCaption(h : HWND) : string;
var
Title : array [0..255] of char;
begin
result := '';
if GetWindowText(h, Title, 255) <> 0 then
result := Title;
end;
//******************************************
// 他のプロセス内のコントロールの文字列を得る
//******************************************
function GetWindowString(h : HWND) : string;
var
p : PChar;
len : LongInt;
begin
result := '';
//ウィンドウの文字列のバイト数を取得
//終端のNULL文字を含まない文字列の長さ（バイト数）
len := SendMessage(h, WM_GETTEXTLENGTH, 0, 0);
if len > 0 then begin
//終端のNULL文字を含むサイズを確保
GetMem(p, (len + 1) * 2);
//格納するバッファの最大サイズ（終端のNULL文字を含む長さ）
//文字列バッファ
SendMessage(h, WM_GETTEXT, (len+1)*2, LongInt(p));
//文字列がバッファサイズより長いとき、後部がカットされる
result := string(p);
FreeMem(p);
end;
end;
//******************************************
// クラス名取得
//******************************************
function GetHwndClassName(h : HWND):string;
var
PC : PChar;
Len : Integer;
Classname : string;
begin
ClassName := '';
if not IsWindow(h) then exit;
GetMem(PC, 100);
try
Len := GetClassName(h, PC, 100);
SetString(Classname, PC, Len);
finally
FreeMem(PC);
end;
result := Classname;
end;
//******************************************
// Window に文字列を送る
//******************************************
function SendCharHwnd(h: HWND; const s: string):boolean;
var
i : integer;
begin
result := False;
if h <> 0 then begin
for i := 1 to Length(s) do
SendMessage(h, WM_CHAR, Word(s[i]), 0);
result := true;
end;
end;
//******************************************
// Window に文字列を送る
//******************************************
function SendTextHwnd(h: HWND; const s : string):boolean;
begin
result := False;
if h <> 0 then begin
SendMessage(h, WM_SETTEXT, 0, LPARAM(PChar(s)));
result := true;
end;
end;
//****************************************
// 画面の指定位置をBitmapに変換
//****************************************
procedure CaptureToBmp(Lf, Tp, W, H: Integer; bmp: TBitmap);
const
CAPTUREBLT = $40000000;
var
hdcScreen : HDC;
begin
bmp.Width := W;
bmp.Height := H;
hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
try
BitBlt( bmp.Canvas.Handle, 0, 0, W, H, hdcScreen, Lf, Tp, SRCCOPY or CAPTUREBLT);
finally
DeleteDC(hdcScreen);
end;
end;
//****************************************
// KEY を打つ
//****************************************
procedure HwndSendKeys(h: HWND; const keystr: string);
var
i : integer;
s: string;
begin
if GetForegroundWindow <> h then SetForegroundWindow(h);
s := UpperCase(keystr);
for i := 1 to Length(s) do begin
keybd_event(Byte(s[i]), 0, 0, 0);
keybd_event(Byte(s[i]), 0, KEYEVENTF_KEYUP, 0);
Sleep(1);
end;
end;
procedure TForm4.ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
var
cmd, res, s, s0, s1 : string;
i, j, k0 : integer;
begin
cmd := Trim(string(Data));
if cmd = 'CPU' then begin
ApdComPort1.PutString('KV' + #13#10);
end
else if cmd = 'READ' then begin
s0 := ''; s1 := '';
for i := 0 to 1 do begin
k0 := 0;
for j := 0 to 15 do begin
if BitAryNew[i * 16 + j] then
k0 := k0 + IntPower(2, j);
end;
WordAryNew[i] := k0;
s0 := s0 + IntToHex(k0, 4);
s1 := s1 + IntToHex(WordAryOld[i], 4);
end;
res := Copy(Edit5.Text + ' ', 1, 8) ; // 先頭デバイス(8文字)
res := res + s0 + s1; // 8 + 8 + 8 = 合計 24 文字
ApdComPort1.PutString(res + #13#10);
WordAryOld := WordAryNew;
end
// ビット反転
else if Pos('BTRV', cmd) = 1 then begin
s := Copy(cmd, 6);
Edit11.Text := s;
Button5Click(self);
ApdComPort1.PutString('OK' + #13#10);
end
// 先頭デバイス変更
else if Pos('DEVN', cmd) = 1 then begin
s := Copy(cmd, 6);
Edit5.Text := s;
Button3Click(self);
ApdComPort1.PutString('OK' + #13#10);
end
else
ApdComPort1.PutString('??' + #13#10);
end;
procedure TForm4.Button1Click(Sender: TObject);
var
s : string;
begin
if Button1.Caption = 'START' then begin
Button1.Caption := 'STOP';
Button3Click(self);
with ApdComPort1 do begin
s := Copy(ComboBox1.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;
ComboBox1.Enabled := False;
end;
except
ShowMessage('ComPort Open Error');
end;
Timer1.Enabled := True;
end
else begin
Button1.Caption := 'START';
Timer1.Enabled := False;
if ApdComPort1.Open then begin
ApdComPort1.Open := False;
ComboBox1.Enabled := True;
end;
end;
end;
procedure TForm4.Button3Click(Sender: TObject);
// 先頭デバイス変更
var
h1, h2, h3, h4, h : HWND;
ARect : TRect;
bmp : TBitmap;
x, y : integer;
pt0 : TPoint;
pt : TPoint;
tmFlag : boolean;
i: Integer;
begin
tmFlag := Timer1.Enabled;
if tmFlag then Timer1.Enabled := False;
GetCursorPos(pt0);
h1 := FindWindow(nil, '一括モニタ'); //#32770
h2 := GetWindow(h1, GW_CHILD);
h3 := GetWindow(h2, GW_HWNDNEXT);
h4 := GetWindow(h3, GW_CHILD);
if (h4 <> 0) and IsWindowVisible(h4) then begin
GetWindowRect(h4, ARect);
pt.X := ARect.Left + 1;
pt.Y := ARect.Top + 1;
h := WindowFromPoint(pt);
if h <> h4 then begin
SetForegroundWindow(h1);
Sleep(100);
end;
x := ARect.Left + Trunc((CaptL + 100) * shtScale);
y := ARect.Top + Trunc((captH / 33 + pickYOff) * shtScale);
SetCursorPos(x, y);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
Sleep(200);
keybd_event(VK_RETURN, 0, 0, 0);
keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
// 先頭デバイス番号を送る
HwndSendKeys(h4, Edit5.Text + #13);
// 反転対象のデバイスを変更
Edit11.Text := Edit5.Text;
// 初期化
Edit7.Text := '';
Edit12.Text := '';
for i := 0 to 31 do BitAryNew[i] := False;
BitAryOld := BitAryNew;
SetCursorPos(pt0.X, pt0.Y);
Sleep(500);
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf24bit;
CaptureToBmp(ARect.Left + Trunc(captL * shtScale), ARect.Top,
Trunc(captW * shtScale), Trunc(captH * shtScale), bmp);
Image1.Picture.Bitmap.Assign(bmp);
finally
bmp.Free;
end;
end;
if tmFlag then Timer1.Enabled := True;
end;
procedure TForm4.Button4Click(Sender: TObject);
// 現在値取得
// 先頭デバイス番号は取得できない
var
h1, h2, h3, h4, h : HWND;
ARect : TRect;
bmp : TBitmap;
i : integer;
Pnt : PByteArray;
R, G, B, R0, G0, B0 : Byte;
x, y, x0 : integer;
s : string;
pt : TPoint;
divH : double;
head, dv, md, dv2, md2 : integer;
begin
divH := captH / 33;
h1 := FindWindow(nil, '一括モニタ'); //#32770
h2 := GetWindow(h1, GW_CHILD);
h3 := GetWindow(h2, GW_HWNDNEXT);
h4 := GetWindow(h3, GW_CHILD);
if (h4 <> 0) and IsWindowVisible(h4) then begin
GetWindowRect(h4, ARect);
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf24bit;//24bit;
pt.X := ARect.Left + 1;
pt.Y := ARect.Top + 1;
h := WindowFromPoint(pt);
if h <> h4 then begin
SetForegroundWindow(h1);
Sleep(100);
end;
CaptureToBmp(ARect.Left + Trunc(captL * shtScale), ARect.Top,
Trunc(captW * shtScale), Trunc(captH * shtScale), bmp);
Image1.Picture.Bitmap.Assign(bmp);
finally
bmp.Free;
end;
with Image1.Picture.Bitmap do begin
Canvas.Pen.Color := clRed;
Canvas.Brush.Color := clRed;
Canvas.Brush.Style := bsSolid;
x := Trunc(pickXOff * shtScale);
x0 := Trunc(pickXOff0 * shtScale);
for i := 0 to 31 do begin
y := Trunc((divH * (i + 1) + pickYOff) * shtScale);
if y < Height then begin
Pnt := ScanLine[y];
R := Pnt[x * 3 + 2]; G := Pnt[x * 3 + 1]; B := Pnt[x * 3];
R0 := Pnt[x0 * 3 + 2]; G0 := Pnt[x0 * 3 + 1]; B0 := Pnt[x0 * 3];
BitAryNew[i] :=
((R = 0) and (G = 0) and (B = 0) and (R0 = $FF) and (G0 = $FF) and (B0 = $FF)) or
// 青色= $0078D7
((R = $FF) and (G = $FF) and (B = $FF) and (R0 = 0) and (G0 <> 0) and (B0 <> 0));
Canvas.Ellipse(x - 2, y - 2, x + 2, y + 2);
Canvas.Ellipse(x0 - 2, y - 2, x0 + 2, y + 2);
end;
end;
// デバイス先頭
head := StrToIntDef(Copy(Edit5.Text, 2), 0);
dv := head div 100;
md := head mod 100;
// 比較
for i := 0 to 31 do begin
if BitAryNew[i] <> BitAryOld[i] then begin
dv2 := dv + i div 16;
md2 := md + i mod 16;
if md2 >= 16 then begin
dv2 := dv2 + md2 div 16;
md2 := md2 mod 16;
end;
s := Copy(Edit5.Text, 1, 1) + Format('%.3d', [dv2 * 100 + md2]);
Edit7.Text := s;
if BitAryNew[i] then Edit12.Text := 'ON'
else Edit12.Text := 'OFF';
end;
end;
BitAryOld := BitAryNew;
end;
end;
end;
procedure TForm4.Button5Click(Sender: TObject);
// 値変更
var
h1, h2, h3, h4, h : integer;
ARect : TRect;
x, y : integer;
idx : integer;
pt0 : TPoint;
pt : TPoint;
n, m : integer;
tmFlag : boolean;
begin
tmFlag := Timer1.Enabled;
if tmFlag then Timer1.Enabled := False;
// カーソル位置を取得
GetCursorPos(pt0);
// 先頭デバイス
m := StrToIntDef(Copy(Edit5.Text, 2), 0);
// 反転デバイス
n := StrToIntDef(Copy(Edit11.Text ,2), 0);
// デバイス番号（相対）
idx := ((n - m) div 100) * 16 + (n - m) mod 100;
// 対象のウィンドウを探す
h1 := FindWindow(nil, '一括モニタ'); //#32770
h2 := GetWindow(h1, GW_CHILD);
h3 := GetWindow(h2, GW_HWNDNEXT);
h4 := GetWindow(h3, GW_CHILD);
if (h4 <> 0) and IsWindowVisible(h4) then begin
// ウィンドウの位置、矩形範囲を取得
GetWindowRect(h4, ARect);
pt.X := ARect.Left + 1;
pt.Y := ARect.Top + 1;
h := WindowFromPoint(pt);
if h <> h4 then begin
SetForegroundWindow(h1);
Sleep(100);
end;
// カーソル位置を移動
x := ARect.Left + Trunc((captL + pickXOff) * shtScale);
y := ARect.Top + Trunc(((captH / 33) * (idx + 1) + pickYOff) * shtScale);
SetCursorPos(x, y);
// セルをアクティブに
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
Sleep(100);
// スペースキーを押す
keybd_event(VK_SPACE, 0, 0, 0);
keybd_event(VK_SPACE, 0, KEYEVENTF_KEYUP, 0);
Sleep(100);
{
// 次の処理（現在値取得）のためにアクティブセルをデバイスの先頭に変える
x := ARect.Left + Trunc((captL + pickXOff) * shtScale);
y := ARect.Top + Trunc((captH / 33 + pickYOff) * shtScale);
SetCursorPos(x, y);
// セルをアクティブに
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
Sleep(100);
}
// カーソル位置を戻す
SetCursorPos(pt0.X, pt0.Y);
Sleep(500);
end;
if tmFlag then Timer1.Enabled := True;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
i : integer;
ini : TIniFile;
begin
shtScale := 1.0;
// Pixcel 取得のマス目左上基点からのオフセット
pickXOff := 454;
pickXOff0 := 220;
pickYOff := 10;
// ウィンドウ基点から「デバイス」マスの左位置 (上位置=0)
captL := 270;
// キャプチャ範囲の幅
captW := 475;
// キャプチャ範囲の高さ
captH := 1188;
// 使用可能な COM ポートを列挙
AdSelCom.ShowPortsInUse := False;
for i := 0 to 32 do begin
if AdSelCom.IsPortAvailable(i) then
ComboBox1.Items.Add (AdPort.ComName(i) + '.');
end;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
Left := ini.ReadInteger('Form', 'Left', (Screen.Width - Width) div 2);
Top := ini.ReadInteger('Form', 'Top' , (Screen.Height - Height) div 2);
i := ini.ReadInteger('COM', 'PortIndex', 0);
if ComboBox1.Items.Count > i then ComboBox1.ItemIndex := i;
shtScale := ini.ReadFloat('Capt', 'Scale', 1);
captW := ini.ReadInteger('Capt', 'captW', captW);
captH := ini.ReadInteger('Capt', 'captH', captH);
captL := ini.ReadInteger('Capt', 'captL', captL);
pickXOff := ini.ReadInteger('Capt', 'pickXOff', pickXOff);
pickXOff0 := ini.ReadInteger('Capt', 'pickXOff0', pickXOff0);
pickYOff := ini.ReadInteger('Capt', 'pickYOff', pickYOff);
finally
ini.Free;
end;
ApdDataPacket1.Enabled := False;
Edit1.Text := Format('%.6f', [ shtScale]);
Edit2.Text := IntToStr(captW);
Edit3.Text := IntToStr(captH);
Edit4.Text := IntToStr(captL);
Edit8.Text := IntToStr(pickXOff0);
Edit9.Text := IntToStr(pickXOff);
Edit10.Text := IntToStr(pickYOff);
end;
procedure TForm4.FormDestroy(Sender: TObject);
var
ini: TIniFile;
begin
if ApdComPort1.Open then ApdComPort1.Open := False;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
ini.WriteInteger('Form', 'Left', Left);
ini.WriteInteger('Form', 'Top' , Top);
ini.WriteInteger('COM', 'PortIndex', ComboBox1.ItemIndex);
ini.WriteFloat('Capt', 'Scale', shtScale);
ini.WriteInteger('Capt', 'captW', captW);
ini.WriteInteger('Capt', 'captH', captH);
ini.WriteInteger('Capt', 'captL', captL);
ini.WriteInteger('Capt', 'pickXOff', pickXOff);
ini.WriteInteger('Capt', 'pickXOff0', pickXOff0);
ini.WriteInteger('Capt', 'pickYOff', pickYOff);
finally
ini.Free;
end;
end;
procedure TForm4.SpeedButton10Click(Sender: TObject);
// 規定値に戻す
begin
shtScale := 1.0;
captW := 475;
captH := 1188;
captL := 270;
pickXOff0 := 220;
pickXOff := 454;
pickYOff := 10;
Edit1.Text := Format('%.6f', [ shtScale]);
Edit2.Text := IntToStr(captW);
Edit3.Text := IntToStr(captH);
Edit4.Text := IntToStr(captL);
Edit8.Text := IntToStr(pickXOff0);
Edit9.Text := IntToStr(pickXOff);
Edit10.Text := IntToStr(pickYOff);
end;
procedure TForm4.SpeedButton1Click(Sender: TObject);
// [+10], [+1]
var
idx0, idx1 : integer;
dv0, dv1, md1 : integer;
begin
idx0 := StrToIntDef(Copy(Edit5.Text, 2), 0);
dv0 := idx0 div 100;
idx1 := StrToIntDef(Copy(Edit11.Text, 2), 0);
if idx1 - idx0 < 200 then begin
dv1 := idx1 div 100;
md1 := idx1 mod 100;
if Sender as TSpeedButton = SpeedButton1 then begin
Inc(md1);
if md1 >= 16 then begin
Inc(dv1);
md1 := 0;
end;
end
else begin
Inc(dv1);
end;
if (dv1 - dv0 < 2) and (md1 < 16) then
Edit11.Text := Copy(Edit5.Text, 1, 1) + Format('%.3d', [dv1 * 100 + md1]);
end;
end;
procedure TForm4.SpeedButton2Click(Sender: TObject);
// [-10], [-1]
var
idx0, idx1 : integer;
dv0, dv1, md1 : integer;
begin
idx0 := StrToIntDef(Copy(Edit5.Text, 2), 0);
dv0 := idx0 div 100;
idx1 := StrToIntDef(Copy(Edit11.Text, 2), 0);
if idx1 - idx0 < 200 then begin
dv1 := idx1 div 100;
md1 := idx1 mod 100;
if Sender as TSpeedButton = SpeedButton2 then begin
Dec(md1);
if md1 < 0 then begin
Dec(dv1);
md1 := 15;
end;
end
else begin
Dec(dv1);
end;
if (dv1 >= dv0) and (md1 >= 0) then
Edit11.Text := Copy(Edit5.Text, 1, 1) + Format('%.3d', [dv1 * 100 + md1]);
end;
end;
procedure TForm4.SpeedButton5Click(Sender: TObject);
// 先頭デバイス +100, +1000
var
idx0 : integer;
dv0, md0 : integer;
begin
idx0 := StrToIntDef(Copy(Edit5.Text, 2), 0);
dv0 := idx0 div 100;
md0 := idx0 mod 100;
if Sender as TSpeedButton = SpeedButton5 then
Inc(dv0)
else
dv0 := dv0 + 10;
Edit5.Text := Copy(Edit5.Text, 1, 1) + Format('%.3d', [dv0 * 100 + md0]);
// 先頭デバイス変更
Button3Click(self);
end;
procedure TForm4.SpeedButton7Click(Sender: TObject);
// 先頭デバイス -100, -1000
var
idx0 : integer;
dv0, md0 : integer;
begin
idx0 := StrToIntDef(Copy(Edit5.Text, 2), 0);
dv0 := idx0 div 100;
md0 := idx0 mod 100;
if Sender as TSpeedButton = SpeedButton7 then
Dec(dv0)
else
dv0 := dv0 - 10;
if (dv0 >= 0) and (md0 >= 0) then begin
Edit5.Text := Copy(Edit5.Text, 1, 1) + Format('%.3d', [dv0 * 100 + md0]);
// 先頭デバイス変更
Button3Click(self);
end;
end;
procedure TForm4.SpeedButton9Click(Sender: TObject);
// 設定を更新
begin
shtScale := StrToFloatDef(Edit1.Text ,1.0);
Edit1.Text := Format('%.6f', [shtScale]);
captW := StrToIntDef(Edit2.Text, 475);
captH := StrToIntDef(Edit3.Text, 1188 );
captL := StrToIntDef(Edit4.Text, 270);
pickXOff0 := StrToIntDef(Edit8.Text, 220);
pickXOff := StrToIntDef(Edit9.Text, 454);
pickYOff := StrToIntDef(Edit10.Text, 10);
end;
procedure TForm4.Timer1Timer(Sender: TObject);
begin
Button4Click(self);
end;
end.
// ****************************
// Android 側
// ****************************
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,
// for ToneGenerator
AndroidApi.JNI.Media;
type
TBitAry = array [0..31] 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;
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;
Rectangle9: TRectangle;
Label11: TLabel;
Rectangle12: TRectangle;
Label14: 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;
// uses ... Androidapi.JNIBridge, AndroidApi.JNI.Media;
ToneGenerator: JToneGenerator;
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] = $0A) 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 31 do BitAryNew[i] := False;
BitAryOld := BitAryNew;
// PC の値を変更
ATimeout := 250;
// デバイス名
AData := TEncoding.ANSI.GetBytes('DEVN ' + Label8.Text + #13#10);
// 送信
ASocket.SendData(AData);
res := ASocketReceiveData(ASocket, ATimeout);
// アドレス表示部
Rectangle4.Fill.Color := TAlphaColorRec.Black;
// ON/OFF表示部
Rectangle5.Fill.Color := TAlphaColorRec.Black;
end;
// 反転デバイスの初期値
Label3.Text := Label8.Text;
end;
procedure TForm4.Button2Click(Sender: TObject);
// 接続先保存
var
IniFile: TMemIniFile;
begin
IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath, 'KVS_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('BTRV ' + 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;
if Switch1.IsChecked then begin
// ブザー
if (res = 'ON') or (res = 'OFF') or (res = 'OK') then
ToneGenerator.startTone(TJToneGenerator.JavaClass.TONE_PROP_ACK)
else
ToneGenerator.startTone(TJToneGenerator.JavaClass.TONE_PROP_NACK);
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 1 do
Cells[0, i] := Format('%.3d', [i*100]);
end;
// 縦画面に固定
Application.FormFactor.Orientations :=
[TFormOrientation.Portrait, TFormOrientation.InvertedPortrait];
// use ..... System.IOUtils;
IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath, 'KVS_IO.ini'), TEncoding.UTF8);
with IniFile do begin
try
BtDeviceHead := ReadString('Target', 'PCName', '');
finally
Free;
end;
end;
// TTS
InitTTS;
// ブザー
ToneGenerator := TJToneGenerator.JavaClass.init(
TJAudioManager.JavaClass.STREAM_ALARM,
TJToneGenerator.JavaClass.MAX_VOLUME);
// 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 := StrToIntDef(Copy(Label8.Text, 2), 0);
if Sender as TRectangle = Rectangle10 then
idx := idx - 1000
else if Sender as TRectangle = Rectangle11 then
idx := idx - 100
else // 12
idx := idx - 10000;
if idx < 0 then idx := 0;
Label8.Text := Copy(Label8.Text, 1, 1) + Format('%.3d', [idx]);
with StringGrid1 do begin
for i := 0 to 1 do
Cells[0, i]:= Format('%.3d', [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 := StrToIntDef(Copy(Label3.Text, 2), 0);
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 := Copy(Text, 1,1) + Format('%.3d', [dv * 100 + md]);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
idx := StrToIntDef(Copy(Label8.Text, 2), 0);
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 := StrToIntDef(Copy(Label3.Text, 2), 0);
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 := Copy(Text, 1, 1) + Format('%.3d', [dv * 100 + md]);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
idx := StrToIntDef(Copy(Label8.Text, 2), 0);
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 := StrToIntDef(Copy(Label8.Text, 2), 0);
if Sender as TRectangle = Rectangle7 then
idx := idx + 100
else if Sender as TRectangle = Rectangle8 then
idx := idx + 1000
else //9
idx := idx + 10000;
if idx > 59000 then idx := 59000;
Label8.Text := Copy(Label8.Text, 1, 1) + Format('%.3d', [idx]);
with StringGrid1 do begin
for i := 0 to 1 do
Cells[0, i]:= Format('%.3d', [idx + i * 100]);
Row := 0;
Col := 1;
end;
Label1.Text := '';
Label2.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 := Copy(Text, 1, 1) + Format('%.3d', [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 := StrToIntDef(Copy(Label8.Text, 2), 0);
// 現在のアドレス
n := StrToIntDef(Copy(Label1.Text,2), -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 := StrToIntDef(Copy(Label8.Text, 2), 0);
if Flag then begin
// デバイス一括読み出しコマンド
AData := TEncoding.ANSI.GetBytes('READ' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
flag := res <> '';
// データ格納
if res.Length >= 24 then begin
for i := 0 to 1 do begin
s := Copy(res, i * 4 + 9, 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 + 9 + 8, 4);
n := StrToIntDef('$' + s, 0);
for j := 0 to 15 do
BitAryOld[i * 16 + j] := n and IntPower(2, j) > 0;
end;
s := Trim(Copy(res, 1, 8)); //
// 先頭デバイス番号
idx := StrToIntDef(Copy(s, 2), 0);
if (stIndex <> idx) then begin
stIndex := idx;
// アドレス番号を変える
Label8.Text := Copy(Label8.Text, 1, 1) + Format('%.3d', [stIndex]);
with StringGrid1 do begin
for i := 0 to 1 do
Cells[0, i] := Format('%.3d', [stIndex + i * 100]);
Row := 0;
Col := 1;
end;
// 内部データを初期化
for i := 0 to 31 do BitAryNew [i] := False;
BitAryOld := BitAryNew;
// デバイス ON/OFF の表示を初期化
Label1.Text := '';
Label2.Text := '';
Rectangle4.Fill.Color := TAlphaColorRec.Black;
Rectangle5.Fill.Color := TAlphaColorRec.Black;
// 反転デバイス番号を更新
Label3.Text := Copy(Label3.Text, 1, 1) + Format('%.3d', [stIndex]);
end;
end;
end;
// 表示
with StringGrid1 do begin
for i := 0 to 31 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;
// 比較
for i := 0 to 31 do begin
if BitAryNew[i] and not BitAryOld[i] then begin
//Rectangle4.Fill.Color := TAlphaColorRec.Red;
with Label1 do begin
Text := Copy(Label8.Text, 1, 1) + Format('%.3d', [(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 := Copy(Label8.Text, 1, 1) + Format('%.3d', [(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 and Switch1.IsChecked then begin
s := NumToSpeechText(Label1.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.