// ---------------------------------------------------------------
// Windows 側
// ---------------------------------------------------------------
unit Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, ActProgTypeLib_TLB,
Vcl.StdCtrls, ActUtlTypeLib_TLB, System.Bluetooth, System.Bluetooth.Components,
AdPacket, OoMisc, AdPort, Math, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Grids, AdSelCom,
Vcl.Buttons,
IniFiles, System.UITypes, ClipBrd, Vcl.ExtDlgs,
SpeechLib_TLB, ComObj;
type
TBitAry = array [0..127] of Boolean;
TWordAry = array [0..7] of SmallInt;
type
TForm4 = class(TForm)
ActProgType1: TActProgType;
ActUtlType1: TActUtlType;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
Button5: TButton;
Button6: TButton;
Edit4: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Button3: TButton;
Edit9: TEdit;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
Edit5: TEdit;
Edit6: TEdit;
Button4: TButton;
ApdComPort1: TApdComPort;
ApdDataPacket1: TApdDataPacket;
Timer1: TTimer;
Edit3: TEdit;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
StringGrid3: TStringGrid;
Button1: TButton;
Edit10: TEdit;
Edit11: TEdit;
SpeedButton5: TSpeedButton;
CheckBox1: TCheckBox;
StringGrid4: TStringGrid;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
Edit1: TEdit;
Label6: TLabel;
OpenTextFileDialog1: TOpenTextFileDialog;
SaveTextFileDialog1: TSaveTextFileDialog;
Button2: TButton;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
procedure ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
procedure Timer1Timer(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure StringGrid2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure SpeedButton5Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
// PLC からの受信データ保持
WordAryOld : TWordAry;
WordAryNew : TWordAry;
// 内部用データ保持
BitAryOld : TBitAry;
BitAryNew : TBitAry;
// デバイス名
GB_DeviceHead : string;
// 先頭番号
GB_DeviceStartNo : integer;
// 「通信設定ユーティリティ」での論理局番
Gb_PLCStationNo : integer;
GB_fxFlag : boolean;
GB_SgScale : double;
function GetDeviceComment(const devStr : string): string;
procedure ReadCommentFile(const FileName : TFileName);
procedure SaveCommentFile(const FileName : TFileName);
end;
var
Form4: TForm4;
SpVoice: OleVariant;
TTSFlag : boolean;
function OctToIntDef(const Value: string; def : integer): integer;
function IntToOct(Value: integer; digits: Integer): string;
function IntPower(n, k : integer):integer;
implementation
{$R *.dfm}
uses Unit1;
// 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 進数 -> 10進数
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;
// 10 進数 -> 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;
// *****************************
// 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;
// --------------------------------------------
procedure TForm4.ReadCommentFile(const FileName : TFileName);
// コメントファイル読み込み
var
sl : TStringList;
cnt1, cnt2 : integer;
i, n : integer;
s, s1, s2 :string;
begin
cnt1 := 0; cnt2 := 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));
if s = 'X' then begin
with StringGrid2 do begin
Inc(cnt1);
if RowCount <= cnt1 then
RowCount := RowCount + 1;
Cells[0, cnt1] := s1;
Cells[1, cnt1] := s2;
end;
end
else if s = 'Y' then begin
with StringGrid3 do begin
Inc(cnt2);
if RowCount <= cnt2 then
RowCount := RowCount + 1;
Cells[0, cnt2] := s1;
Cells[1, cnt2] := s2;
end;
end;
end;
finally
sl.Free;
end;
with StringGrid2 do begin
if cnt1 > 0 then begin
if cnt1 < RowCount then
RowCount := cnt1;
end
else begin
RowCount := 2;
Cells[0, 1] := '';
Cells[1, 1] := '';
end;
end;
with StringGrid3 do begin
if cnt2 > 0 then
if cnt2 < RowCount then RowCount := cnt2
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;
with StringGrid3 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;
var
i, n : integer;
sg : TStringGrid;
s : string;
begin
result := '';
n := StrToInt('$' + Copy(devStr, 2));
if Copy(devStr, 1, 1) = 'X' then
sg := StringGrid2
else
sg := StringGrid3;
with sg do begin
for i := 1 to RowCount - 1 do begin
s := Copy(Cells[0, i], 2);
if (s <> '') and (n = StrToInt('$' + s)) then begin
result := Cells[1, i];
break;
end;
end;
end;
end;
procedure TForm4.ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
// Bluetooth 仮想 COM ポートから、Android 端末からのコマンドを受信
var
s, s0 : string;
szDevice : WideString;
lData : integer;
n : integer;
i : integer;
res, res1, res2 : string;
begin
s := Trim(string(Data));
// Android からのコマンド
Edit7.Text := s;
s0 := Trim(Copy(s, 1, 2));
// CPU Type
if s = 'CPU' then begin
Timer1.Enabled := False;
res := Edit9.Text;
ApdComPort1.PutString(res + #13#10);
Edit5.Text := res;
Timer1.Enabled := True;
end
// 一括読み出し
else if s0 = 'RD' then begin
Timer1.Enabled := False;
// 内部データを返信
res := '';
res1 := '';
res2 := '';
// 16進2桁×4 左から若い順
// 今回値
for i := 0 to 7 do
res1 := res1 + WordAryNew[i].ToHexString(4);
// 前回値
for i := 0 to 7 do
res2 := res2 + WordAryOld[i].ToHexString(4);
// デバイス名と開始番号（16進表示）
res := res1 + res2 + ' ' + GB_DeviceHead + ' ' + GB_DeviceStartNo.ToHexString(4);
// コメント
if Edit3.Text <> '' then begin
s := GetDeviceComment(Edit3.Text);
if s <> '' then res := res + ' ' + s;
end;
ApdComPort1.PutString(res + #13#10);
Edit5.Text := res;
// 前回値を更新
WordAryOld := WordAryNew;
Timer1.Enabled := True;
end
else if s0 = 'WR' then begin
// 'WR Y0 1'
Timer1.Enabled := False;
with ActUtlType1 do begin
// PLC に 書き込み
s0 := Copy(s, 4);
n := Pos(' ', s0);
if n > 0 then begin
// デバイス名
szDevice := Copy(s0, 1, n -1);
// 無視
// lData := StrToIntDef(Copy(s0, n + 1), 0);
// 反転
GetDevice(szDevice, lData);
lData := abs(lData - 1);
if SetDevice(szDevice, lData) = 0 then
if lData = 1 then res := 'ON'
else res := 'OFF'
else res := 'NG';
end
else res := 'NG';
ApdComPort1.PutString(res + #13#10);
Edit5.Text := res;
end;
Timer1.Enabled := True;
end
// デバイス番号をセット
// 'CF X 0', CF X 16'...
else if s0 = 'CF' then begin
Timer1.Enabled := False;
// デバイス名
s0 := Copy(s, 4);
n := Pos(' ', s0);
if n > 0 then begin
res := 'OK';
Edit5.Text := res;
ApdComPort1.PutString(res + #13#10);
GB_DeviceHead := Trim(Copy(s0, 1, n - 1));
// デバイス名
if GB_DeviceHead = 'Y' then ComboBox1.ItemIndex := 1
else ComboBox1.ItemIndex := 0;
// 開始アドレス
GB_DeviceStartNo := StrToIntDef('$' + Copy(s0, n + 1), 1);
if not Gb_fxFlag then
ComboBox2.ItemIndex := GB_DeviceStartNo div 32
else
ComboBox2.ItemIndex := GB_DeviceStartNo div 16;
// 変更を反映
ComboBox1Change(self);
end;
Timer1.Enabled := True;
end
else
ApdComPort1.PutString('??' + #13#10);
end;
procedure TForm4.Button1Click(Sender: TObject);
// コメントファイル読み込み
begin
OpenTextFileDialog1.InitialDir := ExtractFileDir(Edit10.Text);
if OpenTextFileDialog1.Execute then begin
Edit10.Text := OpenTextFileDialog1.FileName;
ReadCommentFile(Edit10.Text);
end;
end;
procedure TForm4.Button2Click(Sender: TObject);
// コメントファイル保存
var
fname : TFileName;
flag : boolean;
begin
if (StringGrid2.Cells[0, 1] <> '') or (StringGrid3.Cells[0, 1] <> '') then begin
SaveTextFileDialog1.InitialDir := ExtractFileDir(Edit10.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);
Edit10.Text := fname;
end;
end;
end;
end;
procedure TForm4.Button3Click(Sender: TObject);
// 出力反転
var
szDevice : string;
lData : integer;
edt : TEdit;
begin
if Sender as TButton = Button3 then edt := Edit8
else edt := Edit6;
with ActUtlType1 do begin
Timer1.Enabled := False;
with edt do begin
// デバイス名
szDevice := UpperCase(Text);
// 反転
if GetDevice(szDevice, lData) = 0 then begin
Font.Color := clWhite;
lData := abs(lData - 1);
if SetDevice(szDevice, lData) = 0 then
if lData = 1 then Font.Color := clRed
else Font.Color := clLime
else Font.Color := clYellow;
Timer1.Enabled := True;
end
else Font.Color := clYellow;
end;
end;
end;
procedure TForm4.Button5Click(Sender: TObject);
// Bluetooth SPP 通信（仮想 COM ポート）接続
var
s : string;
begin
Edit9.Text := ''; // CPU Name
Edit7.Text := '';
Edit5.Text := '';
with ApdComPort1 do begin
s := Copy(ComboBox4.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;
end;
except
ShowMessage('ComPort Open Error');
end;
with ActUtlType1 do begin
// 対象デバイス
if ComboBox1.ItemIndex = 1 then GB_DeviceHead := 'Y'
else GB_DeviceHead := 'X';
// 「通信設定ユーティリティ」での論理局番
Gb_PLCStationNo := ComboBox3.ItemIndex;
ActLogicalStationNumber := Gb_PLCStationNo;
Timer1.Enabled := Open = 0;
end;
end;
procedure TForm4.Button6Click(Sender: TObject);
// PLC、Android 通信終了
begin
with ActUtlType1 do begin
Close;
Timer1.Enabled := False;
end;
// Bluetooth SPP 通信（仮想 COM ポート）切断
if ApdComPort1.Open then
ApdComPort1.Open := False;
Label5.Caption := '';
end;
procedure TForm4.CheckBox1Click(Sender: TObject);
// CPU Type = FX / Other
var
i :integer;
begin
GB_fxFlag := CheckBox1.Checked;
with StringGrid1 do begin
for i := 0 to 15 do Cells[i + 1, 0] := i.ToHexString(1);
for i := 0 to 15 do Cells[0, i + 1] := (i * 16).ToHexString(3);
Cells[0, 0] := 'X';
Row := 1;
Col := 1;
end;
with ComboBox2 do begin
Items.Clear;
if not GB_fxFlag then for i := 0 to 255 do Items.Add(IntToHex(i * 32, 3))
else for i := 0 to 255 do Items.Add(IntToOct(i * 16, 3));
ItemIndex := 0;
end;
with ComboBox1 do begin
ItemIndex := 0;
end;
Edit6.Text := 'X000';
Edit8.Text := 'Y000';
end;
procedure TForm4.ComboBox1Change(Sender: TObject);
// デバイス X or Y
var
i : integer;
begin
if ComboBox1.ItemIndex = 0 then GB_DeviceHead := 'X'
else GB_DeviceHead := 'Y';
if GB_fxFlag then begin
GB_DeviceStartNo := ComboBox2.ItemIndex * 16;
Edit6.Text := 'X' + IntToOct(GB_DeviceStartNo, 3);
Edit8.Text := 'Y' + IntToOct(GB_DeviceStartNo, 3);
end
else begin
GB_DeviceStartNo := ComboBox2.ItemIndex * 32;
Edit6.Text := 'X' + IntToHex(GB_DeviceStartNo, 3);
Edit8.Text := 'Y' + IntToHex(GB_DeviceStartNo, 3);
end;
with StringGrid1 do begin
Cells[0, 0] := GB_DeviceHead;
if GB_fxFlag then
for i := 0 to 15 do Cells[0, i + 1] := IntToOct(GB_DeviceStartNo + i * 8, 3)
else
for i := 0 to 15 do Cells[0, i + 1] := IntToHex(GB_DeviceStartNo + i * 16, 3);
Row := 1;
Col := 1;
end;
for i := 0 to 127 do BitAryOld[i] := False;
for i := 0 to 7 do WordAryOld[i] := 0;
Edit3.Text := '';
Edit4.Text := '';
end;
procedure TForm4.Edit1Change(Sender: TObject);
begin
GB_SgScale := StrToFloatDef(Edit1.Text, 1.0);
StringGrid1.Repaint;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
ini : TInifile;
i : integer;
begin
GB_DeviceHead := 'X';
GB_DeviceStartNo := 0;
GB_fxFlag := True;
AdSelCom.ShowPortsInUse := False;
for i := 0 to 32 do
if AdSelCom.IsPortAvailable(i) then
ComboBox4.Items.Add (AdPort.ComName(i) + '.');
with StringGrid4 do begin
RowCount := 101;
ColWidths[0] := 150;
ColWidths[1] := 550;
Cells[0, 0] := ' 論理番号';
Cells[1, 0] := ' コメント';
for i := 0 to 99 do begin
Cells[0, i + 1] := i.ToString;
end;
end;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
with ini do begin
try
with StringGrid4 do begin
for i := 0 to 9 do
Cells[1, i + 1] := ReadString('MXCompo', 'StationNo' + i.ToString, '');
end;
with ComboBox3 do begin
with StringGrid4 do
for i := 0 to 99 do
Items.Add(' '+ i.ToString + ' : ' + Cells[1, i + 1]);
//ItemIndex := 0;
end;
ComboBox3.ItemIndex := ReadInteger('PLC', 'StationNo', 0);
with ComboBox4 do
ItemIndex := Items.IndexOf(ReadString('COM', 'PortNo', ''));
Edit10.Text := ReadString('Device', 'CommentFileName', '');
GB_SgScale := StrToFloatDef(ReadString('Grid', 'TextScale', '2.0'), 1.0);
Edit1.Text := Format('%.2f', [GB_SgScale]);
finally
Free;
end;
end;
Edit3.Text := '';
Edit4.Text := '';
Edit5.Text := '';
Edit7.Text := '';
Label5.Caption := '';
with StringGrid2 do begin
Cells[0, 0]:= ' デバイス';
Cells[1, 0]:= ' コメント';
ColWidths[1] := 450;
end;
with StringGrid3 do begin
Cells[0, 0]:= ' デバイス';
Cells[1, 0]:= ' コメント';
ColWidths[1] := 450;
end;
Edit11.Text := '';
PageControl1.ActivePageIndex := 0;
CheckBox1Click(self);
TTSFlag := False;
try
SpVoice := CreateOleObject('SAPI.SpVoice');
TTSFlag := True;
CheckBox2.Enabled := True;
CheckBox3.Enabled := True;
except
;
end;
end;
procedure TForm4.FormDestroy(Sender: TObject);
var
ini : TIniFile;
i : integer;
begin
with ActUtlType1 do Close;
if ApdComPort1.Open then ApdComPort1.Open := False;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
with ini do begin
try
WriteInteger('PLC', 'StationNo', ComboBox3.ItemIndex);
WriteString('COM', 'PortNo', ComboBox4.Text);
WriteString('Device', 'CommentFileName', Edit10.Text);
with StringGrid4 do begin
for i := 0 to 99 do
WriteString('MXCompo', 'StationNo' + i.ToString, Cells[1, i + 1]);
end;
WriteString('Grid', 'TextScale', GB_SgScale.ToString);
finally
Free;
end;
end;
end;
procedure TForm4.FormShow(Sender: TObject);
begin
if (Edit10.Text <> '') and FileExists(Edit10.Text) then begin
if MessageDlg(
'前回終了時のコメントファイル' + #13 +
Edit10.Text + #13 + 'を、読み込みますか？',
mtInformation, [mbYes, mbNo], 0) = mrYes then
ReadCommentFile(Edit10.Text)
else if MessageDlg(
'前回終了時のコメントファイル名' + #13 +
Edit10.Text + #13 + 'を、削除しますか？',
mtInformation, [mbYes, mbNo], 0) = mrYes then
Edit10.Text := '';
end;
end;
procedure TForm4.SpeedButton1Click(Sender: TObject);
// [ + ] ボタン
var
n, r, c : integer;
edt : TEdit;
begin
if Sender as TSpeedButton = SpeedButton1 then edt := Edit8
else edt := Edit6;
if not GB_fxFlag then begin
with edt do begin
n := StrToIntDef('$' + Copy(Text, 2), 0);
Inc(n);
Text := Copy(Text, 1, 1) + n.ToHexString(3);
Font.Color := RGB($FF, $A5, $00);
end;
n := n - GB_DeviceStartNo;
if n >= 0 then begin
with StringGrid1 do begin
r := n div 16 + 1;
c := n mod 16 + 1;
if (r < RowCount) and (c < ColCount) then begin
OnClick := nil;
Row := r;
Col := c;
OnClick := StringGrid1Click;
end;
end;
end;
end
else begin
with edt do begin
n := OctToIntDef(Copy(Text, 2), 0);
Inc(n);
Text := Copy(Text, 1, 1) + IntToOct(n, 3);
Font.Color := RGB($FF, $A5, $00);
end;
n := n - GB_DeviceStartNo;
if n >= 0 then begin
with StringGrid1 do begin
r := n div 8 + 1;
c := n mod 8 + 1;
if (r < RowCount) and (c < ColCount) then begin
OnClick := nil;
Row := r;
Col := c;
OnClick := StringGrid1Click;
end;
end;
end;
end;
end;
procedure TForm4.SpeedButton2Click(Sender: TObject);
// [ - ] ボタン
var
n, r, c : integer;
edt : TEdit;
begin
if Sender as TSpeedButton = SpeedButton2 then edt := Edit8
else edt := Edit6;
if not GB_fxFlag then begin
with edt do begin
n := StrToIntDef('$' + Copy(Text, 2), 0);
Dec(n);
if n < 0 then n := 0;
Text := Copy(Text, 1, 1) + n.ToHexString(3);
Font.Color := RGB($FF, $A5, $00);
end;
n := n - GB_DeviceStartNo;
if n >= 0 then begin
with StringGrid1 do begin
r := n div 16 + 1;
c := n mod 16 + 1;
if (r > 0) and (c > 0) and (r < RowCount) and (c < ColCount) then begin
OnClick := nil;
Row := r;
Col := c;
OnClick := StringGrid1Click;
end;
end;
end;
end
else begin
with edt do begin
n := OctToIntDef(Copy(Text, 2), 0);
Dec(n);
if n < 0 then n := 0;
Text := Copy(Text, 1, 1) + IntToOct(n, 3);
Font.Color := RGB($FF, $A5, $00);
end;
n := n - GB_DeviceStartNo;
if n >= 0 then begin
with StringGrid1 do begin
r := n div 8 + 1;
c := n mod 8 + 1;
if (r > 0) and (c > 0) and (r < RowCount) and (c < ColCount) then begin
OnClick := nil;
Row := r;
Col := c;
OnClick := StringGrid1Click;
end;
end;
end;
end;
end;
procedure TForm4.SpeedButton5Click(Sender: TObject);
begin
Form1.ShowModal;
end;
procedure TForm4.StringGrid1Click(Sender: TObject);
// 出力先
var
s : string;
begin
with StringGrid1 do begin
if not GB_fxFlag or (GB_fxFlag and (Col <= 8)) then begin
s := IntToHex(StrToIntDef('$'+Cells[0, Row], 0) + StrToIntDef('$'+Cells[Col, 0], 0), 3);
Edit11.Text := GetDeviceComment(Cells[0, 0] + s);
with Edit8 do begin
Text := 'Y' + s;
Font.Color := RGB($FF, $A5, $00);
end;
with Edit6 do begin
Text := 'X' + s;
Font.Color := RGB($FF, $A5, $00);
end;
end;
end;
end;
procedure TForm4.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
ARect : TRect;
s : string;
scale : double;
flag : boolean;
n : integer;
begin
flag := False;
scale := GB_SgScale;
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 (Edit4.Text = 'ON') or (Edit4.Text = 'OFF') then begin
if not GB_fxFlag then
n := StrToIntDef('$' + Copy(Edit3.Text, 2), -1)
else
n := OctToIntDef(Copy(Edit3.Text, 2), -1);
if n >= GB_DeviceStartNo then begin
n := n - GB_DeviceStartNo;
if (not GB_fxFlag and (ARow = n div 16 + 1) and (ACol = n mod 16 + 1)) or
(GB_fxFlag and (ARow = n div 8 + 1) and (ACol = n mod 8 + 1)) then begin
flag := True;
if Edit4.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 := Copy(Edit3.Text, 2);
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(Sender as TStringGrid, Key, Shift);
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
i, j, devN : integer;
lSize : integer;
szDevice : WideString;
s : string;
flag : boolean;
SpeechFlag : boolean;
begin
SpeechFlag := False;
Timer1.Enabled := False;
with ActUtlType1 do begin
// CPU Type
if Edit9.Text = '' then begin
GetCpuType(szDevice, lSize);
Edit9.Text := szDevice;
// FX であるか
flag := Pos('FX', Edit9.Text) = 1;
if flag <> GB_fxFlag then begin
CheckBox1.Checked := flag;
CheckBox1Click(self);
end;
end;
if GB_fxFlag then devN := 8
else devN := 16;
lSize := 1; // 1 ワード(ビットデバイスでは16点)
for i := 0 to 7 do begin
WordAryNew[i] := 0;
if not GB_fxFlag then
szDevice := GB_DeviceHead + (GB_DeviceStartNo + i * 16).ToHexString
else
szDevice := GB_DeviceHead + IntToOct(GB_DeviceStartNo + i * 16, 4);
if ReadDeviceBlock2(szDevice, lSize, WordAryNew[i]) <> 0 then begin
WordAryNew[i] := 0;
break;
end;
end;
// 内部データに格納 8 x 16 = 128 個
// FX の時グリッド表示は、 8 x 8 = 64 個
for i := 0 to 7 do begin
for j := 0 to 15 do
BitAryNew[i * 16 + j] := WordAryNew[i] and IntPower(2, j) > 0;
end;
for i := 0 to 128 - 1 do begin
if not GB_fxFlag then
s := IntToHex(GB_DeviceStartNo + i, 3)
else
s := IntToOct(GB_DeviceStartNo + i, 3);
if BitAryNew[i] and not BitAryOld[i] then begin
Edit3.Text := GB_DeviceHead + s;
Edit3.Font.Color := clRed;
Edit4.Text := 'ON';
Edit4.Font.Color := clRed;
StringGrid1.Repaint;
Edit11.Text := GetDeviceComment(Edit3.Text);
SpeechFlag := True;
end
else if not BitAryNew[i] and BitAryOld[i] then begin
Edit3.Text := GB_DeviceHead + s;
Edit3.Font.Color := clLime;
Edit4.Text := 'OFF';
Edit4.Font.Color := clLime;
StringGrid1.Repaint;
Edit11.Text := GetDeviceComment(Edit3.Text);
SpeechFlag := True;
end;
with StringGrid1 do begin
if BitAryNew[i] then begin
if Cells[i mod devN + 1, i div devN + 1] <> s then
Cells[i mod devN + 1, i div devN + 1] := s ;
end
else Cells[i mod devN + 1, i div devN + 1] := '';
end;
end;
BitAryOld := BitAryNew;
if Label5.Caption <> '■' then Label5.Caption := '■'
else Label5.Caption := '□';
// テキストスピーチ
if CheckBox2.Checked and SpeechFlag and TTSFlag then begin
Application.ProcessMessages;
s := Copy(Edit3.Text, 1,1) {+ #13} + NumToSpeechText(Copy(Edit3.Text, 2));
if CheckBox3.Checked then s := s + Edit11.Text + #13;
if Edit4.Text = 'ON' then s := s + 'オンン'
else s := s + 'オフ';
SpVoice.Speak(s, SVSFDefault);
end;
end;
Timer1.Enabled := True;
end;
end.
// ---------------------------------------------------------------
// Android 側
//
// TextToSpeech :
// Androidapi.JNI.TTS, AndroidAPI.JNIBridge は、GitHub よりダウンロード
// https://github.com/jimmckeeth/FireMonkey-Android-Voice/tree/master/JNIBridge
// ---------------------------------------------------------------
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..127] 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;
Rectangle6: TRectangle;
Label8: TLabel;
Rectangle7: TRectangle;
Label9: TLabel;
Rectangle8: TRectangle;
Label10: TLabel;
Button1: TButton;
Label11: TLabel;
Rectangle9: TRectangle;
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;
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;
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 進数 -> 10進数
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;
// 10 進数 -> 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 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.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;
lbl : TLabel;
begin
if Sender as TButton = Button6 then
lbl := Label3
else
lbl := Label8;
if (ASocket <> nil) and ASocket.Connected then begin
Timer1.Enabled := False;
ATimeout := 250;
AData := TEncoding.ANSI.GetBytes('WR ' + lbl.Text + ' 1' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
with lbl.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.CheckBox1Change(Sender: TObject);
var
i :integer;
begin
GB_fxFlag := CheckBox1.IsChecked;
// 初期に戻す
with StringGrid1 do begin
if not GB_fxFlag then
for i := 0 to 7 do Cells[0, i] := (i * 16).ToHexString(3)
else
for i := 0 to 7 do Cells[0, i] := IntToOct(i * 8, 3);
Row := 0;
Col := 1;
end;
with ComboBox2 do begin
BeginUpdate;
Items.Clear;
if not GB_fxFlag then
for i := 0 to 255 do Items.Add(IntToHex(i * 32, 3))
else
for i := 0 to 255 do Items.Add(IntToOct(i * 16, 3));
EndUpdate;
ItemIndex := 0;
end;
// X に戻す
with ComboBox1 do begin
ItemIndex := 0;
end;
Label8.Text := 'X000';
Label3.Text := 'Y000';
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 127 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 * 32, 4)
else
s2 := IntToHex(ItemIndex * 16, 4);
end;
end;
AData := TEncoding.ANSI.GetBytes('CF ' + 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, '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;
// 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 : integer;
lbl : TLabel;
begin
if Sender as TRectangle = Rectangle1 then lbl := Label3
else lbl := Label8;
if not GB_fxFlag then begin
n := StrToIntDef('$' + Copy(lbl.Text, 2), 0);
Inc(n);
with lbl 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(lbl.Text, 2), 0);
Inc(n);
with lbl 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.Rectangle2Click(Sender: TObject);
// [ - ]
var
n : integer;
lbl : TLabel;
begin
if Sender as TRectangle = Rectangle2 then lbl := Label3
else lbl := Label8;
if not GB_fxFlag then begin
n := StrToIntDef('$' + Copy(lbl.Text, 2), 0);
Dec(n);
if n < 0 then n := 0;
with lbl 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(lbl.Text, 2), 0);
Dec(n);
if n < 0 then n := 0;
with lbl 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 := 'Y'+ n.ToHexString(3);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
with Label8 do begin
Text := 'X'+ 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 : integer;
Ticks : Cardinal;
j : integer;
s, s1 : string;
n, idx : integer;
flag : boolean;
fxFlag : boolean;
devN, devM : integer;
ttsFlag : boolean;
begin
ttsFlag := False;
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);
Label7.Text := res;
flag := res <> '';
fxFlag := (Pos('FX', Label7.Text) = 1) or (res = '');
if GB_fxFlag <> fxFlag then begin
CheckBox1.IsChecked := fxFlag;
CheckBox1Change(self);
// GB_fxFlag := fxFlag; // CheckBox1Chenge イベントに含まれる
end;
end
else begin
if GB_fxFlag then begin
devN := 8;
devM := 64;
end
else begin
devN := 16;
devM := 128;
end;
if Flag then begin
// デバイス一括読み出しコマンド
AData := TEncoding.ANSI.GetBytes('RD' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
flag := res <> '';
// データ格納
if res.Length >= 64 then begin
for i := 0 to 7 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 + 32, 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, 66); // スペース１個ある
if s <> '' then begin
n := Pos(' ', s);
if n > 0 then begin
// デバイス番号
s1 := Copy(s, 1, n - 1);
s := Copy(s, n + 1);
n := Pos(' ', s);
if n = 0 then begin
idx := StrToIntDef('$' + s, 0);
Label11.Text := ''; // コメント
end
else begin
// 先頭デバイス番号（PC からの応答は 16 進表記）
idx := StrToIntDef('$' + Copy(s, 1, n - 1), 0);
// コメント
Label11.Text := Copy(s, n + 1);
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 32
else
ItemIndex := GB_DeviceStartIndex div 16;
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 7 do
Cells[0, i] := (GB_DeviceStartIndex + i * 16).ToHexString(3);
end
else begin
for i := 0 to 7 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
Label8.Text := 'X' + IntToHex(GB_DeviceStartIndex, 3);
Label3.Text := 'Y' + IntToHex(GB_DeviceStartIndex, 3);
end
else begin
Label8.Text := 'X' + IntToOct(GB_DeviceStartIndex, 3);
Label3.Text := 'Y' + IntToOct(GB_DeviceStartIndex, 3);
end;
end;
end;
end;
end;
end;
// 表示
with StringGrid1 do begin
for i := 0 to devM -1 do begin
if BitAryNew[i] then begin
s := (i mod devN).ToHexString(1);
if Cells[i mod devN + 1, i div devN] <> s then
Cells[i mod devN + 1, i div devN] := s ;
end
else begin
if Cells[i mod devN + 1, i div devN] <> '' then
Cells[i mod devN + 1, i div devN] := '';
end;
end;
end;
// 比較
// 内部データ数 = 128, FX は先頭 64 データのみ表示される
for i := 0 to 128 -1 do begin
idx := i + GB_DeviceStartIndex;
if BitAryNew[i] and not BitAryOld[i] then begin
Rectangle4.Fill.Color := TAlphaColorRec.Red;
with Label1 do begin
if not GB_fxFlag then
Text := GB_DeviceName + idx.ToHexstring(3)
else
Text := GB_DeviceName + IntToOct(idx, 3);
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
if not GB_fxFlag then
Text := GB_DeviceName + idx.ToHexstring(3)
else
Text := GB_DeviceName + IntToOct(idx, 3);
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 :=Copy(Label1.Text, 1, 1) + #13 + NumToSpeechText(Copy(Label1.Text, 2));
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
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.
