PC 側で、[START] ボタンをクリックし、画面キャプチャ、CPU 判断等 が出来ていることを確認してからアプリを起動してください。
初回起動時は、エラーになります。一番上のコンボボックスから接続先のPC名を選択し、「保存」 をタップして PC 名を保存。再起動してください。
PC と通信できない時は、PC 側で [STOP] をクリック、[START] をクリックしたあと、アプリを再度起動してみて下さい。
// **********************************
// Windows 側
// **********************************
unit GXW2Unit4;unit GXW2Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Buttons,
OoMisc, AdPort, AdSelCom, AdPacket, IniFiles, Vcl.ComCtrls;
type
// 16 点×10 行のデータを保持
TBitAry = array [0..159] of ShortInt;
TWordAry = array [0..9] of Word;
type
TForm4 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Image1: TImage;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
Edit1: TEdit;
Button3: TButton;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Button4: TButton;
Edit5: TEdit;
CheckBox1: TCheckBox;
ComboBox1: TComboBox;
Timer1: TTimer;
ApdComPort1: TApdComPort;
ApdDataPacket1: TApdDataPacket;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
GroupBox1: TGroupBox;
Label5: TLabel;
Edit8: TEdit;
Label6: TLabel;
Edit9: TEdit;
Label7: TLabel;
Edit10: TEdit;
Label8: TLabel;
Edit11: TEdit;
Label9: TLabel;
Edit12: TEdit;
Button2: TButton;
Button5: TButton;
Label1: TLabel;
Edit6: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(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 CheckBox1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
procedure Button2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
var
// SpreadSheet ウィンドウ
SpreadSheetHwnd : HWND;
// SpreadSheet ウィンドウの左上座標
shtCaptLeft, shtCaptTop : integer;
// 座標補正の係数
//shtXScale, shtYScale : double;
// 列幅、行高
shtColWidth, shtRowHeight : double;
// マウスクリック、ピクセル取得の左上基点からのオフセット
pickXOff, pickYOff : integer;
// 先頭デバイス番号の Edit ウィンドウ
DeviceEditHwnd : HWND;
// 先頭デバイス番号の ComboBox ウィンドウ
DeviceComboHwnd : HWND;
// メインウィンドウ
GXW2FrameHwnd : HWND;
captL, captW, captH: integer;
// 全体の尺度
shtScale : double;
// 比較用内部データ（ShortInt）
// 今回値
BitAryNew : TBitAry;
// 前回値
BitAryOld : TBitAry;
// 常時監視の先頭デバイスが変わる判断
devHeadOld : string;
// 先頭デバイスが変わった時は比較を１回パス
passFlag : boolean;
// 先頭デバイスの変更が失敗した時に戻す
devChgOld : string;
// スマホへのデータ送信用
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;
//******************************************
// 8 進数表記 -> 整数
//******************************************
function OctToIntDef(const Value: string; Def :integer): integer;
var
i, len, n : integer;
begin
result := 0;
len := Length(Value);
for i := 1 to len do begin
n := StrToIntDef(Value[i], -1);
if (n >= 0 ) and (n < 8) then
Inc(result, n * IntPower(8, len - i))
else begin
result := Def;
break;
end;
end;
end;
//******************************************
// 整数 -> 8 進数表記
//******************************************
function IntToOct(Value: integer; digits: Integer): string;
var
rest: Longint;
oct: string;
i: Integer;
begin
oct := '';
while Value <> 0 do begin
rest := Value mod 8;
Value := Value div 8;
oct := IntToStr(rest) + oct;
end;
if Length(oct) < digits then
for i := Length(oct) + 1 to digits do oct := '0' + oct;
result := oct;
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;
//******************************************
// ウィンドウのタイトル（キャプション）を得る
//******************************************
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;
// 先頭デバイスのコンボボックスを探す
function EnumCWinProc_DeviceCombo(h: HWND; lparam: Integer): Bool; stdcall;
var
Title : array [0..255] of char;
begin
result := true;
if GetWindowText(h, Title, 255) <> 0 then begin
if Pos('デバイス/バッファメモリ一括モニタ', Title) = 1 then begin
DeviceComboHwnd := h;
Result := False;
end;
end;
end;
// デバイス一括モニタのスプレッドシートを探す
function EnumCWinProc_SpreadSheet(h: HWND; lparam: Integer): Bool; stdcall;
var
ClassName : string;
begin
result := true;
ClassName := GetHwndClassName(h);
if 'SPR32AU70_SpreadSheet' = ClassName then begin
SpreadSheetHwnd := h;
Result := False;
end;
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;
procedure TForm4.ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
var
cmd, res, s, s0, s1 : string;
i, j, k0 : integer;
begin
cmd := Trim(string(Data));
//Memo1.Lines.Add(cmd);
if cmd = 'CPU' then begin
if CheckBox1.Checked then res := 'FX'
else res := 'QL';
ApdComPort1.PutString(res + #13#10);
end
else if cmd = 'READ' then begin
s0 := ''; s1 := '';
for i := 0 to 9 do begin
k0 := 0;// k1 := 0;
for j := 0 to 15 do begin
if BitAryNew[i * 16 + j] = 1 then
k0 := k0 + IntPower(2, j);
end;
WordAryNew[i] := k0;
//k1 := WordAryOld[i];
s0 := s0 + IntToHex(k0, 4);
s1 := s1 + IntToHex(WordAryOld[i], 4);
end;
if CheckBox1.Checked then res := 'FX'
else res := 'QR';
res := res + Copy(Edit1.Text + ' ', 1, 6) ; // 先頭デバイス
res := res + s0 + s1; // 合計 88 文字
ApdComPort1.PutString(res + #13#10);
WordAryOld := WordAryNew;
end
// ビット反転
else if Pos('BTRV', cmd) = 1 then begin
s := Copy(cmd, 6);
Edit4.Text := s;
Button4Click(self);
ApdComPort1.PutString('OK' + #13#10);
end
// 先頭デバイス変更
else if Pos('DEVN', cmd) = 1 then begin
s := Copy(cmd, 6);
Edit5.Text := s;
Button1Click(self);
ApdComPort1.PutString('OK' + #13#10);
end
else
ApdComPort1.PutString('??' + #13#10);
end;
procedure TForm4.Button1Click(Sender: TObject);
// 先頭デバイス変更
var
x, y : integer;
pt, pt0 : TPoint;
h : HWND;
tmFlag : boolean;
begin
tmFlag := Timer1.Enabled;
if tmFlag then Timer1.Enabled := False;
if IsWindowVisible(DeviceEditHwnd) then begin
GetCursorPos(pt0);
SendTextHwnd(DeviceEditHwnd, Trim(Edit5.Text));
SetForegroundWindow(DeviceEditHwnd);
// [Enter]
keybd_event(VK_RETURN, 0, 0, 0);
keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
// セル 0,0 に移動
x := shtCaptLeft + Trunc(pickXOff * shtScale);
y := shtCaptTop + Trunc(shtRowHeight + pickYOff * shtScale);
SetCursorPos(x, y);
pt.X := x; pt.Y := y;
// マウス直下の Window を取得
if WindowFromPoint(pt) = SpreadSheetHwnd then begin
// マウスクリックで Active に
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;
// カーソルを元に戻す
SetCursorPos(pt0.X, pt0.Y);
Sleep(200);
// 変更できない時、ダイアログを探す
h := FindWindow(nil, 'MELSOFTシリーズ GX Works2');
if h = 0 then
h := FindWindow(nil, 'MELSOFT GX Works3 Q/L/FXシリーズ互換モード');
// ダイアログを閉じる
if (h <> 0) and IsWindowVisible(h) then begin
if '#32770' = GetHwndClassName(h) then begin
SetForegroundWindow(h);
keybd_event(VK_RETURN, 0, 0, 0);
keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
Sleep(200);
// 先頭番号を戻す
if devChgOld <> '' then begin
Edit5.Text := devChgOld;
end
else begin
Edit5.Text := Copy(Edit5.Text, 1, 1) + '000';
devChgOld := Edit5.Text;
end;
SendTextHwnd(DeviceEditHwnd, Trim(Edit5.Text));
SetForegroundWindow(DeviceEditHwnd);
// [Enter]
keybd_event(VK_RETURN, 0, 0, 0);
keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
Sleep(200);
// セル 0,0 に移動
x := shtCaptLeft + Trunc(pickXOff * shtScale);
y := shtCaptTop + Trunc(shtRowHeight + pickYOff * shtScale);
SetCursorPos(x, y);
pt.X := x; pt.Y := y;
// マウス直下の Window を取得
if WindowFromPoint(pt) = SpreadSheetHwnd then begin
// マウスクリックで Active に
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;
// カーソル位置を戻す
SetCursorPos(pt0.X, pt0.Y);
Sleep(200);
end;
end;
// ダイアログを閉じる
h := FindWindow(nil, '現在値変更');
if (h <> 0) and IsWindowVisible(h) and IsWindowEnabled(h) then begin
if '#32770' = GetHwndClassName(h) then begin
SetForegroundWindow(h);
keybd_event(VK_ESCAPE, 0, 0, 0);
keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0);
Sleep(200);
end;
end;
end;
if tmFlag then Timer1.Enabled := True;
end;
procedure TForm4.Button2Click(Sender: TObject);
begin
shtScale := StrToFloatDef(Edit6.Text, 1);
Edit6.Text := Format('%.4f', [shtScale]);
//shtYScale := StrToFloatDef(Edit7.Text, 1);
//Edit7.Text := Format('%.3f', [shtYScale]);
captW := StrToIntDef(Edit8.Text, 504);
Edit8.Text := IntToStr(captW);
captH := StrToIntDef(Edit9.Text, 372);
Edit9.Text := IntToStr(captH);
captL := StrToIntDef(Edit10.Text, 243);
Edit10.Text := IntToStr(captL);
pickXOff := StrToIntDef(Edit11.Text, 10);
Edit11.Text := IntToStr(pickXOff);
pickYOff := StrToIntDef(Edit12.Text, 8);
Edit12.Text := IntToStr(pickYOff);
end;
procedure TForm4.Button3Click(Sender: TObject);
var
s : string;
begin
if Button3.Caption = 'START' then begin
Button3.Caption := 'STOP';
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
Timer1.Enabled := False;
Button3.Caption := 'START';
if ApdComPort1.Open then begin
ApdComPort1.Open := False;
ComboBox1.Enabled := True;
end;
end;
end;
procedure TForm4.Button4Click(Sender: TObject);
// デバイス ON/OFF 反転
var
h, k, n, m : integer;
x, y : integer;
pt, pt0 : TPoint;
hnd : HWND;
tmFlag : boolean;
begin
tmFlag := Timer1.Enabled;
if tmFlag then Timer1.Enabled := False;
x := 0; y := 0;
GetCursorPos(pt0);
if CheckBox1.Checked then begin
// 先頭デバイス
h := OctToIntDef(Copy(Edit1.Text, 2), 0);
// 反転対象のデバイス
k := OctToIntDef(Copy(Edit4.Text, 2), -1);
if k >= 0 then begin
k := k - h;
n := k div 8;
m := k mod 8;
if BitAryNew[n * 16 + m] >= 0 then begin
x := shtCaptLeft + Trunc((7 - m) * shtColWidth + pickXOff * shtScale);
y := shtCaptTop + Trunc((n + 1) * shtRowHeight + pickYOff * shtScale);
end;
end;
end
else begin
// 先頭デバイス
h := StrToIntDef('$' + Copy(Edit1.Text, 2), 0);
// 反転対象のデバイス
k := StrToIntDef('$' + Copy(Edit4.Text, 2), -1);
if k >= 0 then begin
k := k - h;
n := k div 16;
m := k mod 16;
if BitAryNew[n * 16 + m] >= 0 then begin
x := shtCaptLeft + Trunc((15 - m) * shtColWidth + pickXOff * shtScale);
y := shtCaptTop + Trunc((n + 1) * shtRowHeight + pickYOff * shtScale);
end;
end;
end;
if (x > 0) and (y > 0) then begin
SetCursorPos(x, y);
pt.X := x; pt.Y := y;
// マウス直下の Window を取得
if WindowFromPoint(pt) = SpreadSheetHwnd then begin
// マウスクリックで Active に
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
Sleep(100);
// [Shift] + [Enter] キーで反転
keybd_event(VK_SHIFT, 0, 0, 0);
keybd_event(VK_RETURN, 0, 0, 0);
keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
end;
Sleep(200);
hnd := FindWindow(nil, '現在値変更');
if (hnd <> 0) and IsWindowVisible(hnd) and IsWindowEnabled(hnd) then begin
if '#32770' = GetHwndClassName(hnd) then begin
SetForegroundWindow(hnd);
keybd_event(VK_ESCAPE, 0, 0, 0);
keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0);
Sleep(200);
end;
end;
end;
// マウス位置を戻す
SetCursorPos(pt0.X, pt0.Y);
if tmFlag then Timer1.Enabled := True;
end;
procedure TForm4.Button5Click(Sender: TObject);
begin
Edit6.Text := '1.0000';
//Edit7.Text := '1.000';
Edit8.Text := '504';
Edit9.Text := '372';
Edit10.Text := '243';
Edit11.Text := '10';
Edit12.Text := '8';
end;
procedure TForm4.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then begin
SpeedButton5.Caption := '+40';
SpeedButton7.Caption := '-40';
end
else begin
SpeedButton5.Caption := '+80';
SpeedButton7.Caption := '-80';
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
i : integer;
ini : TIniFile;
begin
shtScale := 1.0;
//shtYScale := 1.0;
// デバイス SpreadSheet のセルをアクティブにする左上からオフセット
// ピクセルの色取得の位置
pickXOff := 8;
pickYOff := 6;
captL := 243;
captW := 504;
captH := 372;
// 使用可能な 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);
//shtYScale := ini.ReadFloat('Capt', 'YScale', 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);
pickYOff := ini.ReadInteger('Capt', 'pickYOff', pickYOff);
Edit6.Text := Format('%.4f', [shtScale]);
//Edit7.Text := Format('%.3f', [shtYScale]);
Edit8.Text := IntToStr(captW);
Edit9.Text := IntToStr(captH);
Edit10.Text := IntToStr(captL);
Edit11.Text := IntToStr(pickXOff);
Edit12.Text := IntToStr(pickYOff);
finally
ini.Free;
end;
ApdDataPacket1.Enabled := False;
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.WriteFloat('Capt', 'YScale', shtYScale);
ini.WriteInteger('Capt', 'captW', captW);
ini.WriteInteger('Capt', 'captH', captH);
ini.WriteInteger('Capt', 'captL', captL);
ini.WriteInteger('Capt', 'pickXOff', pickXOff);
ini.WriteInteger('Capt', 'pickYOff', pickYOff);
finally
ini.Free;
end;
end;
procedure TForm4.SpeedButton10Click(Sender: TObject);
// デバイス変更
begin
if Uppercase(Copy(Edit5.Text, 1, 1)) <> 'Y' then begin
Edit5.Text := 'Y' + Copy(Edit5.Text, 2);
Button1Click(self);
end;
end;
procedure TForm4.SpeedButton1Click(Sender: TObject);
// [+10],[+1]
var
m, n, h, i, j : integer;
begin
if CheckBox1.Checked then begin
// 先頭デバイス（基準）
n := OctToIntDef(Copy(Edit1.Text, 2), 0);
// 現在の番号
m := OctToIntDef(Copy(Edit4.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton1 then Inc(m)
else m := m + 8;
if m - n < 80 then begin
h := m - n;
i := h div 8;
j := h mod 8;
if BitAryNew[i * 16 + j] >= 0 then
Edit4.Text := Copy(Edit4.Text, 1, 1) + IntToOct(m, 3);
end;
end
else begin
n := StrToIntDef('$' + Copy(Edit1.Text, 2), 0);
m := StrToIntDef('$' + Copy(Edit4.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton1 then Inc(m)
else m := m + 16;
if m - n < 160 then begin
h := m - n;
i := h div 16;
j := h mod 16;
if BitAryNew[i * 16 + j] >= 0 then
Edit4.Text := Copy(Edit4.Text, 1, 1) + IntToHex(m, 3);
end;
end;
end;
procedure TForm4.SpeedButton2Click(Sender: TObject);
// [-10],[-1]
var
n, m : integer;
begin
if CheckBox1.Checked then begin
n := OctToIntDef(Copy(Edit1.Text, 2), 0);
m := OctToIntDef(Copy(Edit4.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton2 then Dec(m)
else m := m - 8;
if m - n >= 0 then
Edit4.Text := Copy(Edit4.Text, 1, 1) + IntToOct(m, 3);
end
else begin
n := StrToIntDef('$' + Copy(Edit1.Text, 2), 0);
m := StrToIntDef('$' + Copy(Edit4.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton2 then Dec(m)
else m := m - 16;
if m - n >= 0 then
Edit4.Text := Copy(Edit4.Text, 1, 1) + IntToHex(m, 3);
end;
end;
procedure TForm4.SpeedButton5Click(Sender: TObject);
// 先頭アドレス変更 [+80],[+100]
var
m : integer;
begin
devChgOld := Edit5.Text;
if CheckBox1.Checked then begin
m := OctToIntDef(Copy(Edit5.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton5 then
m := m + 32
else
m := m + 64;
Edit5.Text := Copy(Edit5.Text, 1, 1) + IntToOct(m, 1);
Button1Click(self);
end
else begin
m := StrToIntDef('$' + Copy(Edit5.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton5 then
m := m + $80
else
m := m + $100;
Edit5.Text := Copy(Edit5.Text, 1, 1) + IntToHex(m, 1);
Button1Click(self);
end;
end;
procedure TForm4.SpeedButton7Click(Sender: TObject);
// 先頭アドレス変更 [-80],[-100]
var
m : integer;
begin
if CheckBox1.Checked then begin
m := OctToIntDef(Copy(Edit5.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton7 then
m := m - 32
else
m := m - 64;
if m >= 0 then begin
Edit5.Text := Copy(Edit5.Text, 1, 1) + IntToOct(m, 1);
Button1Click(self);
end;
end
else begin
m := StrToIntDef('$' + Copy(Edit5.Text, 2), 0);
if Sender as TSpeedButton = SpeedButton7 then
m := m - $80
else
m := m - $100;
if m >= 0 then begin
Edit5.Text := Copy(Edit5.Text, 1, 1) + IntToHex(m, 1);
Button1Click(self);
end;
end;
end;
procedure TForm4.SpeedButton9Click(Sender: TObject);
// デバイス変更
begin
if Uppercase(Copy(Edit5.Text, 1, 1)) <> 'X' then begin
Edit5.Text := 'X' + Copy(Edit5.Text, 2);
Button1Click(self);
end;
end;
procedure TForm4.Timer1Timer(Sender: TObject);
var
h : HWND;
i, j, n : integer;
ARect : TRect;
bmp : TBitmap;
Pnt : PByteArray;
R, G, B : Byte;
x, y : integer;
pt : TPoint;
hBound : integer;
begin
// メインウィンドウを探す
GXW2FrameHwnd := FindWindow('GXW2FrameWnd', nil);
if IsWindowVisible(GXW2FrameHwnd) and not IsIconic(GXW2FrameHwnd) then begin
// メインウィンドウのキャプション
//Edit6.Text := GetWindowCaption(GXW2FrameHwnd);
// 「デバイス/バッファメモリ一括モニタ」Window を探す
EnumChildWindows(GXW2FrameHwnd, @EnumCwinProc_DeviceCombo, 0);
h := GetWindow(DeviceComboHwnd, GW_CHILD);
h := GetWindow(h, GW_CHILD);
for i := 0 to 2 do
h := GetWindow(h, GW_HWNDNEXT);
DeviceEditHwnd := GetWindow(h, GW_CHILD);
// デバイス先頭
Edit1.Text := GetWindowString(DeviceEditHwnd);
if Edit1.Text = '' then begin
SendTextHwnd(DeviceEditHwnd, 'X000');
SetForegroundWindow(DeviceEditHwnd);
// [Enter]
keybd_event(VK_RETURN, 0, 0, 0);
keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
Edit1.Text := GetWindowString(DeviceEditHwnd);
end;
if Edit4.Text = '' then Edit4.Text := Edit1.Text;
if Edit5.Text = '' then Edit5.Text := Edit1.Text;
// 先頭デバイスが変わったときは、１回パス
if devHeadOld <> Edit1.Text then begin
passFlag := True;
devHeadOld := Edit1.Text;
// 反転デバイスを変更
Edit4.Text := Edit1.Text;
// 先頭デバイスのアドレスを変更
Edit5.Text := Edit1.Text;
end
else
passFlag := False;
// クラス名「SPR32AU70_SpreadSheet」 を探す
EnumChildWindows(GXW2FrameHwnd, @EnumCwinProc_SpreadSheet, 0);
GetWindowRect(SpreadSheetHwnd, ARect);
// 左上座標を保持
shtCaptLeft := Trunc(ARect.Left + captL * shtScale);
shtCaptTop := ARect.Top;
shtColWidth := (captW * shtScale) / 16 ; // 16 列
shtRowHeight := (captH * shtScale) / 11 ; // 11 行 （タイトルを含む行数）
// アクティブにする
pt.X := shtCaptLeft; pt.Y := shtCaptTop;
if WindowFromPoint(pt) <> SpreadSheetHwnd then begin
SetForegroundWindow(SpreadSheetHwnd);
Sleep(100);
end;
if WindowFromPoint(pt) = SpreadSheetHwnd then begin
// キャプチャ
bmp := TBitmap.Create;
try
bmp.PixelFormat:= TPixelFormat.pf24bit; // 重要
CaptureToBmp(shtCaptLeft, shtCaptTop, Trunc(shtColWidth*16), Trunc(shtRowHeight * 11), bmp);
Image1.Picture.Assign(bmp);
finally
bmp.Free;
end;
// ON/OFF をセルの色でチェック
for i := 0 to 9 do begin
y := Trunc(shtRowHeight * (i+1) + pickYOff * shtScale);
Pnt := Image1.Picture.Bitmap.ScanLine[y];
// FXCPU であるか１行目で判断
if i = 0 then begin
// 9 個めのセルの色で判断
x := Trunc(shtColWidth * 8 + pickXOff * shtScale);
R := Pnt[x * 3 + 2]; G := Pnt[x * 3 + 1]; B := Pnt[x * 3];
// 白または青色
if ((R = 0) and (G = 0) and (B = $FF)) or ((R = $FF) and (G = $FF) and (B = $FF)) then begin
if CheckBox1.Checked then begin
CheckBox1.Checked := False;
CheckBox1Click(self);
end;
end
else begin
// FXCPU である
if not CheckBox1.Checked then begin
CheckBox1.Checked := True;
CheckBox1Click(self);
end;
end;
end;
if CheckBox1.Checked then hBound := 7
else hBound := 15;
for j := 0 to hBound do begin
x := Trunc(shtColWidth * j + pickXOff * shtScale);
R := Pnt[x * 3 + 2]; G := Pnt[x * 3 + 1]; B := Pnt[x * 3];
if (R = 0) and (G = 0) and (B = $FF) then // 青
BitAryNew[i * 16 + hBound - j] := 1
else
if (R = $FF) and (G = $FF) and (B = $FF) then // 白
BitAryNew[i * 16 + hBound - j] := 0
else // その他（グレイ）
BitAryNew[i * 16 + hBound - j] := -1;
with Image1.Picture.Bitmap.Canvas do begin
Pen.Color := clRed;
Brush.Style := bsSolid;
Brush.Color := clRed;
Ellipse(x-2, y-2, x + 2,y + 2);
end;
end;
end;
if not passFlag then begin
// 結果表示
for i:= 0 to 159 do begin
if (BitAryNew[i] >= 0) and (BitAryOld[i] >= 0) and (BitAryNew[i] <> BitAryOld[i]) then begin
if CheckBox1.Checked then begin
n := OctToIntDef(Copy(Edit1.Text, 2), 0);
Edit2.Text := Copy(Edit1.Text, 1, 1) + IntToOct(n + (i div 16) * 8 + i mod 16, 3);
end
else begin
n := StrToIntDef('$'+ Copy(Edit1.Text, 2), 0);
Edit2.Text := Copy(Edit1.Text, 1, 1) + IntToHex(n + (i div 16) * 16 + i mod 16, 3);
end;
if BitAryNew[i] = 1 then Edit3.Text := 'ON'
else Edit3.Text := 'OFF';
end;
end;
end
else begin
Edit2.Text := '';
Edit3.Text := '';
for i := 0 to 159 do BitAryNew[i] := 0;
end;
// 前回値を更新
BitAryOld := BitAryNew;
end;
end;
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..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;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
Label7: TLabel;
StringColumn10: TStringColumn;
StringColumn11: TStringColumn;
StringColumn12: TStringColumn;
StringColumn13: TStringColumn;
StringColumn14: TStringColumn;
StringColumn15: TStringColumn;
StringColumn16: TStringColumn;
StringColumn17: TStringColumn;
CheckBox1: TCheckBox;
ComboBox3: TComboBox;
Button2: TButton;
Switch1: TSwitch;
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 ComboBox1Change(Sender: TObject);
procedure StringGrid1CellClick(const Column: TColumn; const Row: Integer);
procedure CheckBox1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(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;
GB_DeviceName : string;
GB_DeviceStartIndex : integer;
GB_fxFlag : boolean;
//GB_Busy : boolean;
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
end;
var
Form4: TForm4;
ADevice : TBluetoothDevice;
ASocket : TBluetoothSocket;
GThdMode : integer;
GCmdMode : integer;
ThBt : TBtThread;
OpenNGcnt : integer;
OpenMsecCnt : integer;
Counter : integer;
BtDeviceHead : string;
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;
// 8 進数表記 -> 整数
function OctToIntDef(const Value: string; Def :integer): integer;
var
i, len, n : integer;
begin
result := 0;
len := Length(Value);
for i := 1 to len do begin
n := StrToIntDef(Copy(Value, i, 1), -1);
if (n >= 0 ) and (n < 8) then
Inc(result, n * IntPower(8, len - i))
else begin
result := Def;
break;
end;
end;
end;
// 整数 -> 8 進数表記
function IntToOct(Value: integer; digits: Integer): string;
var
rest: Longint;
oct: string;
i: Integer;
begin
oct := '';
while Value <> 0 do begin
rest := Value mod 8;
Value := Value div 8;
oct := IntToStr(rest) + oct;
end;
if Length(oct) < digits then
for i := Length(oct) + 1 to digits do oct := '0' + oct;
result := oct;
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
// PC名
//Synchronize(procedure() begin
// Form4.Label6.Text :=
// '[' + ABluetoothManager.CurrentAdapter.AdapterName + ']'
//end);
// 過去にペアリングされたデバイスの一覧から、ターゲット を探す
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 begin
Sleep(250);
GCMDMODE := cmdSCCONNECT;
end;
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.Button2Click(Sender: TObject);
// 接続先保存
var
IniFile: TMemIniFile;
begin
IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath, 'GXW2_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.CheckBox1Change(Sender: TObject);
var
i :integer;
begin
GB_fxFlag := CheckBox1.IsChecked;
// 初期に戻す
with StringGrid1 do begin
if not GB_fxFlag then
for i := 0 to 9 do Cells[0, i] := (i * 16).ToHexString(3)
else
for i := 0 to 9 do Cells[0, i] := IntToOct(i * 8, 3);
Row := 0;
Col := 1;
end;
ComboBox1.OnChange := nil;
ComboBox2.OnChange := nil;
with ComboBox2 do begin
BeginUpdate;
Items.Clear;
if not GB_fxFlag then
for i := 0 to 255 do Items.Add(IntToHex(i * $80, 3))
else
for i := 0 to 255 do Items.Add(IntToOct(i * 32, 3));
EndUpdate;
ItemIndex := 0;
end;
// X に戻す
with ComboBox1 do begin
ItemIndex := 0;
end;
ComboBox1.OnChange := ComboBox1Change;
ComboBox2.OnChange := ComboBox1Change;
Label3.Text := 'X000';
end;
procedure TForm4.ComboBox1Change(Sender: TObject);
var
AData : TBytes;
s2, s1, res : string;
ATimeout: Cardinal;
i : integer;
begin
// ここでは、StringGrid のデバイス番号を変更しない
// PC 側へ先頭アドレスを送信するだけ
if (ASocket <> nil) and ASocket.Connected then begin
Timer1.Enabled := False;
// 初期化
Label1.Text := '';
Label2.Text := '';
for i := 0 to 159 do BitAryNew[i] := False;
BitAryOld := BitAryNew;
// PC の値を変更
ATimeout := 250;
// デバイス名
with ComboBox1 do begin
if ItemIndex < 0 then ItemIndex := 0;
s1 := ListBox.Items[ItemIndex];
end;
with ComboBox2 do begin
if ItemIndex < 0 then ItemIndex := 0;
if ItemIndex < 0 then s2 := '000'
else begin
if not GB_fxFlag then s2 := IntToHex(ItemIndex * $80, 3)
else s2 := IntToOct(ItemIndex * 32, 3);
end;
end;
AData := TEncoding.ANSI.GetBytes('DEVN ' + s1 + s2 + #13#10);
// 送信
ASocket.SendData(AData);
res := ASocketReceiveData(ASocket, ATimeout);
Rectangle4.Fill.Color := TAlphaColorRec.Black;
Rectangle5.Fill.Color := TAlphaColorRec.Black;
Timer1.Enabled := True;
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
IniFile: TMemIniFile; // uses .... System.IniFiles;
begin
GB_DeviceName := 'X';
GB_DeviceStartIndex := 0;
GB_fxFlag := True;
StringColumn1.Header := 'X';
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 := 'A';
StringColumn13.Header := 'B';
StringColumn14.Header := 'C';
StringColumn15.Header := 'D';
StringColumn16.Header := 'E';
StringColumn17.Header := 'F';
// 縦画面に固定
Application.FormFactor.Orientations :=
[TFormOrientation.Portrait, TFormOrientation.InvertedPortrait];
// use ..... System.IOUtils;
IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath, 'GXW2_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;
// FX モード で起動
CheckBox1.IsChecked := True;
CheckBox1Change(self);
end;
procedure TForm4.FormDestroy(Sender: TObject);
begin
if ASocket <> nil then begin
ASocket.Close;
ASocket.Free;
ASocket := nil;
end;
end;
procedure TForm4.Rectangle1Click(Sender: TObject);
// [ + ]
var
n, m : integer;
begin
if not GB_fxFlag then begin
n := StrToIntDef('$' + Copy(Label3.Text, 2), 0);
Inc(n);
m := n - GB_DeviceStartIndex;
if m >= 0 then begin
if m div 16 < 10 then begin
with Label3 do begin
Text := Copy(Text, 1, 1) + n.ToHexString(3);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
with StringGrid1 do begin
OnCellClick := nil;
Row := m div 16;
Col := m mod 16 + 1;
OnCellClick := StringGrid1CellClick;
SetFocus;
end;
end;
end;
end
else begin
n := OctToIntDef(Copy(Label3.Text, 2), 0);
Inc(n);
m := n - GB_DeviceStartIndex;
if m >= 0 then begin
if m div 8 < 10 then begin
with Label3 do begin
Text := Copy(Text, 1, 1) + IntToOct(n, 3);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
with StringGrid1 do begin
OnCellClick := nil;
Row := m div 8;
Col := m mod 8 + 1;
OnCellClick := StringGrid1CellClick;
SetFocus;
end;
end;
end;
end;
end;
procedure TForm4.Rectangle2Click(Sender: TObject);
// [ - ]
var
n : integer;
begin
if not GB_fxFlag then begin
n := StrToIntDef('$' + Copy(Label3.Text, 2), 0);
Dec(n);
if n < 0 then n := 0;
with Label3 do begin
Text := Copy(Text, 1, 1) + n.ToHexString(3);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
n := n - GB_DeviceStartIndex;
if n >= 0 then begin
with StringGrid1 do begin
OnCellClick := nil;
Row := n div 16;
Col := n mod 16 + 1;
OnCellClick := StringGrid1CellClick;
SetFocus;
end;
end;
end
else begin
n := OctToIntDef(Copy(Label3.Text, 2), 0);
Dec(n);
if n < 0 then n := 0;
with Label3 do begin
Text := Copy(Text, 1, 1) + IntToOct(n, 3);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
n := n - GB_DeviceStartIndex;
if n >= 0 then begin
with StringGrid1 do begin
OnCellClick := nil;
Row := n div 8;
Col := n mod 8 + 1;
OnCellClick := StringGrid1CellClick;
SetFocus;
end;
end;
end;
end;
procedure TForm4.StringGrid1CellClick(const Column: TColumn;
const Row: Integer);
var
n : integer;
begin
// 出力反転の対象
if not GB_fxFlag or (GB_fxFlag and (Column.Index <= 8)) then begin
n := StrToIntDef('$' + StringGrid1.Cells[0, Row], 0) + StrToIntDef('$' + Column.Header, 0);
with Label3 do begin
Text := GB_DeviceName + n.ToHexString(3);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
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;
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
if not GB_fxFlag then n := StrToIntDef('$' + Copy(Label1.Text, 2), -1)
else n := OctToIntDef(Copy(Label1.Text, 2), -1);
if (n >= GB_DeviceStartIndex) then begin
n := n - GB_DeviceStartIndex;
if (not GB_fxFlag and (Row = n div 16) and (Column.Index = n mod 16 + 1)) or
(GB_fxFlag and (Row = n div 8) and (Column.Index = n mod 8 + 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;
if not GB_fxFlag then s := IntToHex(n mod 16, 1)
else s := IntToHex(n mod 8, 1);
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, j, k : integer;
Ticks : Cardinal;
s, s1 : string;
n, idx : integer;
flag : boolean;
fxFlag : boolean;
begin
if not ((GCMDMODE = cmdSCCONNECT) and ASocket.Connected) then begin
Inc(OpenMsecCnt);
CheckBox1.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 Label7.Text = '' then begin
AData := TEncoding.ANSI.GetBytes('CPU' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
flag := res <> '';
fxFlag := (Pos('FX', res) = 1);
if fxFlag then Label7.Text := 'FXCPU'
else Label7.Text := 'Q/LCPU';
if GB_fxFlag <> fxFlag then begin
CheckBox1.IsChecked := fxFlag;
CheckBox1Change(self);
end;
end
else begin
// デバイス一括読み出しコマンド
AData := TEncoding.ANSI.GetBytes('READ' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
flag := res <> '';
// データ格納
if res.Length >= 88 then begin
// FX FLAG
//GB_FxFlag := Copy(res, 1,2) = 'FX'; // 未使用
// 先頭デバイス
s1 := Copy(res, 3, 1);
if not GB_fxFlag then
idx := StrToIntDef('$' + Trim(Copy(res, 4, 5)), 0)
else
idx := OctToIntDef(Trim(Copy(res, 4, 5)), 0);
for i := 0 to 9 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 + 49, 4);
n := StrToIntDef('$' + s, 0);
for j := 0 to 15 do
BitAryOld[i * 16 + j] := n and IntPower(2, j) > 0;
end;
// 先頭デバイスが変わった
if (GB_DeviceName <> s1) or (GB_DeviceStartIndex <> idx) then begin
GB_DeviceName := s1;
GB_DeviceStartIndex := idx;
// イベント無効 (PC へ送り返すため)
ComboBox1.OnChange := nil;
ComboBox2.OnChange := nil;
with ComboBox1 do begin
if GB_DeviceName = 'X' then ItemIndex := 0
else ItemIndex := 1;
end;
// 先頭デバイス番号
with ComboBox2 do begin
if Items.Count > 0 then begin
if not GB_fxFlag then
ItemIndex := GB_DeviceStartIndex div $80
else
ItemIndex := GB_DeviceStartIndex div 32;
end;
end;
// イベントを戻す
ComboBox1.OnChange := ComboBox1Change;
ComboBox2.OnChange := ComboBox1Change;
// X or Y
StringColumn1.Header := GB_DeviceName;
// アドレス番号を変える
with StringGrid1 do begin
if not GB_fxFlag then begin
for i := 0 to 9 do
Cells[0, i] := (GB_DeviceStartIndex + i * 16).ToHexString(3);
end
else begin
for i := 0 to 9 do
Cells[0, i] := IntToOct(GB_DeviceStartIndex + i * 8, 3);
end;
Row := 0;
Col := 1;
end;
// デバイス ON/OFF の表示を初期化
Label1.Text := '';
Label2.Text := '';
Rectangle4.Fill.Color := TAlphaColorRec.Black;
Rectangle5.Fill.Color := TAlphaColorRec.Black;
// 反転デバイス番号を更新
if not GB_fxFlag then begin
Label3.Text := GB_DeviceName + IntToHex(GB_DeviceStartIndex, 3);
end
else begin
Label3.Text := GB_DeviceName + IntToOct(GB_DeviceStartIndex, 3);
end;
for i := 0 to 159 do BitAryOld[i] := False;
end;
end;
// 表示
with StringGrid1 do begin
for i := 0 to 9 do begin
for j := 0 to 15 do begin
if BitAryNew[i * 16 + j] then s := j.ToHexString(1)
else s := '';
if Cells[j + 1, i] <> s then Cells[j + 1, i] := s;
if GB_fxFlag and (j = 7) then break;
end;
end;
end;
// 比較
// 内部データ数 = 160
for i := 0 to 9 do begin
for j := 0 to 15 do begin
k := i * 16 + j;
if BitAryNew[k] <> BitAryOld[k] then begin
with Label1 do begin
if not GB_fxFlag then begin
idx := k + GB_DeviceStartIndex;
Text := GB_DeviceName + idx.ToHexstring(3);
end
else begin
idx := i * 8 + j + GB_DeviceStartIndex;
Text := GB_DeviceName + IntToOct(idx, 3);
end;
end;
if BitAryNew[k] then begin
Rectangle4.Fill.Color := TAlphaColorRec.Red;
Label1.TextSettings.FontColor := TAlphaColorRec.White;
Rectangle5.Fill.Color := TAlphaColorRec.Red;
with Label2 do begin
Text := 'ON';
TextSettings.FontColor := TAlphaColorRec.White;
end;
end
else begin
Rectangle4.Fill.Color := TAlphaColorRec.Black;
Label1.TextSettings.FontColor := TAlphaColorRec.Lime;
Rectangle5.Fill.Color := TAlphaColorRec.Black;
with Label2 do begin
Text := 'OFF';
TextSettings.FontColor := TAlphaColorRec.Lime;
end;
end;
if Switch1.IsChecked then begin
s := Copy(Label1.Text, 1, 1) + #13 + NumToSpeechText(Copy(Label1.Text, 2));
if Label2.Text = 'ON' then s := s + '。' + 'オン'
else s := s + '。' + 'オフ';
SpeakOut(s);
end;
end;
if GB_fxFlag and (j = 7) then break;
end;
end;
end;
if flag then
CheckBox1.Text := (TThread.GetTickCount - Ticks).ToString
else
CheckBox1.Text := 'PC 接続失敗';
if flag then
Timer1.Enabled := True;
except
CheckBox1.Text := 'PC 応答なし';
Timer1.Enabled := True;
end;
end;
end;
end.
