// ----------------------
// Windows側
// ----------------------
unit KvComPlusUnit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls,
DATABUILDERAXLibEx_TLB, Vcl.OleServer, Vcl.Buttons,
Vcl.Grids, Vcl.ExtCtrls, OoMisc, AdPort, AdSelCom, AdPacket, IniFiles,
Vcl.ComCtrls, Vcl.ExtDlgs, System.UITypes, ClipBrd,
SpeechLib_TLB, ComObj;
type
TWordAry = array [0.. 9] of Word;
TBoolAry = array [0.. 159] of boolean;
type
TForm4 = class(TForm)
DBCommManager1: TDBCommManager;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Timer1: TTimer;
ApdComPort1: TApdComPort;
ApdDataPacket1: TApdDataPacket;
Label1: TLabel;
Edit1: TEdit;
SpeedButton2: TSpeedButton;
SpeedButton1: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
ComboBox1: TComboBox;
Button2: TButton;
Button3: TButton;
ComboBox2: TComboBox;
Edit3: TEdit;
Edit4: TEdit;
Edit2: TEdit;
Button1: TButton;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Button4: TButton;
OpenTextFileDialog1: TOpenTextFileDialog;
Edit5: TEdit;
Button5: TButton;
SaveTextFileDialog1: TSaveTextFileDialog;
Button6: TButton;
Edit6: TEdit;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Edit7: TEdit;
Edit8: TEdit;
Label5: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure StringGrid1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
procedure Edit1Change(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure StringGrid2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Button6Click(Sender: TObject);
procedure Edit7Change(Sender: TObject);
procedure Edit8Change(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
GB_SgTextScale : double;
GB_SgWidthScale : double;
procedure ReadCommentFile(const FileName : TFileName);
procedure SaveCommentFile(const FileName : TFileName);
function GetDeviceComment(const devStr : string): string;
end;
var
Form4: TForm4;
WordAryNew : TWordAry;
WordAryOld : TWordAry;
BoolAryNew : TBoolAry;
BoolAryOld : TBoolAry;
SpVoice: OleVariant;
TTSFlag : boolean;
const
DEV_RLY_B = $00;
DEV_RLY_W = $19;
DEV_CR_W = $64;
DEV_CR = $0A;
implementation
{$R *.dfm}
uses KvComPlusUnit5;
// n の k 乗 (Math ユニット不要)
function IntPower(n, k : integer):integer;
var
i : integer;
begin
result := 1;
for i := 1 to k do result := result * n;
end;
// *****************************
// StringGrid でのキー操作
// *****************************
procedure SgKeyDown(SG: TSTringGrid; var Key: Word; Shift: TShiftState);
var
i, j, k, n : integer;
sl : TStringList;
s, s1 : string;
xflag : boolean;
begin
if Key = VK_DELETE then begin
with SG do begin
if (Selection.Top <> Selection.Bottom) or
(Selection.Left <> Selection.Right) then begin
Key := 0;
for i := Selection.Top to Selection.Bottom do
for j := Selection.Left to Selection.Right do
Cells[j, i] := '';
end;
end;
end;
if ssCtrl in Shift then begin
if true then begin
xflag := (Key = Ord('X')) or (Key = Ord('x'));
if (Key = Ord('C')) or (Key = Ord('c')) or xflag then begin
Key := 0;
Clipboard.AsText := '';
with SG do begin
for i := Selection.Top to Selection.Bottom do begin
for j := Selection.Left to Selection.Right do begin
Clipboard.AsText := Clipboard.AsText + Cells[j, i];
if j < Selection.Right then
Clipboard.AsText := Clipboard.AsText + #9
else Clipboard.AsText :=
Clipboard.AsText + #13#10;
end;
end;
if xflag then begin
for i := Selection.Top to Selection.Bottom do
for j := Selection.Left to Selection.Right do
Cells[j, i] := '';
end;
end;
end
else if (Key = Ord('V')) or (Key = Ord('v')) then begin
//with SG do
// if EditorMode then EditorMode := false;
Key := 0;
with SG do begin
sl := TStringList.Create;
try
s := Clipboard.AsText;
while true do begin
k := Pos(#13#10, s);
if k = 0 then break
else begin
sl.Add(Copy(s, 1, k - 1));
Delete(s, 1, k + 1);
end;
end;
for i := 0 to sl.Count-1 do begin
s := SL[i];
j := 0;
while true do begin
k := Pos(#9, s);
if k = 0 then
s1 := Copy(s, 1, Length(s))
else begin
s1 := Copy(s, 1, k - 1);
Delete(s, 1, k);
end;
Cells[Selection.Left + j, Selection.Top + i] := s1;
n := 1;
while true do begin
if Selection.Bottom < Selection.Top + i + (sl.Count * n) then
break
else
Cells[Selection.Left + j, Selection.Top + i + (sl.Count * n)] := s1;
Inc(n);
end;
if k = 0 then break;
Inc(j);
end;
end;
finally
sl.Free;
end;
end;
end;
end;
end;
end;
// --------------------------------------------
function NumToSpeechText(const hex : string): string;
var
i : integer;
s : string;
begin
result := '';
for i := 1 to hex.Length do begin
s := Copy(hex, i, 1);
if s = '0' then result := result + 'ゼロ'
else if s = '1' then result := result + 'イチ'
else if s = '2' then result := result + 'ニイ'
else if s = '3' then result := result + 'サン'
else if s = '4' then result := result + 'ヨン'
else if s = '5' then result := result + 'ゴオ'
else if s = '6' then result := result + 'ロク'
else if s = '7' then result := result + 'ナナ'
else if s = '8' then result := result + 'ハチ'
else if s = '9' then result := result + 'キュウ'
else if s = 'A' then result := result + 'エイ'
else if s = 'B' then result := result + 'ビイ'
else if s = 'C' then result := result + 'シイ'
else if s = 'D' then result := result + 'デー'
else if s = 'E' then result := result + 'イイ'
else if s = 'F' then result := result + 'エフ'
else result := result + s;
result := result + ' ';
end;
end;
procedure TForm4.ReadCommentFile(const FileName : TFileName);
// コメントファイル読み込み
var
sl : TStringList;
cnt : integer;
i, n : integer;
s, s1, s2 :string;
begin
cnt := 0;
sl := TStringList.Create;
try
sl.LoadFromFile(FileName);
for i := 0 to sl.Count - 1 do begin
n := Pos(',', sl[i]);
s1 := Copy(sl[i], 1, n- 1);
s2 := Copy(sl[i], n + 1);
s := Uppercase(Copy(s1, 1, 1));
with StringGrid2 do begin
Inc(cnt);
if RowCount <= cnt then
RowCount := RowCount + 1;
Cells[0, cnt] := s1;
Cells[1, cnt] := s2;
end;
end;
finally
sl.Free;
end;
with StringGrid2 do begin
if cnt > 0 then begin
if cnt < RowCount then
RowCount := cnt;
end
else begin
RowCount := 2;
Cells[0, 1] := '';
Cells[1, 1] := '';
end;
end;
end;
procedure TForm4.SaveCommentFile(const FileName : TFileName);
// コメントファイル保存
var
sl : TStringList;
i : integer;
begin
sl := TStringList.Create;
try
with StringGrid2 do begin
for i := 1 to RowCount -1 do
sl.Add(Cells[0, i] + ',' + Cells[1, i]);
end;
sl.SaveToFile(FileName);
finally
sl.Free;
end;
end;
function TForm4.GetDeviceComment(const devStr : string): string;
// Gdid2 からコメントを取得
var
i, n : integer;
s : string;
begin
result := '';
n := StrToIntDef(devStr, 0);
with StringGrid2 do begin
for i := 1 to RowCount - 1 do begin
s := Cells[0, i];
if (s <> '') and (n = StrToIntDef(s, 0)) then begin
result := Cells[1, i];
break;
end;
end;
end;
end;
procedure TForm4.ApdDataPacket1StringPacket(Sender: TObject; Data: AnsiString);
// スマホ Bluetooth から受信
var
cmd, s, res : string;
i, ret, ret1 : integer;
begin
cmd := Trim(string(Data));
Label5.Caption := cmd;
if cmd = 'CPU' then begin
res := ComboBox1.Text;
ApdComPort1.PutString(res + #13#10);
end
else if cmd = 'RD' then begin
res := '';
// 今回値
for i := 0 to 9 do
res := res + WordAryNew[i].ToHexString(4);
// 前回値
for i := 0 to 9 do
res := res + WordAryOld[i].ToHexString(4);
// 先頭番号
res := res + ' ' + Edit1.Text;
// コメント
// 表示中のアドレス
if Edit2.Text <> '' then begin
s := GetDeviceComment(Edit2.Text);
if s <> '' then res := res + ' ' + s;
end;
ApdComPort1.PutString(res + #13#10);
//Caption := res;
// 前回値を更新
WordAryOld := WordAryNew;
end
else if Pos('WR ', cmd) = 1 then begin
s := Copy(cmd, 4);
ret := DBCommManager1.ReadDevice(DEV_RLY_B, s);
DBCommManager1.WriteDevice(DEV_RLY_B, s, abs(ret - 1));
ret1 := DBCommManager1.ReadDevice(DEV_RLY_B, s);
if ret1 = 1 then res := 'ON'
else res := 'OFF';
ApdComPort1.PutString(res + #13#10);
end
else if Pos('CF ', cmd) = 1 then begin
Edit1.Text := Copy(cmd, 4);
ApdComPort1.PutString('OK' + #13#10);
end
else
ApdComPort1.PutString('??' + #13#10);
end;
procedure TForm4.Button1Click(Sender: TObject);
// 手動反転操作
var
ret, idx, ans : integer;
s : string;
begin
try
if DBCommManager1.Active then begin
idx := StrToIntDef(Edit4.Text, 0);
ret := DBCommManager1.ReadDevice(DEV_RLY_B, idx.Tostring);
DBCommManager1.WriteDevice(DEV_RLY_B, idx.Tostring, abs(ret - 1));
ans := DBCommManager1.ReadDevice(DEV_RLY_B, idx.Tostring);
if ret = ans then
Edit4.Font.Color := clYellow
else if ans = 1 then
Edit4.Font.Color := clRed
else
Edit4.Font.Color := clLime;
end;
except
on E: Exception do begin
s := E.ClassName + sLineBreak + E.Message;
Application.MessageBox(PChar(s), '情報', MB_ICONINFORMATION);
end;
end;
end;
procedure TForm4.Button2Click(Sender: TObject);
// 接続
var
plcType : integer;
s : string;
begin
with ApdComPort1 do begin
s := Copy(ComboBox2.Text, 4);
s := Copy(s, 1, Length(s) -1);
ComNumber := StrToIntDef(s, 4);
Baud := 9600;
StopBits := 1;
DataBits := 8;
Parity := TParity.pNone;
SWFlowOptions := TSWFlowOptions.swfNone;
end;
with ApdDataPacket1 do begin
Enabled := False;
EndCond := [ecString];
EndString := #13#10;
StartCond := scAnyData;
TimeOut := 500;
end;
try
ApdComPort1.Open := True;
if ApdComPort1.Open then begin
ApdDataPacket1.Enabled := True;
ComboBox2.Enabled := False;
end;
except
ShowMessage('ComPort Open Error');
end;
// KV Com +
plcType := -1;
with ComboBox1 do begin
if ItemIndex >= 0 then
plcType := Integer(Items.Objects[ItemIndex]);
end;
if plcType >= 0 then begin
DBCommManager1.Peer := 'USB';
DBCommManager1.PLC := plcType;
try
// 接続
DBCommManager1.Connect;
ComboBox1.Enabled := not DBCommManager1.Active;
Timer1.Enabled := DBCommManager1.Active;
except
on E: Exception do begin
s := E.ClassName + sLineBreak + E.Message;
Application.MessageBox(PChar(s), '情報', MB_ICONINFORMATION);
end;
end;
end;
end;
procedure TForm4.Button3Click(Sender: TObject);
// 切断
begin
// KV Com + 切断
if DBCommManager1.Active then begin
DBCommManager1.Disconnect;
ComboBox1.Enabled := not DBCommManager1.Active;
end;
// Bluetooth SPP 通信（仮想 COM ポート）切断
if ApdComPort1.Open then begin
ApdComPort1.Open := False;
ComboBox2.Enabled := True;
end;
end;
procedure TForm4.Button4Click(Sender: TObject);
// コメントファイル読み込み
begin
OpenTextFileDialog1.InitialDir := ExtractFileDir(Edit5.Text);
if OpenTextFileDialog1.Execute then begin
Edit5.Text := OpenTextFileDialog1.FileName;
ReadCommentFile(Edit5.Text);
end;
end;
procedure TForm4.Button5Click(Sender: TObject);
// コメントファイル保存
var
fname : TFileName;
flag : boolean;
begin
if (StringGrid2.Cells[0, 1] <> '') then begin
SaveTextFileDialog1.InitialDir := ExtractFileDir(Edit5.Text);
if SaveTextFileDialog1.Execute then begin
fname := SaveTextFileDialog1.FileName;
if ExtractFileExt(fname) = '' then fname := fname + '.csv';
flag := True;
if FileExists(fname) then
flag := MessageDlg('すでにファイルが存在します．上書きしますか？', mtInformation, [mbYes, mbNo], 0) = mrYes;
if flag then begin
SaveCommentFile(fname);
Edit5.Text := fname;
end;
end;
end;
end;
procedure TForm4.Button6Click(Sender: TObject);
// コメント用デバイス番号作成
var
ret, st, ed, i, j, cnt : integer;
begin
with Form5 do begin
ret := ShowModal;
if ret <> mrCancel then begin
st := StrToInt(Edit1.Text);
ed := StrToInt(Edit2.Text);
cnt := 0;
with Form4.StringGrid2 do begin
RowCount := ((ed - st) div 100 + 1) * 16 + 1;
for i := st div 100 to ed div 100 do begin
for j := 0 to 15 do begin
Cells[0, cnt + 1] := Format('%.4d', [i * 100 + j]);
Inc(cnt);
end;
end;
end;
if ret = mrYes then begin
st := StrToInt(Edit3.Text);
ed := StrToInt(Edit4.Text);
with Form4.StringGrid2 do begin
RowCount := RowCount + ((ed - st) div 100 + 1) * 16;
for i := st div 100 to ed div 100 do begin
for j := 0 to 15 do begin
Cells[0, cnt + 1] := Format('%.4d', [i * 100 + j]);
Inc(cnt);
end;
end;
end;
end;
end;
end;
end;
procedure TForm4.Edit1Change(Sender: TObject);
// 先頭アドレス変更された
var
i, idx : integer;
begin
idx := StrToIntDef(Edit1.Text, 0);
with StringGrid1 do begin
for i := 0 to 9 do
Cells[0, i +1] := Format('%.4d', [idx + i*100]);
end;
// 初期化
for i := 0 to 9 do WordAryNew[i] := 0;
WordAryOld := WordAryNew;
for i := 0 to 159 do BoolAryNew[i] := False;
BoolAryOld := BoolAryNew;
Edit2.Text := '';
Edit3.Text := '';
end;
procedure TForm4.Edit7Change(Sender: TObject);
// Grid1 文字サイズの調整
begin
GB_SgTextScale := StrToFloatDef(Edit7.Text, 2.0);
StringGrid1.Repaint;
end;
procedure TForm4.Edit8Change(Sender: TObject);
// Grid2 列幅の調整
begin
GB_SgWidthScale := StrToFloatDef(Edit8.Text, 1.0);
StringGrid2.ColWidths[1] := Trunc(250 * GB_SgWidthScale);
StringGrid2.Repaint;
end;
procedure TForm4.FormCreate(Sender: TObject);
// フォーム生成
var
i : integer;
ini : TIniFile;
begin
GB_SgTextScale := 2.0;
GB_SgWidthScale := 2.0;
Edit5.Text := '';
Edit6.Text := '';
Label2.Caption := '';
Label5.Caption := '';
AdSelCom.ShowPortsInUse := False;
for i := 0 to 32 do
if AdSelCom.IsPortAvailable(i) then
ComboBox2.Items.Add (AdPort.ComName(i) + '.');
with ComboBox1 do begin
Items.AddObject('KV-7000', TObject(StrToInt('$020D')));
Items.AddObject('KV-7000 <XYM>', TObject(StrToInt('$120D')));
Items.AddObject('KV-5500/ 5000/ 3000', TObject(StrToInt('$0203')));
Items.AddObject('KV-5500/ 5000/ 3000 <XYM>', TObject(StrToInt('$1203')));
Items.AddObject('KV-1000/ 700', TObject(StrToInt('$0007')));
Items.AddObject('KV-1000 <XYM>', TObject(StrToInt('$1007')));
Items.AddObject('KV Nano [KV-N*]', TObject(StrToInt('$0208')));
Items.AddObject('KV Nano [KV-N*] <XYM>', TObject(StrToInt('$1208')));
end;
with StringGrid1 do begin
Cells[0, 0] := 'R';
for i := 0 to 15 do
Cells[i +1, 0] := i.ToString;
for i := 0 to 9 do
Cells[0, i +1] := Format('%.4d', [i*100]);
end;
with StringGrid2 do begin
ColWidths[1] := Trunc(250 * GB_SgWidthScale);
Cells[0, 0] := ' デバイス';
Cells[1, 0] := ' コメント';
end;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
i := ini.ReadInteger('COM', 'PortIndex', 0);
if ComboBox2.Items.Count > i then ComboBox2.ItemIndex := i;
i := ini.ReadInteger('KVCOM', 'PLCIndex', 0);
if ComboBox1.Items.Count > i then ComboBox1.ItemIndex := i;
Edit5.Text := ini.ReadString('Comment', 'FileName', '');
Edit7.Text := ini.ReadString('Grid', 'TextScale', GB_SgTextScale.ToString);
Edit8.Text := ini.ReadString('Grid', 'WidthScale', GB_SgWidthScale.ToString);
finally
ini.Free;
end;
TTSFlag := False;
try
SpVoice := CreateOleObject('SAPI.SpVoice');
TTSFlag := True;
CheckBox1.Enabled := True;
CheckBox2.Enabled := True;
except
;
end;
end;
procedure TForm4.FormDestroy(Sender: TObject);
// フォーム破棄
var
ini: TIniFile;
begin
if DBCommManager1.Active then DBCommManager1.Disconnect;
if ApdComPort1.Open then ApdComPort1.Open := False;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
ini.WriteInteger('COM', 'PortIndex', ComboBox2.ItemIndex);
ini.WriteInteger('KVCOM', 'PLCIndex', ComboBox1.ItemIndex);
ini.WriteString('Comment', 'FileName', Edit5.Text);
ini.WriteString('Grid', 'TextScale', Edit7.Text);
ini.WriteString('Grid', 'WidthScale', Edit8.Text);
finally
ini.Free;
end;
end;
procedure TForm4.FormShow(Sender: TObject);
begin
if (Edit5.Text <> '') and FileExists(Edit5.Text) then begin
if MessageDlg(
'前回終了時のコメントファイル' + #13 +
Edit5.Text + #13 + 'を、読み込みますか？',
mtInformation, [mbYes, mbNo], 0) = mrYes then
ReadCommentFile(Edit5.Text)
else if MessageDlg(
'前回終了時のコメントファイル名' + #13 +
Edit5.Text + #13 + 'を、削除しますか？',
mtInformation, [mbYes, mbNo], 0) = mrYes then
Edit5.Text := '';
end;
end;
procedure TForm4.SpeedButton1Click(Sender: TObject);
// 先頭アドレス +10000, +1000
var
idx : integer;
begin
idx := StrToIntDef(Edit1.Text, 0);
if Sender as TSpeedButton = SpeedButton1 then
idx := idx + 1000
else
idx := idx + 10000;
if idx > 59000 then idx := 59000;
Edit1.Text := Format('%.4d', [idx]);
end;
procedure TForm4.SpeedButton3Click(Sender: TObject);
// 先頭アドレス -10000, -1000
var
idx : integer;
begin
idx := StrToIntDef(Edit1.Text, 0);
if Sender as TSpeedButton = SpeedButton3 then
idx := idx - 1000
else
idx := idx - 10000;
if idx < 0 then idx := 0;
Edit1.Text := Format('%.4d', [idx]);
end;
procedure TForm4.SpeedButton7Click(Sender: TObject);
// 反転対象 + 100, +1
var
idx : integer;
dv, md : integer;
begin
idx := StrToIntDef(Edit4.Text, 0);
dv := idx div 100;
md := idx mod 100;
if Sender as TSpeedButton = SpeedButton7 then begin
Inc(dv);
if dv > 599 then dv := 599;
end
else begin
Inc(md);
if md > 15 then begin
Inc(dv);
if dv > 599 then begin
dv := 599;
md := 15;
end
else begin
md := 0;
end;
end;
end;
Edit4.Text := Format('%.4d', [dv * 100 + md]);
Edit4.Font.Color := clWhite;
end;
procedure TForm4.SpeedButton8Click(Sender: TObject);
// 反転対象 -100, -1
var
idx : integer;
dv, md : integer;
begin
idx := StrToIntDef(Edit4.Text, 0);
dv := idx div 100;
md := idx mod 100;
if Sender as TSpeedButton = SpeedButton8 then begin
Dec(dv);
if dv < 0 then dv := 0;
end
else begin
Dec(md);
if (md < 0) and (dv > 0) then begin
md := 15;
Dec(dv);
if dv < 0 then begin
dv := 0;
md := 0;
end;
end;
end;
if dv < 0 then dv := 0;
if md < 0 then md := 0;
Edit4.Text := Format('%.4d', [dv * 100 + md]);
Edit4.Font.Color := clWhite;
end;
procedure TForm4.StringGrid1Click(Sender: TObject);
// 手動反転操作の対象を変える
var
idx : integer;
begin
idx := StrToIntDef(Edit1.Text, 0);
with StringGrid1 do
Edit4.Text := Format('%.4d', [idx + (Row - 1) * 100 + Col -1]);
Edit4.Font.Color := clWhite;
end;
procedure TForm4.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
// Grid 描画
var
ARect : TRect;
s : string;
scale : double;
flag : boolean;
n : integer;
idx : integer;
begin
flag := False;
scale := GB_SgTextScale;
ARect := Rect;
ARect.Top := Rect.Top + 1;
ARect.Bottom := Rect.Bottom - 1;
ARect.Left := Rect.Left + 1;
ARect.Right := Rect.Right - 1;
with StringGrid1 do begin
s := Cells[ACol, ARow];
if (ARow = 0) or (ACol = 0) then begin
if (ARow = 0) and (ACol = 0) then begin
Canvas.Brush.Color := clLime;
Canvas.FillRect(Rect);
Canvas.Font.Height := Trunc(20 * scale);
Canvas.Font.Color := clBlack;
end
else begin
Canvas.Brush.Color := clSilver;
Canvas.FillRect(Rect);
Canvas.Font.Height := Trunc(20 * scale);
Canvas.Font.Color := clGray;
end;
DrawText(Canvas.Handle, PChar(s), Length(s), ARect, DT_CENTER);
end
else begin
if (Edit3.Text = 'ON') or (Edit3.Text = 'OFF') then begin
idx := StrToIntDef(Edit1.Text, 0);
n := StrToIntDef(Edit2.Text, -1);
if n >= idx then begin
n := n - idx;
if (ARow = n div 100 + 1) and (ACol = n mod 100 + 1) then begin
flag := True;
if Edit3.Text = 'ON' then begin
Canvas.Brush.Color := clRed;
Canvas.FillRect(ARect);
Canvas.Font.Height := Trunc(20 * scale);
Canvas.Font.Color := clWhite;
end
else begin
Canvas.Brush.Color := clLime;
Canvas.FillRect(ARect);
Canvas.Font.Height := Trunc(20 * scale);
Canvas.Font.Color := clBlack;
s := Edit2.Text;
end;
end;
end;
end;
if not flag and (s <> '') then begin
Canvas.Brush.Color := RGB($FF, $A5, $00);
Canvas.FillRect(ARect);
Canvas.Font.Height := Trunc(20 * scale);
Canvas.Font.Color := clWhite;
end;
if s <> '' then
DrawText(Canvas.Handle, PChar(s), Length(s), ARect, DT_CENTER);
end;
end;
end;
procedure TForm4.StringGrid2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
// コメント編集でのキー操作
begin
SgKeyDown(StringGrid2, Key, Shift);
end;
procedure TForm4.Timer1Timer(Sender: TObject);
// ポーリング
var
i, idx : integer;
j: Integer;
s , devNo : string;
SpeechFlag : boolean;
begin
SpeechFlag := False;
Timer1.Enabled := False;
try
if DBCommManager1.Active then begin
idx := StrToIntDef(Edit1.Text, 0);
for i := 0 to 9 do
WordAryNew[i] := DBCommManager1.ReadDevice(DEV_RLY_W, Format('%.4d', [idx + i * 100]));
// 内部データに
for i := 0 to 9 do begin
for j := 0 to 15 do
BoolAryNew[i * 16 + j] := WordAryNew[i] and IntPower(2, j) > 0;
end;
// 比較
for i := 0 to 159 do begin
devNo := Format('%.4d', [idx + (i div 16) * 100 + i mod 16]);
// OFF -> ON
if not BoolAryOld[i] and BoolAryNew[i] then begin
Edit2.Text := devNo;
Edit3.Text := 'ON';
Edit2.Font.Color := clRed;
Edit3.Font.Color := clRed;
Edit6.Text := GetDeviceComment(devNo);
SpeechFlag := True;
end
// ON -> OFF
else if BoolAryOld[i] and not BoolAryNew[i] then begin
Edit2.Text := devNo;
Edit3.Text := 'OFF';
Edit2.Font.Color := clLime;
Edit3.Font.Color := clLime;
Edit6.Text := GetDeviceComment(devNo);
SpeechFlag := True;
end
else begin
with StringGrid1 do begin
if BoolAryNew[i] then
Cells[i mod 16 +1, i div 16 +1] := devNo
else
Cells[i mod 16 +1, i div 16 +1] := '';
end;
end;
end;
// 前回値を更新
BoolAryOld := BoolAryNew;
if Label2.Caption = '' then Label2.Caption := '■'
else Label2.Caption := '';
// テキストスピーチ
if CheckBox1.Checked and SpeechFlag and TTSFlag then begin
Repaint;
StringGrid1.Repaint;
Application.ProcessMessages;
s := NumToSpeechText(Edit2.Text);
if CheckBox2.Checked then s := s + Edit6.Text + #13;
if Edit3.Text = 'ON' then s := s + '、オオン'
else s := s + '、オフ';
SpVoice.Speak(s, SVSFDefault);
end;
end;
Timer1.Enabled := True;
except
on E: Exception do begin
s := E.ClassName + sLineBreak + E.Message;
Application.MessageBox(PChar(s), '情報', MB_ICONINFORMATION);
end;
end;
end;
end.
// ------------------
// Android 側
// ------------------
// Android 側
// 2019/02/17 FX5U にてテスト
// 2019/02/20 PC 名のコンボボックスを追加
unit Unit4;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
System.Bluetooth, System.Bluetooth.Components, FMX.ScrollBox, FMX.Memo,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.Edit, System.Rtti,
FMX.Grid.Style, FMX.Grid,{ Math,} FMX.Objects, System.UIConsts, FMX.ListBox,
System.IOUtils, System.IniFiles,
// for TTS
Androidapi.JNI.TTS,AndroidAPI.JNIBridge;
type
TBitAry = array [0..159] of Boolean;
type
TBtThread = class(TThread)
private
{ Private 宣言 }
procedure BtOpen;
protected
procedure Execute; override;
public
constructor Create; virtual;
end;
type
TForm4 = class(TForm)
ScaledLayout1: TScaledLayout;
Bluetooth1: TBluetooth;
Button6: TButton;
Timer1: TTimer;
StringGrid1: TStringGrid;
StringColumn1: TStringColumn;
StringColumn2: TStringColumn;
StringColumn3: TStringColumn;
StringColumn4: TStringColumn;
StringColumn5: TStringColumn;
StringColumn6: TStringColumn;
StringColumn7: TStringColumn;
StringColumn8: TStringColumn;
StringColumn9: TStringColumn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Rectangle1: TRectangle;
Label4: TLabel;
Label5: TLabel;
Rectangle2: TRectangle;
Rectangle3: TRectangle;
Rectangle4: TRectangle;
Rectangle5: TRectangle;
Label7: TLabel;
StringColumn10: TStringColumn;
StringColumn11: TStringColumn;
StringColumn12: TStringColumn;
StringColumn13: TStringColumn;
StringColumn14: TStringColumn;
StringColumn15: TStringColumn;
StringColumn16: TStringColumn;
StringColumn17: TStringColumn;
Label11: TLabel;
Rectangle9: TRectangle;
ComboBox3: TComboBox;
Button2: TButton;
Switch1: TSwitch;
Rectangle6: TRectangle;
Label8: TLabel;
Rectangle7: TRectangle;
Label9: TLabel;
Rectangle8: TRectangle;
Label6: TLabel;
Rectangle10: TRectangle;
Label10: TLabel;
Rectangle11: TRectangle;
Label12: TLabel;
Label13: TLabel;
procedure Button6Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Rectangle1Click(Sender: TObject);
procedure Rectangle2Click(Sender: TObject);
procedure StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas;
const Column: TColumn; const Bounds: TRectF; const Row: Integer;
const Value: TValue; const State: TGridDrawStates);
procedure StringGrid1DrawColumnHeader(Sender: TObject;
const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF);
procedure StringGrid1CellClick(const Column: TColumn; const Row: Integer);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Rectangle7Click(Sender: TObject);
procedure Rectangle10Click(Sender: TObject);
// TTS
type
TttsOnInitListener = class(TJavaLocal, JTextToSpeech_OnInitListener)
private
[weak] FParent : TForm4;
public
constructor Create(AParent : TForm4);
procedure onInit(status: Integer); cdecl;
end;
private
{ private 宣言 }
ttsListener : TttsOnInitListener;
tts : JTextToSpeech;
procedure SpeakOut(const s :string);
procedure InitTTS;
public
{ public 宣言 }
BitAryOld : TBitAry;
BitAryNew : TBitAry;
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SendDeviceStartIndex;
end;
var
Form4: TForm4;
ADevice : TBluetoothDevice;
ASocket : TBluetoothSocket;
GThdMode : integer;
GCmdMode : integer;
ThBt : TBtThread;
OpenNGcnt : integer;
OpenMsecCnt : integer;
Counter : integer;
BtDeviceHead : string;
const
// SPP(Serial Port Profile) による通信のUUID
ServiceUUID = '{00001101-0000-1000-8000-00805F9B34FB}';
thdTHSTART = 1000;
thdTHTERM = 2000;
cmdSCCREATE = 200;
cmdSCCONNECT = 201;
cmdSCNG = 202;
implementation
uses Androidapi.JNI.JavaTypes, FMX.Helpers.Android
{$IF CompilerVersion >= 27.0}
, Androidapi.Helpers
{$ENDIF}
;
{$R *.fmx}
// n の k 乗 (Math ユニット不要)
function IntPower(n, k : integer):integer;
var
i : integer;
begin
result := 1;
for i := 1 to k do result := result * n;
end;
// -----------------------------------------------------------------------------
// Bluetooth を Open し、接続する
procedure TBtThread.BtOpen;
var
ABluetoothManager : TBluetoothManager;
APairedDevices : TBluetoothDeviceList;
ADevice : TBluetoothDevice;
idx, i : integer;
begin
GThdMODE := thdTHSTART;
try
try
ABluetoothManager := TBluetoothManager.Current;
if ABluetoothManager.ConnectionState = TBluetoothConnectionState.Connected then begin
// 過去にペアリングされたデバイスの一覧から、ターゲット を探す
APairedDevices := ABluetoothManager.GetPairedDevices;
if APairedDevices.Count > 0 then begin
idx := -1;
for i := 0 to APairedDevices.Count -1 do begin
Synchronize(procedure() begin
with Form4.ComboBox3 do begin
BeginUpdate;
Items.Add(APairedDevices[i].DeviceName );
EndUpdate;
end;
end);
if (BTDeviceHead = APairedDevices[i].DeviceName) then begin
Synchronize(procedure() begin
with Form4.ComboBox3 do begin
ItemIndex := i;
end;
end);
idx := i;
//break; // リストアップを続ける
end;
end;
if idx >= 0 then begin
ADevice := APairedDevices[idx];
if ADevice <> nil then begin
ASocket := ADevice.CreateClientSocket(StringToGUID(ServiceUUID), False);
if ASocket <> nil then begin
GCMDMODE := cmdSCCREATE;
// 接続
ASocket.Connect;
if ASocket.Connected then GCMDMODE := cmdSCCONNECT;
end;
end;
end;
end;
end;
except
on E : Exception do begin
GCMDMODE := cmdSCNG;
end;
end;
finally
// 明示的にスレッドを終了（破棄される）
// スレッド実行中にアプリを終了した時エラーになるため
Terminate;
WaitFor;
FreeAndNil(ThBt);
GThdMODE := thdTHTERM;
end;
end;
constructor TBtThread.Create;
begin
// スレッドを生成、直ちに実行
inherited Create(False);
// スレッド終了時、スレッドオブジェクトを破棄
FreeOnTerminate := True;
end;
procedure TBtThread.Execute;
begin
BtOpen;
end;
// -----------------------------------------------------------------------------
procedure TForm4.InitTTS;
begin
tts := TJTextToSpeech.JavaClass.init(TAndroidHelper.Context, ttsListener);
end;
procedure TForm4.SpeakOut(const s : string);
var
text : JString;
begin
text := StringToJString(s);
tts.speak(text, TJTextToSpeech.JavaClass.QUEUE_FLUSH, nil);
end;
{ TForm4.TttsOnInitListener }
constructor TForm4.TttsOnInitListener.Create(AParent: TForm4);
begin
inherited Create;
FParent := AParent
end;
procedure TForm4.TttsOnInitListener.onInit(status: Integer);
var
Result : Integer;
begin
if (status = TJTextToSpeech.JavaClass.SUCCESS) then
begin
//result := FParent.tts.setLanguage(TJLocale.JavaClass.US);
result := FParent.tts.setLanguage(TJLocale.JavaClass.JAPAN);
if (result = TJTextToSpeech.JavaClass.LANG_MISSING_DATA) or
(result = TJTextToSpeech.JavaClass.LANG_NOT_SUPPORTED) then
ShowMessage('This Language is not supported');
end
else
ShowMessage('Initilization Failed!');
end;
constructor TForm4.Create(AOwner: TComponent);
begin
inherited;
ttsListener := TttsOnInitListener.Create(self);
end;
destructor TForm4.Destroy;
begin
if Assigned(tts) then begin
tts.stop;
tts.shutdown;
tts := nil;
end;
end;
// -----------------------------------------------------------------------------
function ASocketReceiveData(ASocket: TBluetoothSocket; ATimeout: Cardinal): string;
var
AData : TBytes;
ReadData : TBytes;
i : integer;
res : string;
Ticks : Cardinal;
idx : integer;
loop : boolean;
cnt : integer;
begin
res := '';
cnt := 0;
SetLength(ReadData, 1024);
idx := 0;
Ticks := TThread.GetTickCount;
loop := True;
while loop and (cnt < 500) do begin
Sleep(1);
AData := ASocket.ReceiveData;
if Length(AData) > 0 then begin
for i := 0 to Length(AData) - 1 do begin
ReadData[idx] := AData[i];
Inc(idx);
if (AData[i] = Ord(#10)) or (idx >= 1024) then begin
loop := False;
break;
end;
end;
end;
Inc(cnt);
if loop then
loop := TThread.GetTickCount - Ticks < ATimeout;
end;
SetLength(ReadData, idx);
res := TEncoding.ANSI.GetString(ReadData);
result := Trim(res); // 制御コードを含まない
end;
procedure TForm4.SendDeviceStartIndex;
// PC へ先頭番号を送信
var
AData : TBytes;
res : string;
ATimeout: Cardinal;
i : integer;
begin
// PC 側へ先頭アドレスを送信するだけ
if (ASocket <> nil) and ASocket.Connected then begin
// 初期化
for i := 0 to 159 do BitAryNew[i] := False;
BitAryOld := BitAryNew;
// PC の値を変更
ATimeout := 250;
// デバイス名
AData := TEncoding.ANSI.GetBytes('CF ' + Label8.Text + #13#10);
// 送信
ASocket.SendData(AData);
res := ASocketReceiveData(ASocket, ATimeout);
// アドレス表示部
Rectangle4.Fill.Color := TAlphaColorRec.Black;
// ON/OFF表示部
Rectangle5.Fill.Color := TAlphaColorRec.Black;
end;
end;
procedure TForm4.Button2Click(Sender: TObject);
// 接続先保存
var
IniFile: TMemIniFile;
begin
IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath, 'MXC4_IO.ini'), TEncoding.UTF8);
with IniFile do begin
try
with ComboBox3 do begin
if ItemIndex >= 0 then begin
WriteString('Target', 'PCName', Items[ItemIndex]);
ShowMessage('接続先: ' + Items[ItemIndex] + 'を保存しました．' + #13#10 +
'次回起動時から有効になります．' + #13#10 + 'このアプリを再起動して下さい．');
end
else
ShowMessage('接続先が選択されていません．');
end;
IniFile.UpdateFile;
finally
Free;
end;
end;
end;
procedure TForm4.Button6Click(Sender: TObject);
// デバイスの値をセット
var
AData : TBytes;
res : string;
ATimeout: Cardinal;
begin
if (ASocket <> nil) and ASocket.Connected then begin
Timer1.Enabled := False;
ATimeout := 250;
AData := TEncoding.ANSI.GetBytes('WR ' + Label3.Text + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
with Label3.TextSettings do begin
if res = 'ON' then FontColor := TAlphaColorRec.Red
else if res = 'OFF' then FontColor := TAlphaColorRec.Lime
else FontColor := TAlphaColorRec.White;
end;
Timer1.Enabled := True;
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
IniFile: TMemIniFile; // uses .... System.IniFiles;
i : integer;
begin
Label7.Text := '';
Label13.Text := '';
StringColumn1.Header := 'R';
StringColumn2.Header := '0';
StringColumn3.Header := '1';
StringColumn4.Header := '2';
StringColumn5.Header := '3';
StringColumn6.Header := '4';
StringColumn7.Header := '5';
StringColumn8.Header := '6';
StringColumn9.Header := '7';
StringColumn10.Header := '8';
StringColumn11.Header := '9';
StringColumn12.Header := '10';
StringColumn13.Header := '11';
StringColumn14.Header := '12';
StringColumn15.Header := '13';
StringColumn16.Header := '14';
StringColumn17.Header := '15';
with StringGrid1 do begin
for i := 0 to 9 do
Cells[0, i] := Format('%.4d', [i*100]);
end;
// 縦画面に固定
Application.FormFactor.Orientations :=
[TFormOrientation.Portrait, TFormOrientation.InvertedPortrait];
// use ..... System.IOUtils;
IniFile := TMemIniFile.Create(System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath, 'MXC4_IO.ini'), TEncoding.UTF8);
with IniFile do begin
try
BtDeviceHead := ReadString('Target', 'PCName', '');
finally
Free;
end;
end;
// TTS
InitTTS;
// Bruetooth スレッド
Timer1.Interval := 10;
Timer1.Enabled := True;
ThBt := TBtThread.Create;
end;
procedure TForm4.FormDestroy(Sender: TObject);
begin
if ASocket <> nil then begin
ASocket.Close;
ASocket.Free;
ASocket := nil;
end;
end;
procedure TForm4.Rectangle10Click(Sender: TObject);
// [-10000, -1000]
var
idx, i: integer;
begin
idx := Label8.Text.ToInteger();
if Sender as TRectangle = Rectangle10 then
idx := idx - 1000
else
idx := idx - 10000;
if idx < 0 then idx := 0;
Label8.Text := Format('%.4d', [idx]);
with StringGrid1 do begin
for i := 0 to 9 do
Cells[0, i]:= Format('%.4d', [idx + i * 100]);
Row := 0;
Col := 1;
end;
// 先頭アドレスを PC に送信
SendDeviceStartIndex;
end;
procedure TForm4.Rectangle1Click(Sender: TObject);
// [ + 1]
var
n, md, dv, idx : integer;
begin
n := Label3.Text.ToInteger();
dv := n div 100;
md := n mod 100;
if md >= 15 then begin
Inc(dv);
md := 0;
end
else
Inc(md);
if dv * 100 + md <= 59915 then begin
with Label3 do begin
Text := Format('%.4d', [dv * 100 + md]);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
idx := Label8.Text.ToInteger();
n := dv * 100 + md - idx;
if n >= 0 then begin
with StringGrid1 do begin
OnCellClick := nil;
Row := n div 100;
Col := n mod 100 + 1;
OnCellClick := StringGrid1CellClick;
SetFocus;
end;
end;
end;
end;
procedure TForm4.Rectangle2Click(Sender: TObject);
// [ - ]
var
n, md, dv, idx : integer;
begin
n := Label3.Text.ToInteger;
dv := n div 100;
md := n mod 100;
if md > 0 then Dec(md)
else begin
Dec(dv);
md := 15;
end;
if dv < 0 then begin
dv := 0;
md := 0;
end;
with Label3 do begin
Text := Format('%.4d', [dv * 100 + md]);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
idx := Label8.Text.ToInteger();
n := dv * 100 + md - idx;
if n >= 0 then begin
with StringGrid1 do begin
OnCellClick := nil;
Row := n div 100;
Col := n mod 100 + 1;
OnCellClick := StringGrid1CellClick;
SetFocus;
end;
end;
end;
procedure TForm4.Rectangle7Click(Sender: TObject);
//[+10000, +1000]
var
idx: integer;
i: Integer;
begin
idx := Label8.Text.ToInteger();
if Sender as TRectangle = Rectangle7 then
idx := idx + 10000
else
idx := idx + 1000;
if idx > 59000 then idx := 59000;
Label8.Text := Format('%.4d', [idx]);
with StringGrid1 do begin
for i := 0 to 9 do
Cells[0, i]:= Format('%.4d', [idx + i * 100]);
Row := 0;
Col := 1;
end;
Label1.Text := '';
Label2.Text := '';
Label11.Text := '';
// 先頭アドレスを PC に送信
SendDeviceStartIndex;
end;
procedure TForm4.StringGrid1CellClick(const Column: TColumn;
const Row: Integer);
// セルクリックで、反転対象のアドレスを変更
var
n : integer;
begin
// 出力反転の対象
n := StrToIntDef(StringGrid1.Cells[0, Row], 0) + StrToIntDef(Column.Header, 0);
with Label3 do begin
Text := Format('%.4d', [n]);
TextSettings.FontColor := TAlphaColorRec.Orange;
end;
end;
procedure TForm4.StringGrid1DrawColumnCell(Sender: TObject;
const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
const Row: Integer; const Value: TValue; const State: TGridDrawStates);
// AlphaColor uses ... System.UIConsts;
var
s : string;
n : integer;
flag : boolean;
idx : integer;
begin
if not Value.IsEmpty then s := Value.ToString
else s := '';
with Canvas do begin
if Column.Index = 0 then begin
if s <> '' then begin
Fill.Color := claSilver;//claAqua;//claSilver;//Yellow;
FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
Fill.Color := claBlack;
Font.Size := 15;
FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
end;
end
else begin
flag := False;
if (Label2.Text = 'OFF') or (Label2.Text = 'ON') then begin
// 先頭アドレス
idx := Label8.Text.ToInteger();
// 現在のアドレス
n := StrToIntDef(Label1.Text, -1);
if (n >= idx) then begin
n := n - idx;
if (Row = n div 100) and (Column.Index = n mod 100 + 1) then begin
if Label2.Text = 'OFF' then begin
Fill.Color := claGray;//Black;
FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
Fill.Color := claLime;
end;
if Label2.Text = 'ON' then begin
Fill.Color := claRed;
FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
Fill.Color := claWhite;
end;
s := (n mod 100).ToString;
Font.Size := 16;
FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
flag := true;
end;
end;
end;
if not flag and (s <> '') then begin
Fill.Color := claOrange;//Red;
FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
Fill.Color := claWhite;
Font.Size := 16;
FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
end;
end;
end;
end;
procedure TForm4.StringGrid1DrawColumnHeader(Sender: TObject;
const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF);
var
s: string;
begin
s := Column.Header;
if s <> '' then begin
with Canvas do begin
if Column.Index = 0 then begin
Fill.Color := claLime;
FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
Fill.Color := claBlack;
Font.Size := 18;
FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
end
else begin
Fill.Color := claSilver;
FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round );
Fill.Color := claBlack;
Font.Size := 15;
FillText(Bounds, s, False, 1.0, [], TTextAlign.Center);
end;
end;
end;
end;
function NumToSpeechText(const hex : string): string;
var
i : integer;
s : string;
begin
result := '';
for i := 1 to hex.Length do begin
s := Copy(hex, i, 1);
if s = '0' then result := result + 'ゼロ'
else if s = '1' then result := result + 'イチ'
else if s = '2' then result := result + 'ニイ'
else if s = '3' then result := result + 'サン'
else if s = '4' then result := result + 'ヨン'
else if s = '5' then result := result + 'ゴー'
else if s = '6' then result := result + 'ロク'
else if s = '7' then result := result + 'ナナ'
else if s = '8' then result := result + 'ハチ'
else if s = '9' then result := result + 'キュウ'
else if s = 'A' then result := result + 'エイ'
else if s = 'B' then result := result + 'ビイ'
else if s = 'C' then result := result + 'シイ'
else if s = 'D' then result := result + 'デー'
else if s = 'E' then result := result + 'イイ'
else if s = 'F' then result := result + 'エフ'
else result := result + s;
result := result + ' ';
end;
end;
procedure TForm4.Timer1Timer(Sender: TObject);
var
ATimeout : Cardinal;
AData : TBytes;
res : string;
i : integer;
Ticks : Cardinal;
j : integer;
s : string;
n, idx, stIndex : integer;
flag : boolean;
ttsFlag : boolean;
begin
ttsFlag := False;
if not ((GCMDMODE = cmdSCCONNECT) and ASocket.Connected) then begin
Inc(OpenMsecCnt);
Label7.Text := IntToStr(OpenMsecCnt * 10) + 'msec';
if GCMDMODE = cmdSCNG then begin
Inc(OpenNgCnt);
if OpenNgCnt > 4 then begin
Timer1.Enabled := False;
ShowMessage(BTDeviceHead + ' に、接続できません．');
end;
end;
if OpenMsecCnt > 100 then begin
Timer1.Enabled := False;
ShowMessage('接続先が無効です．');
end;
end;
if (GCMDMODE = cmdSCCONNECT) and ASocket.Connected then begin
Timer1.Interval := 250;
flag := True;
Timer1.Enabled := False;
try
Ticks := TThread.GetTickCount;
ATimeout := 250;
// 初回は CPU TYPE 取得のみ
if Label13.Text = '' then begin
AData := TEncoding.ANSI.GetBytes('CPU' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
Label13.Text := res;
flag := res <> '';
end
else begin
// 先頭アドレス
stIndex := Label8.Text.ToInteger();
if Flag then begin
// デバイス一括読み出しコマンド
AData := TEncoding.ANSI.GetBytes('RD' + #13#10);
// 送信
ASocket.SendData(AData);
// 受信
res := ASocketReceiveData(ASocket, ATimeout);
flag := res <> '';
// データ格納
if res.Length >= 80 then begin // 10 x 4 = 40, 40 x 2 = 80
for i := 0 to 9 do begin
s := Copy(res, i * 4 + 1, 4);
n := StrToIntDef('$' + s, 0);
for j := 0 to 15 do
BitAryNew[i * 16 + j] := n and IntPower(2, j) > 0;
s := Copy(res, i * 4 + 1 + 40, 4);
n := StrToIntDef('$' + s, 0);
for j := 0 to 15 do
BitAryOld[i * 16 + j] := n and IntPower(2, j) > 0;
end;
s := Copy(res, 82); // スペース１個ある
if s <> '' then begin
// デバイス番号
n := Pos(' ', s);
if n = 0 then begin
idx := StrToIntDef(s, 0);
Label11.Text := ''; // コメント
end
else begin
// 先頭デバイス番号（PC からの応答は 10 進表記）
idx := StrToIntDef(Copy(s, 1, n - 1), 0);
// コメント
Label11.Text := Copy(s, n + 1);
end;
if (stIndex <> idx) then begin
stIndex := idx;
// アドレス番号を変える
Label8.Text := stIndex.ToString;
with StringGrid1 do begin
for i := 0 to 9 do
Cells[0, i] := Format('%.4d', [stIndex + i * 100]);
Row := 0;
Col := 1;
end;
// 内部データを初期化
for i := 0 to 159 do BitAryNew [i] := False;
BitAryOld := BitAryNew;
// デバイス ON/OFF の表示を初期化
Label1.Text := '';
Label2.Text := '';
Rectangle4.Fill.Color := TAlphaColorRec.Black;
Rectangle5.Fill.Color := TAlphaColorRec.Black;
// 反転デバイス番号を更新
Label3.Text := Format('%.4d', [stIndex]);
end;
end;
end;
end;
// 表示
with StringGrid1 do begin
for i := 0 to 159 do begin
if BitAryNew[i] then begin
s := (i mod 16).ToString;
if Cells[i mod 16 + 1, i div 16] <> s then
Cells[i mod 16 + 1, i div 16] := s ;
end
else begin
if Cells[i mod 16 + 1, i div 16] <> '' then
Cells[i mod 16 + 1, i div 16] := '';
end;
end;
end;
// 比較
// 内部データ数 = 128, FX は先頭 64 データのみ表示される
for i := 0 to 159 do begin
//idx := i + stIndex;
if BitAryNew[i] and not BitAryOld[i] then begin
Rectangle4.Fill.Color := TAlphaColorRec.Red;
with Label1 do begin
Text := Format('%.4d', [(i div 16) * 100 + i mod 16 + stIndex]);
TextSettings.FontColor := TAlphaColorRec.White;
end;
Rectangle5.Fill.Color := TAlphaColorRec.Red;
with Label2 do begin
Text := 'ON';
TextSettings.FontColor := TAlphaColorRec.White;
end;
ttsFlag := True;
end
else if not BitAryNew[i] and BitAryOld[i] then begin
Rectangle4.Fill.Color := TAlphaColorRec.Black;
with Label1 do begin
Text := Format('%.4d', [(i div 16) * 100 + i mod 16 + stIndex]);
TextSettings.FontColor := TAlphaColorRec.Lime;
end;
Rectangle5.Fill.Color := TAlphaColorRec.Black;
with Label2 do begin
Text := 'OFF';
TextSettings.FontColor := TAlphaColorRec.Lime;
end;
ttsFlag := True;
end;
if ttsFlag then begin
s := NumToSpeechText(Label1.Text);
if Switch1.IsChecked then
s := s + '。' + Label11.Text;
if Label2.Text = 'ON' then s := s + '。' + 'オン'
else s := s + '。' + 'オフ';
SpeakOut(s);
end;
end;
end;
if flag then
Label7.Text := (TThread.GetTickCount - Ticks).ToString
else
Label7.Text := 'PC 接続失敗';
if flag then
Timer1.Enabled := True;
except
Label7.Text := 'PC 応答なし';
Timer1.Enabled := True;
end;
end;
end;
end.
