MELSEC MX Component を Delphi XE5 で使う その２ 2016/ 7/25 変更
2017/ 1/11
※サンプルコードの Suspend（一時停止）、Resume（再開）は、最近の Delphi では使用不可（非推奨）になっています。
また、Synchronize() の使い方が、適切ではありません。
■FX5UCPU EThernet ポート直結のサンプルです。
・起動と同時に通信を開始します。
・LAN ケーブル抜け、PLC 電源断等で、通信異常が発生した時は、2 秒周期で、再接続を試みます。
・通信正常時は、100 ミリ秒周期で、デバイスの値を取得します。
・マルチスレッドを使っています。
■ ActProgType 用 ほぼ実用コード
// 2017/ 1/11 追記
// Suspend（一時停止）、Resume（再開）は、最近の Delphi では使用不可（非推奨）になっています。
// また、Synchronize() の使い方が、適切ではありません。
// 必要な個所のみ、Synchronize()を使う例
{
Synchronize(procedure() begin
Form1.Label2.Text := 'Receive Error';
ShowMessage('応答がありません．');
end);
}
// -------------------------------------------------
// メイン
// -------------------------------------------------
unit MXCompoTest2Unit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.OleCtrls,
ActProgTypeLib_TLB, Vcl.StdCtrls;
type
TForm3 = class(TForm)
ActProgType1: TActProgType;
Timer1: TTimer;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Edit13: TEdit;
Edit14: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Label1: TLabel;
Label2: TLabel;
Edit15: TEdit;
Button5: TButton;
Edit16: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form3: TForm3;
GB_ReadCnt : integer;
GB_OpenCnt : integer;
GB_TmBusy : boolean;
GB_OpenFlag : boolean;
// スレッドを保持
Th : TThread;
// プロトタイプ
function HexToSingle(const hex: string): single;
function HexToDouble(const hex: string): double;
function SingleToHex(d: single) : String;
function DoubleToHex(const d: double): string;
function PlcBufToSingle(var iData : array of integer): single;
function PlcBufToDouble(var iData : array of Integer): double;
function PlcBufToStr(var iData: array of Integer): string;
function PlcBufToShort(var iData: array of Integer): SmallInt;
function PlcBufToInt(var iData: array of Integer): integer;
procedure ShortToPlcBuf(i : integer; var iData: array of Integer);
procedure IntToPlcBuf(i : integer; var iData: array of integer);
procedure SingleToPlcBuf(d : single; var iData: array of Integer);
procedure DoubleToPlcBuf(d : double; var iData: array of Integer);
procedure StrToPlcBuf(const s: string; var iData :array of integer);
implementation
{$R *.dfm}
uses MXCompoTest2ThreadUnit;
function PlcBufToShort(var iData: array of Integer): SmallInt;
begin
Result := 0;
if Length(iData) >= 1 then
Result := Short(iData[0]);
end;
procedure ShortToPlcBuf(i : integer; var iData: array of Integer);
begin
if Length(iData) >= 1 then
iData[0] := i and $FFFF;
end;
function PlcBufToInt(var iData: array of Integer): integer;
begin
result := 0;
if Length(iData) >= 2 then
Result := iData[1] * $10000 + iData[0];
end;
procedure IntToPlcBuf(i : integer; var iData: array of integer);
begin
if Length(iData) >= 2 then begin
iData[0] := i and $FFFF;
iData[1] := (i and $FFFF0000) div $10000;
end;
end;
//32ビット実数（単精度）変換
function HexToSingle(const hex: string): single;
var
i : Integer;
FloatValue: Single absolute i;
begin
i := StrToInt('$' + hex);
Result := FloatValue;
end;
function PlcBufToSingle(var iData : array of integer): single;
var
i : Integer;
FloatValue: Single absolute i;
begin
if Length(iData) >= 2 then
i := iData[1] * $10000 + iData[0];
result := FloatValue;
end;
// 32 ビット実数（単精度）変換
function SingleToHex(d: single) : String;
var
i : Cardinal absolute d;
begin
Result := IntToHex(i, 8);
end;
// 32 ビット実数（単精度）変換
procedure SingleToPlcBuf(d : single; var iData: array of Integer);
var
i : Cardinal absolute d;
begin
if Length(iData) >= 2 then begin
iData[0] := i and $FFFF;
iData[1] := (i and $FFFF0000) div $10000;
end;
end;
// 64 ビット実数（倍精度）変換
function DoubleToHex(const d: double): string;
var
Overlay: Int64 absolute d;
begin
result := IntToHex(Overlay, 16);
end;
procedure DoubleToPlcBuf(d : double; var iData: array of Integer);
var
Overlay: Int64 absolute d;
begin
if Length(iData) >= 4 then begin
iData[0] := Overlay and $FFFF;
iData[1] := (Overlay and $FFFF0000) div $10000;
iData[2] := (Overlay and $FFFF00000000) div $100000000;
iData[3] := (Overlay and $FFFF000000000000) div $1000000000000;
end;
end;
//64ビット実数（倍精度）変換
function HexToDouble(const hex: string): double;
var
d : double;
Overlay: array[1..2] of LongInt absolute d;
begin
result := 0.0;
if Length(hex) = 16 then begin
Overlay[1] := StrToInt('$' + Copy(hex, 9, 8));
Overlay[2] := StrToInt('$' + Copy(hex, 1, 8));
result := d;
end;
end;
// PLC 読み込みバッファを64ビット実数（倍精度）変換
function PlcBufToDouble(var iData : array of Integer): double;
var
d : double;
Overlay: array [0..1] of LongInt absolute d;
begin
result := 0.0;
if Length(iData) >= 4 then begin
Overlay[0] := iData[1] * $10000 + iData[0];
Overlay[1] := iData[3] * $10000 + iData[2];
result := d;
end;
end;
// PLC読み込み用バッファを文字列に
function PlcBufToStr(var iData: array of Integer): string;
var
arycnt : integer;
i : integer;
begin
// 配列の大きさ
arycnt := Length(iData);
result := '';
for i := 0 to arycnt - 1 do begin
result := result + Char(iData[i] and $00FF);
result := result + Char((iData[i] and $FF00) div $100);
end;
end;
// 文字列をPLC書き込み用バッファに
procedure StrToPlcBuf(const s: string; var iData :array of integer);
var
arycnt : integer;
len, i : integer;
begin
// 配列の大きさ
arycnt := Length(iData);
// 文字列の長さ
len := Length(s);
for i := 1 to len div 2 do begin
iData[i - 1] := Ord(s[i * 2 ]) * $100 + Ord(s[i * 2 - 1]);
if i = arycnt then break;
end;
if (len div 2 < arycnt) and (len mod 2 > 0) then
iData[len div 2] := Ord(s[len]);
end;
// 16 ビット整数
procedure TForm3.Button1Click(Sender: TObject);
var
iData : array [0..0] of Integer;
begin
if GB_OpenFlag then begin
ShortToPlcBuf(StrToInt(Edit11.Text), iData);
ActProgType1.WriteDeviceBlock('D0', 1, iData[0]);
end;
end;
// 32 ビット整数
procedure TForm3.Button2Click(Sender: TObject);
var
iData : array [0..1] of Integer;
begin
if GB_OpenFlag then begin
IntToPlcBuf(StrToInt(Edit12.Text), iData);
ActProgType1.WriteDeviceBlock('D0', 2, iData[0]);
end;
end;
// 32 ビット実数（単精度）
procedure TForm3.Button3Click(Sender: TObject);
var
iData : array [0..1] of Integer;
begin
if GB_OpenFlag then begin
SingleToPlcBuf(StrToFloat(Edit13.Text), iData);
ActProgType1.WriteDeviceBlock('D0', 2, iData[0]);
end;
end;
// 64 ビット実数（倍精度）
procedure TForm3.Button4Click(Sender: TObject);
var
iData : array [0..3] of Integer;
begin
if GB_OpenFlag then begin
DoubleToPlcBuf(StrToFloat(Edit14.Text), iData);
ActProgType1.WriteDeviceBlock('D0', 4, iData[0]);
end;
end;
// 文字列書き込み
procedure TForm3.Button5Click(Sender: TObject);
var
iData : array of Integer;
writelen : integer;
begin
// 書き込み数（文字列の長さは、この倍まで）
writelen := 10;
SetLength(iData, writelen);
StrToPlcBuf(Edit16.Text , iData);
ActProgType1.WriteDeviceBlock('D0', writelen, iData[0]);
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
// スレッド終了
if Assigned(Th) then Th.Terminate;
end;
// インターバルタイマー
procedure TForm3.Timer1Timer(Sender: TObject);
begin
if not GB_OpenFlag then
Timer1.Interval := 2000
else
Timer1.Interval := 100;
if not Assigned(Th) then begin
Th := PlcThread.Create;
end
else begin
// スレッド再開
Th.Resume;
end;
end;
end.
// -------------------------------------------------
// PLC オープン、データ読込スレッド
// -------------------------------------------------
unit MXCompoTest2ThreadUnit;
interface
uses
System.Classes, System.SysUtils,Winapi.Windows;
type
PlcThread = class(TThread)
private
{ Private 宣言 }
procedure Plc_Open;
procedure Plc_Read;
protected
procedure Execute; override;
end;
implementation
uses MXCompoTest2Unit;
{ PlcThead }
// PLC オープン
procedure PlcThread.Plc_Open;
var
iRet : integer;
Ticks : Cardinal;
begin
if not GB_TmBusy then begin
Inc(GB_OpenCnt);
GB_TmBusy := True;
with Form3.ActProgType1 do begin
ActUnitType := $2002; //UNIT_FXVETHER_DIREC 'ユニットタイプ
ActCpuType := $210; //CPU_FX5UCPU 'CPUタイプ
ActProtocolType := $8; //PROTOCOL_UDPIP '通信プロトコルタイプ
// 直結接続の場合、対象PLCのIPアドレスは不要
ActHostAddress := '255.255.255.255'; // 接続ホスト名（IP アドレス）文字列
ActDestinationPortNumber := $15B8;
ActTimeOut := 500; // 通信のタイムアウト値(単位は"ms")
Ticks := GetTickCount;
// オープン
iRet := Open;
Form3.Edit1.Text := IntToHex(iRet, 8);
Form3.Edit2.Text := IntToStr(GB_OpenCnt);
// すでに接続済
if iRet = -268435453 then begin
// 一度切断
Close;
// 再接続
iRet := Open;
end;
with Form3 do begin
// 読込実行時間（ms）を表示
Edit3.Text := IntToStr(GetTickCount - Ticks);
if iRet = 0 then begin
GB_OpenFlag := True;
if Label2.Caption <> '通信正常' then Label2.Caption := '通信正常';
end
else begin
if Label2.Caption <> '通信異常' then Label2.Caption := '通信異常';
end;
end;
end;
GB_TmBusy := False;
end;
end;
// PLC データ読込
procedure PlcThread.Plc_Read;
var
ReadData : array [0..3] of integer;
// 文字列取得用動的配列
ReadData2 : array of Integer;
// 読込文字数
txtlen : integer;
readlen : integer;
iRet : integer;
Ticks : Cardinal;
begin
if not GB_TmBusy then begin
Inc(GB_ReadCnt);
GB_TmBusy := True;
with Form3 do begin
Edit3.Text := IntToStr(GB_ReadCnt);
// 通信状態を表示
if Label1.Caption <> '●' then Label1.Caption := '●'
else Label1.Caption := '○';
// 開始時間を保持
Ticks := GetTickCount;
// D0 ～ D3 の値を取得
iRet := ActProgType1.ReadDeviceBlock('D0', 4, ReadData[0]);
if iRet = 0 then begin
// そのまま 16 進で表示
Edit5.Text := IntToHex(ReadData[0], 4);
Edit6.Text := INtToHex(ReadData[1], 4);
// D0 を 16ビット整数として表示
Edit7.Text := IntToStr(PlcBufToShort(ReadData[0]));
// D0, D1 を 32ビット整数として取得
Edit8.Text := IntToStr(PlcBufToInt(ReadData));
// D0, D1 を 32ビット単精度実数として表示
Edit9.Text := FloatToStr(PlcBufToSingle(ReadData));
// D0 ～ D3 を 64 ビット倍精度実数として表示
Edit10.Text := FloatToStr(PlcBufToDouble(ReadData));
// 文字列取得
txtlen := 20; // 取得する文字列の最大数
readlen := txtlen div 2;
if txtlen mod 2 > 0 then Inc(readlen);
SetLength(ReadData2, readlen);
if ActProgType1.ReadDeviceBlock('D0', readlen, ReadData2[0]) = 0 then
Edit15.Text := PlcBufToStr(ReadData2);
end
else begin
GB_OpenFlag := False;
end;
// 実行時間（ミリ秒）を表示
Edit4.Text := IntToStr(GetTickCount - Ticks) + ' msec';
end;
GB_TmBusy := False;
end;
end;
// スレッド実行
procedure PlcThread.Execute;
begin
while not Terminated do begin
if not GB_TmBusy then begin
if not GB_OpenFlag then
Synchronize(Plc_Open)
else
Synchronize(Plc_Read);
end;
Sleep(5);
// スレッド一時停止
Th. Suspend;
end;
end;
end.