unit Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, OoMisc, AdPort,
Vcl.ExtCtrls, System.UITypes, AdSelCom, IniFiles;
type
TForm4 = class(TForm)
ApdComPort1: TApdComPort;
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Timer1: TTimer;
GroupBox1: TGroupBox;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
Shape5: TShape;
Shape6: TShape;
Shape7: TShape;
Shape8: TShape;
ComboBox1: TComboBox;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ApdComPort1TriggerAvail(CP: TObject; Count: Word);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
resBuf : string;
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
// 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;
procedure TForm4.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
// アンサーバック有効の時、接点出力の操作状態を取得
// （アンサーバック有効の時、接点入力のアンサーバック確認にも使える）
var
i : Word;
ch : AnsiChar;
shp : TShape;
resNo : integer;
j, k : integer;
coOn, coOff : TColor;
begin
coOn := clLime;
coOff := clWhite;
for i := 1 to Count do begin
ch := ApdComPort1.GetChar;
resBuf := resBuf + string(ch);
if ch = #10 then begin
resBuf := Trim(resBuf); // CrLfを削除
Memo1.Lines.Add(resBuf);
resBuf := StringReplace(resBuf, ',', '', [rfReplaceAll]);
if Pos('494D414E53424B', resBuf) > 0 then begin
// 出力の状態
resNo := StrToIntDef(Copy(resBuf, Length(resBuf)- 1), 0);
if resNo > 0 then begin
for j := 1 to 8 do begin
// 出力の状態
if j <= 4 then begin
resNo := StrToIntDef(Copy(resBuf, Length(resBuf)), 0);
k := j;
end
else begin
resNo := StrToIntDef(Copy(resBuf, Length(resBuf) -1, 1), 0);
k := j - 4;
end;
if resNo and intPower(2, k - 1) > 0 then begin
shp := FindComponent('Shape' + j.ToString) as TShape;
if shp <> nil then begin
// '00'から始まるシーケンス番号の最後
if Copy(resBuf, Length(resBuf) - 3, 2) = '04' then
shp.Brush.Color := coOff
else if shp.Brush.Color <> coOn then
shp.Brush.Color := coOn;
end;
end;
end;
end;
end;
resBuf := '';
end;
end;
end;
procedure TForm4.Button1Click(Sender: TObject);
// COM ポートオープン
var
comNo : integer;
begin
comNo := - 1;
with ComboBox1 do begin
if ItemIndex >= 0 then begin
comNo := StrToIntDef(Copy(Items[ItemIndex], 4), -1);
end;
end;
if comNo >= 0 then begin
with ApdComport1 do begin
ComNumber := comNo;
Baud := 19200;
DataBits := 8;
StopBits := 1;
Parity := TParity.pNone;
try
Open:= True;
if Open then Memo1.Lines.Add('COMPORT OPEN OK')
else Memo1.Lines.Add('COMPORT OPEN NG');
except
Memo1.Lines.Add('COMPORT ERROR');
end;
end;
end;
end;
procedure TForm4.Button2Click(Sender: TObject);
// COM ポートクローズ
begin
with ApdComport1 do begin
if Open then begin
Open := False;
Memo1.Lines.Add('COMPORT CLOSE');
end;
end;
end;
procedure TForm4.Button5Click(Sender: TObject);
// OUT 1～8
// MODE = H, L, H
// プッシュ動作＋アンサーバック有効
var
btn : TButton;
outNo : integer;
cmd : string;
begin
btn := Sender as TButton;
outNo := StrToIntDef(Copy(btn.Caption, Length(btn.Caption)), 0);
if outNo > 0 then begin
with ApdComport1 do begin
if Open then begin
resBuf := '';
cmd := 'TXDA494D414E53424B000000';
cmd := cmd + IntToHex(intPower(2, (outNo - 1)), 2);
PutString(cmd + #13#10);
Memo1.Lines.Add('>'+cmd);
end;
end;
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
// フォーム生成
var
i : integer;
ini : TIniFile;
s : string;
begin
Memo1.Lines.Clear;
// COM ポートの列挙
AdSelCom.ShowPortsInUse := False;
for i := 0 to 32 do if AdSelCom.IsPortAvailable(i) then
ComboBox1.Items.Add (AdPort.ComName(i));
// 前回選択した COM ポート名を読み込み
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
s := ini.ReadString('Comport', 'ComName', '');
with ComboBox1 do begin
if (s <> '') and (Items.Count > 0) then begin
for i := 0 to Items.Count - 1 do begin
if Items[i] = s then begin
ItemIndex:= i;
break;
end;
end;
end;
end;
finally
ini.Free;
end;
end;
procedure TForm4.FormDestroy(Sender: TObject);
// フォーム破棄
var
ini : TIniFile;
begin
// 選択した COM ポート名を保存
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
ini.WriteString('Comport', 'ComName', ComboBox1.Text);
finally
ini.Free;
end;
end;
end.
■ ソースコード Android （要：Uni232C コンポーネント）
unit ComReadUnit;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, Uni232C,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Edit, FMX.ScrollBox,
FMX.ListBox, System.Rtti, FMX.Grid.Style, FMX.Grid, System.UIConsts,
System.IOUtils, System.IniFiles, FMX.Objects, FMX.Layouts,
Androidapi.JNIBridge, AndroidApi.JNI.Media, FMX.Memo;
type
TComReadThread = class(TThread)
private
{ Private 宣言 }
procedure ComRead;
protected
procedure Execute; override;
public
constructor Create; virtual;
end;
TForm2 = class(TForm)
ScaledLayout1: TScaledLayout;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Uni232C1: TUni232C;
Button6: TButton;
RoundRect1: TRoundRect;
RoundRect2: TRoundRect;
RoundRect3: TRoundRect;
RoundRect4: TRoundRect;
Rectangle5: TRectangle;
Rectangle6: TRectangle;
Rectangle7: TRectangle;
Rectangle8: TRectangle;
CornerButton1: TCornerButton;
CornerButton2: TCornerButton;
CornerButton3: TCornerButton;
CornerButton4: TCornerButton;
Rectangle9: TRectangle;
CornerButton5: TCornerButton;
Rectangle10: TRectangle;
CornerButton6: TCornerButton;
Rectangle11: TRectangle;
CornerButton7: TCornerButton;
Rectangle12: TRectangle;
CornerButton8: TCornerButton;
RoundRect5: TRoundRect;
RoundRect6: TRoundRect;
RoundRect7: TRoundRect;
RoundRect8: TRoundRect;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
//procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Uni232C1UsbDettach(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure CornerButton1Click(Sender: TObject);
private
{ private 宣言 }
public
{ public 宣言 }
procedure DispRecData;
end;
var
Form2: TForm2;
ResBuf : string;
ResData : array [0..1023] of Byte;
ResIndex : integer;
LoopFlag : boolean;
ThComRead : TComReadThread;
ToneGenerator: JToneGenerator;
implementation
{$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;
procedure Beep(typ : integer);
// ブザー音
// uses ... Androidapi.JNIBridge, AndroidApi.JNI.Media;
//var
// ToneGenerator: JToneGenerator;
begin
//ToneGenerator := TJToneGenerator.JavaClass.init(
// TJAudioManager.JavaClass.STREAM_ALARM,
// TJToneGenerator.JavaClass.MAX_VOLUME);
//https://developer.android.com/reference/android/media/ToneGenerator.html
if typ = 2 then
// TONE_PROP_BEEP2 = 400Hz+1200Hz, 35ms ON, 200ms OFF, 35ms ON
ToneGenerator.startTone(TJToneGenerator.JavaClass.TONE_PROP_BEEP2)
else if typ = 1 then
// TONE_PROP_BEEP = 400Hz+1200Hz, 35ms ON
ToneGenerator.startTone(TJToneGenerator.JavaClass.TONE_PROP_BEEP)
else
// TONE_PROP_ACK = 1200Hz, 100ms ON, 100ms OFF 2 bursts
ToneGenerator.startTone(TJToneGenerator.JavaClass.TONE_PROP_ACK);
end;
// -----------------------------------------------------------------------------
procedure TComReadThread.ComRead;
var
ret : integer;
AData : TBytes;
i, j : integer;
begin
loopFlag := True;
while not Terminated and loopFlag do begin
if Form2.Uni232C1.Connect then begin
SetLength(AData, 64);
ret := Form2.Uni232C1.Read(64, @AData[0]);
if( ret > 0 ) then begin
for i := 0 to ret - 1 do begin
if AData[i]= $0A then begin // <LF>
resBuf := '';
for j := 0 to resIndex - 1 do resBuf := resBuf + Char(resData[j]);
// 受信結果を表示
Synchronize(procedure
begin
Form2.DispRecData;
end
);
resIndex := 0;
end
else begin
resData[resIndex] := AData[i];
Inc(resIndex);
end;
end;
end;
end
else
loopFlag := False;
end;
end;
constructor TComReadThread.Create;
begin
// スレッドを生成、直ちに実行
inherited Create(False);
// スレッド終了時、スレッドオブジェクトを破棄
FreeOnTerminate := True;
end;
procedure TComReadThread.Execute;
begin
ComRead;
end;
// -----------------------------------------------------------------------------
procedure TForm2.Button1Click(Sender: TObject);
// OPEN
var
ret : integer;
begin
with Uni232C1 do begin
BaudRate := 19200;
ByteSize := Bit8;
StopBits := StopBit1;
ParityBits := ParityNone;
FlowControls := CtrlNone;
SetModemStatus($0300);
ret := Open;
if ret < 0 then
ShowMessage('Cannot OPEN' + Error2Str(ret))
else begin
Beep(2);
end;
end;
end;
procedure TForm2.Button2Click(Sender: TObject);
// CLOSE
begin
if Assigned(ThComRead) then loopFlag := False;
Uni232C1.Close;
Beep(1);
end;
procedure TForm2.Button4Click(Sender: TObject);
// READ
begin
if Assigned(ThComRead) then begin
ThComRead.TerminatedSet;
ThComRead := nil;
end;
if Uni232C1.Connect then begin
ThComRead := TComReadThread.Create;
Beep(2);
end;
end;
procedure TForm2.Button6Click(Sender: TObject);
// READ STOP
begin
if Assigned(ThComRead) then begin
loopFlag := False;
Beep(1);
end;
end;
procedure TForm2.CornerButton1Click(Sender: TObject);
// DO 1～8
var
btn : TCornerButton;
AData : TBytes;
len : integer;
outNo : integer;
cmd : string;
begin
if Uni232C1.Connect then begin
btn := Sender as TCornerButton;
// 押された IO の番号
outNo := StrToIntDef(Copy(btn.Text, 4), -1);
if outNo >= 0 then begin
resBuf := '';
cmd := 'TXDA494D414E53424B000000';
cmd := cmd + IntToHex(intPower(2, (outNo - 1)), 2);
AData := TEncoding.ANSI.GetBytes(cmd + #13#10);
len := Length(AData);
Uni232C1.Write(len, @AData[0]);
Memo1.Lines.Clear;
Memo1.Lines.Add('>' + cmd);
Beep(1); // プッ
end;
end;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(ThComRead) then begin
ThComRead.TerminatedSet;
ThComRead := nil;
end;
Uni232C1.Close;
ToneGenerator.release;
end;
procedure TForm2.DispRecData;
var
resNo : Integer;
rect : TRoundRect;
j, k : integer;
coOn, coOff : Cardinal;
begin
coOn := claLime;
coOff := claWhite;
resBuf := Trim(resBuf); // 制御文字を削除
Memo1.Lines.Add(resBuf);
resBuf := StringReplace(resBuf, ',', '', [rfReplaceAll]);
if Pos('494D414E53424B', resBuf) > 0 then begin
// 出力の状態（最後の 2 文字）
resNo := StrToIntDef(Copy(resBuf, Length(resBuf) - 1), 0);
//Memo1.Lines.Add('resNo = ' + resNo.ToString);
if resNo > 0 then begin
for j := 1 to 8 do begin
// 出力の状態
if j <= 4 then begin
// 最後の 1 文字
resNo := StrToIntDef(Copy(resBuf, Length(resBuf)), 0);
k := j;
end
else begin
// 最後から 2 文字目の 1 文字
resNo := StrToIntDef(Copy(resBuf, Length(resBuf) -1, 1), 0);
k := j - 4;
end;
if resNo and intPower(2, k - 1) > 0 then begin
rect := FindComponent('RoundRect' + j.ToString) as TRoundRect;
if rect <> nil then begin
// '00'から始まるシーケンス番号の最後
if Copy(resBuf, Length(resBuf) - 3, 2) = '04' then begin
rect.Fill.Color := coOff;
end
else if rect.Fill.Color <> coOn then
rect.Fill.Color := coOn;
if Copy(resBuf, Length(resBuf) - 3, 2) = '00' then begin
Beep(0); // ピピッ
end;
end;
end;
end;
end;
end;
resBuf := '';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
// 縦画面に固定
Application.FormFactor.Orientations :=
[TFormOrientation.Portrait, TFormOrientation.InvertedPortrait];
ToneGenerator := TJToneGenerator.JavaClass.init(
TJAudioManager.JavaClass.STREAM_ALARM,
TJToneGenerator.JavaClass.MAX_VOLUME);
end;
procedure TForm2.Uni232C1UsbDettach(Sender: TObject);
// USB ケーブル抜け
begin
if Uni232C1.Connect then begin
if Assigned(ThComRead) then begin
ThComRead.TerminatedSet;
ThComRead := nil;
end;
Uni232C1.Close;
Beep(1);
end;
end;
end.
