Delphi XE5, 10.1 Berlin で Rotronic HC2 (ロトロニック社温湿度計) を、読む (2015/08/14, 2017/03/03 更新）
ロトロニック社 （http://www.rotronic.jp/index.html） の温湿度計を、簡単に Delphi から使うサンプルです。
2017/03/03 （追加）
--------------------------------------------------------------------
HC2 センサーの UART 信号を RS232C にレベル変換すると、とても簡単に読めました。DLL や VCP は不要です。
使用したレベル変換器(￥930) ： http://www.mycomkits.com/SHOP/MK-205.html
RS232C の通信設定、送信するコマンド "{ 99RDD}"+#13 は、下記のサンプルと同じです。
MK205 にラトックシステムのWi-Fi - RS232C変換器 (REX-WF60)、Bluetooth - RS232C 変換器 (REX-BT60)
を接続すると、
ワイヤレスで、Windows, Android 端末から、温度、湿度、露点温度の計測が可能になります。
どちらの機器も 5V の電源が必要ですが、モバイルバッテリーでも使用できました。
--------------------------------------------------------------------
※専用のUSBケーブル（UART信号をUSB信号に変換）が必要で、ケーブルだけで ￥24,000. （定価）します。
ハンディタイプ温湿度計（HP22等）の場合、電源は、USBから給電されます。変換器（HF5等）では、無理でした。
USBドライバーのインストール手順 http://www.rotronic.jp/faq_005.html
Windows 8.1 の場合は、「Windows 8 (8.1) でPC接続したとき、正常にインストールできない。」 http://www.rotronic.jp/faq.html も参考に。
VB.NET、C#、VC++、Excel 等から使えるRo3xdrv.dll が公開されていますが、残念ながら、Delphi からでは使えないようです。
VB.NETのサンプルをダブルクリックで試してみたところ、簡単にビルドできました。．NET環境の方は、こちらのほうが良さそうです。
■VCPを使用する
USBドライバのVCP（バーチャルコムポート）機能を使うと、通常のRS-232C機器として、
Delphi からでも簡単に使えます。
「USB Serial Converter」 を右クリックし、「プロパティー」 をクリック。
「詳細設定」タブで、「VCPをロードする」にチェックを付け、[OK]ボタンをクリック。
「USB Serial Port (COM No)」 が追加されます。（追加されない場合は、再起動してみて下さい。）
これを右クリックし、プロパティーを表示します。
「ポートの設定」タブでボーレート等の設定を行います。
■Delphi + ComPort (CPort Lib) でバーチャル COM ポートを使う
送信コマンドは、'{ 99RDD}' + #13
※ '{' と '99RDD}' の間には半角スペースが必要です。要注意です。
50msecほどの時間をおいて受信すると、文字列が返ってきます。
これを、';' 区切りで読むと、計測値等の情報が取得できます。
■FTD2XX.dll をそのまま使う
VCP のチェック、設定は不要です。
専用のUSBケーブルを接続し、ドライバをインストールしただけで、使用できます。
送信文字列、受信文字列は、VCP を使う時とまったく同じです。
DLL を使うために、D2XXUnit2.pas （ソースコードを参照） が必要です。
FTD2XX.dll の日本語説明 PDF は、こちら（（株）西日本常盤商行様）
サンプルEXE （現場での温湿度計測のための最少機能ツール）
・相対湿度、温度、露点温度（演算値） 表示
・トレンド表示（直近５分のみ）
・トレンドグラフのスクリーンショット保存
・直近５分間の測定データCSVファイル保存
ダウンロード（サンプルEXE本体のみ．ソースコードなし）
■スクリーンショット
サンプルEXE（マルチスレッドで、1秒に１回程度計測しています。）↓
■ソースコード
unit Rotronic232cUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, CPort;
type
TForm2 = class(TForm)
ComPort1: TComPort;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses D2XXUnit2;
// VCP(バーチャル COM ポート） 使用
// ComPort コンポーネント(CPort Lib)が必要です
procedure TForm2.Button1Click(Sender: TObject);
var
s : string;
begin
try
with ComPort1 do begin
Port := 'COM6';
BaudRate := br19200;
DataBits := dbEight;
StopBits := sbOneStopBit;
Parity.Bits := prNone;
Parity.Check := False;
FlowControl.FlowControl := fcNone;
end;
ComPort1.Open;
// コマンド送信
ComPort1.WriteStr('{ 99RDD}'+#13);
Sleep(100);
// レスポンス受信
ComPort1.ReadStr(s, 1024);
Edit1.Text := s;
ComPort1.Close;
except
ShowMessage('通信エラーです．');
end;
end;
// USB 使用（VCPを使わない場合は、こちら）
procedure TForm2.Button2Click(Sender: TObject);
var
res : string;
begin
// デバイスオープン
if OpenUsbDevice = FT_OK then begin
// 通信設定
SetUsbDeviceBaudRate;
// タイムアウト設定(必須）
SetUsbDeviceTimeOuts(500, 500);
// 読み込みコマンドを送信
if WriteHc2ReadCommand = FT_OK then
// レスポンス受信
if ReadHc2Result(res) = FT_OK then
Edit1.Text := res
else
ShowMessage('返信エラーです．');
// デバイスクローズ
CloseUsbDevice;
end
else begin
// USBケーブルが接続されていない
ShowMessage('通信エラーです．');
end;
end;
procedure TForm2.Edit1Change(Sender: TObject);
var
sl: TStringList;
s: string;
begin
sl := TStringList.Create;
try
s := StringReplace(Edit1.Text, ' ', '_', [rfReplaceAll]);
sl.Delimiter := ';';
sl.DelimitedText := s;
if sl.Count > 10 then begin
// 相対湿度
Edit2.Text := sl[1];
// 温度
Edit3.Text := sl[5];
// 演算値（露点温度）
Edit4.Text := sl[10];
end
else begin
Edit2.Text := '';
Edit3.Text := '';
Edit4.Text := '';
end;
finally
sl.Free;
end;
end;
end.
// VCP を使う場合は、不要です。
unit D2XXUnit2;
{
***************************************************
FTD2XX.DLL 通信ユニット for HygroClip2
f.izawa (http://www.izawa-web.com) 2015/08/07
***************************************************
参考：
・ＦＴＤＩ社 D2XXUnit.pas
・神栄テクノロジー株式会社 VB6 サンプル通信モジュール
・株式会社西日本常盤商行 Ftd2xxドライバー説明日本語訳
}
interface
Uses Windows,Forms,Dialogs, Messages, SysUtils, Variants, Classes, Graphics, Controls,
System.UITypes;
const
// Return codes
FT_OK = 0;
FT_INVALID_HANDLE = 1;
FT_DEVICE_NOT_FOUND = 2;
FT_DEVICE_NOT_OPENED = 3;
FT_IO_ERROR = 4;
FT_INSUFFICIENT_RESOURCES = 5;
FT_INVALID_PARAMETER = 6;
FT_INVALID_BAUD_RATE = 7;
FT_DEVICE_NOT_OPENED_FOR_ERASE = 8;
FT_DEVICE_NOT_OPENED_FOR_WRITE = 9;
FT_FAILED_TO_WRITE_DEVICE = 10;
FT_EEPROM_READ_FAILED = 11;
FT_EEPROM_WRITE_FAILED = 12;
FT_EEPROM_ERASE_FAILED = 13;
FT_EEPROM_NOT_PRESENT = 14;
FT_EEPROM_NOT_PROGRAMMED = 15;
FT_INVALID_ARGS = 16;
FT_NOT_SUPPORTED = 17;
FT_OTHER_ERROR = 18;
// Flags for FT_OpenEx
FT_OPEN_BY_SERIAL_NUMBER = 1;
FT_OPEN_BY_DESCRIPTION = 2;
// Flags for FT_ListDevices
FT_LIST_NUMBER_ONLY = $80000000;
FT_LIST_BY_INDEX = $40000000;
FT_LIST_ALL = $20000000;
FT_LIST_BY_INDEX_AND_NO = $40000001;
// RS232C
FT_BITS_8 = 8;
FT_BITS_7 = 7;
FT_STOP_BITS_1 = 0;
FT_STOP_BITS_2 = 2;
FT_PARITY_NONE = 0;
FT_PARITY_ODD = 1;
FT_PARITY_EVEN = 2;
FT_PARITY_MARK = 3;
FT_PARITY_SPACE = 4;
FT_FLOW_NONE = $0000;
FT_FLOW_RTS_CTS = $0100;
FT_FLOW_DTR_DSR = $0200;
FT_FLOW_XON_XOFF = $0400;
// Purge
FT_PURGE_RX = 1;
FT_PURGE_TX = 2;
function OpenUsbDevice: long;
function CloseUsbDevice: long;
function WriteHc2ReadCommand: long;
function ReadHc2Result(var res: string): long;
function ReadUsbDevice(var res :string; var ReadLen : long): long;
function SetUSBDeviceBaudRate: long;
function SetUSBDeviceTimeOuts(ReadTimeOut, WriteTimeOut: DWord) : long;
function GetUSBDeviceInfo(var DevType: DWord; var ID: DWord; var SerialNumber: array of AnsiChar; var Description: array of AnsiChar) : long;
implementation
var
FT_HANDLE : Long;
function FT_GetDeviceInfo(ftHandle: DWord; DevType,ID, SerNum,Desc,pvDummy:Pointer) :long; stdcall; external 'FTD2XX.DLL';
function FT_SetDataCharacteristics(ftHandle:Dword; WordLength,StopBits,Parity:Byte):Integer; stdcall; external 'FTD2XX.DLL' name 'FT_SetDataCharacteristics';
function FT_SetFlowControl(ftHandle:Dword; FlowControl:Word; XonChar,XoffChar:Byte):Integer; stdcall; external 'FTD2XX.DLL' name 'FT_SetFlowControl';
function FT_Open(Index:Integer; var ftHandle:Long): long ; stdcall; external 'FTD2XX.DLL' name 'FT_Open';
function FT_Read(ftHandle:Dword; FTInBuf:Pointer; BufferSize:LongInt; var ResultPtr: Long): Integer; stdcall; external 'FTD2XX.DLL' name 'FT_Read';
function FT_Write(ftHandle:Dword; FTOutBuf:Pointer; BufferSize:LongInt; var ResultPtr: Long): Integer; stdcall; external 'FTD2XX.DLL' name 'FT_Write';
function FT_ResetDevice(ftHandle:Dword):Integer; stdcall; external 'FTD2XX.DLL' name 'FT_ResetDevice';
function FT_Purge(ftHandle:Dword; Mask:Dword):Integer; stdcall; external 'FTD2XX.DLL' name 'FT_Purge';
function FT_Close(ftHandle:Dword):long; stdcall; external 'FTD2XX.DLL' name 'FT_Close';
function FT_SetBaudRate(ftHandle:Dword; BaudRate:DWord):Long; stdcall; external 'FTD2XX.DLL' name 'FT_SetBaudRate';
function FT_SetTimeouts(ftHandle:Dword; ReadTimeout,WriteTimeout:Dword):Long; stdcall; external 'FTD2XX.DLL' name 'FT_SetTimeouts';
function FT_GetStatus(ftHandle: DWord; RxBytes, TxBytes, EventStatus:Pointer):long; stdcall; external 'FTD2XX.DLL' name 'FT_GetStatus';
function FT_ListDevices(pvArg1: Dword; pvArg2:Pointer; dwFlags:Dword):Long; stdcall; external 'FTD2XX.DLL' name 'FT_ListDevices';
function FT_OpenEx(pvArg1: Pointer; dwFlags:Dword; var ftHandle: Long):Long; stdcall; external 'FTD2XX.DLL' name 'FT_OpenEx';
function FT_SetDivisor(ftHandle:Dword; Divisor:DWord):Long; stdcall; external 'FTD2XX.DLL' name 'FT_SetDivisor';
function OpenUsbDevice: long;
begin
result := FT_Open(0, FT_Handle);
end;
function CloseUsbDevice: long;
begin
result := FT_Close(FT_Handle);
end;
function WriteHc2ReadCommand: long;
var
WriteLen : long;
cmd : string;
i : integer;
Buffer : array [0.. 63] of AnsiChar;
begin
cmd := '{ 99RDD}' + #13;
for i := 0 to cmd.Length - 1 do
FT_Out_Buffer[i] := AnsiChar(cmd[i + 1]);
result := FT_Write(FT_Handle, @Buffer, 9, WriteLen);
end;
function ReadHc2Result(var res: string): long;
var
ReadLen : long;
begin
result := ReadUsbDevice(res, ReadLen);
end;
function ReadUsbDevice(var res :string; var ReadLen : long): long;
var
i : integer;
ret : Long;
c : AnsiChar;
begin
Result := -1;
for i := 0 to 255 do begin
Application.ProcessMessages;
ret := FT_Read(FT_Handle, @c, 1, ReadLen);
if ret = FT_OK then begin
if (i = 0) and (c <> '{') then Break;
res := res + String(c);
if c = #13 then begin
ReadLen := i;
Result := FT_OK;
break;
end;
end
else begin
Result := ret;
Break;
end;
end;
end;
function SetUsbDeviceBaudRate: Long;
begin
FT_Purge(FT_Handle, FT_PURGE_RX or FT_PURGE_TX);
FT_ResetDevice(FT_Handle);
Result := FT_SetBaudRate(FT_Handle, 19200);
FT_SetDataCharacteristics(FT_Handle, FT_BITS_8 ,FT_STOP_BITS_1, FT_PARITY_NONE);
FT_SetFlowControl(FT_Handle, FT_FLOW_NONE, $11, $13);
end;
function SetUsbDeviceTimeOuts(ReadTimeOut, WriteTimeOut: DWord) : long;
begin
Result := FT_SetTimeouts(FT_Handle, ReadTimeout, WriteTimeout);
end;
// 未使用
function GetUsbDeviceInfo(var DevType: DWord; var ID: DWord; var SerialNumber:array of AnsiChar; var Description: array of AnsiChar) : long;
begin
Result := FT_GetDeviceInfo(FT_Handle, @DevType, @ID, @SerialNumber, @Description, nil);
end;