Lazarusからシリアルポートを使う方法をメモしてておきます。
Lazarusシリアル情報 → http://wiki.lazarus.freepascal.org/index.php/Hardware_Access
Synapseライブラリを使う場合
１） Synapseライブラリの入手
ダウンロードページからダウンロード → https://www.ararat.cz/synapse/doku.php/download
rel.40 の synapse.zip をダウンロード
２）環境整備
2-1) synapse.zipを解凍して適当なフォルダに入れる
(Synapseはコンポーネントではなくライブラリ集らしくインストールは必要ないらしい)
2-2)ライブラリのパスを通す
各プロジェクト毎にProject Optionで設定
[Project]-[Project Options…]でOptions for Project画面を開く
[Compiler Options]-[Paths]-[Other unit files (-Fu)]にlibのパスを追加
今回は [ ..\..\lib\synapse40\source\lib ]で指定し[OK]
(v1.8.2では [Tools]-[Options…]でIDE Optionsに設定箇所が見当たらない)
３）使い方メモ
3-1) usesに synaser を追加
3-2) TBlockSerial型でオブジェクト生成
3-3) ポートパラメータ設定及びポートオープン
3-4) 送信用関数、受信用関数で入出力
3-5) ポート開放
●文字列での送受信メモ
受信イベントが無いのでタイマーでポーリング、最低限はOKそうだけど、ここはもう一工夫必要。
イベントを生成する方法もあるんだと思いますが、勉強不足でさっぱり・・・
unit MainFormunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, synaser;
type
{ TMainForm }
TMainForm = class(TForm)
btn_SendBtn: TButton;
btn_CharSend: TButton;
edt_String: TEdit;
Memo1: TMemo;
RecvTimer: TTimer;
procedure btn_SendBtnClick(Sender: TObject);
procedure btn_CharSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RecvTimerTimer(Sender: TObject);
private
SerialObj: TBlockSerial;
RxBuf: string;
procedure SerialOpen(PortNo, Baud: integer);
procedure SerialClose;
public
end;
const
CRLF = chr(13) + chr(10);
CR = chr(13);
LF = chr(10);
var
MainForm: TMainForm;
implementation
{$R *.lfm}
//+++ 受信ポーリングタイマー
procedure TMainForm.RecvTimerTimer(Sender: TObject);
var
ComBuf, RecvStr, TmpStr: string;
size, i, p: integer;
begin
RecvTimer.Enabled:= false;
size := SerialObj.WaitingDataEx;
if (size > 0) or (Length(RxBuf) > 0) then begin
ComBuf := SerialObj.RecvBufferStr( size, 0 );
RxBuf := RxBuf + ComBuf;
SerialObj.Purge;
p := 0;
TmpStr := '';
for i := 1 to length(RxBuf) do begin
if RxBuf[i] = CR then begin
RecvStr := Copy(RxBuf, 1, i-1); //デリミタ迄の文字列抽出(デリミタを含めない)
p := i;
// 受信バッファを詰める
TmpStr := Copy(RxBuf, p+1, Length(RxBuf));
RxBuf := TmpStr;
p := 0;
// 1行受信したので目的の処理実行
Memo1.Lines.Add(RecvStr);
break;
end;
end;
end;
RecvTimer.Enabled:= true;
end;
//+++ TBlockSerialポートの生成
procedure TMainForm.SerialOpen(PortNo, Baud: integer);
begin
if SerialObj = nil then SerialObj := TBlockSerial.Create;
Try
SerialObj.RaiseExcept:= true;
SerialObj.Connect('COM' + IntToStr(PortNo));
sleep(500);
SerialObj.Config(Baud, 8, 'N', SB1, false, false);
SerialObj.DTR := true;
SerialObj.RTS := true;
sleep(300);
SerialObj.Purge;
Except
on E : exception do begin
ShowMessage(E.ClassName + '例外発生:' + E.Message);
end;
End;
end;
procedure TMainForm.btn_SendBtnClick(Sender: TObject);
begin
SerialObj.SendString(edt_String.Text + CRLF);
end;
procedure TMainForm.btn_CharSendClick(Sender: TObject);
var
Buf: array[0..4] of char;
begin
Buf[0] := 'N';
Buf[1] := 'E';
Buf[2] := 'C';
Buf[3] := CR;
Buf[4] := LF;
SerialObj.SendBuffer(@Buf, high(Buf)+1);
end;
procedure TMainForm.SerialClose;
begin
SerialObj.CloseSocket;
if SerialObj <> nil then SerialObj.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
SerialOpen(4, 38400);
RecvTimer.Interval := 50;
RecvTimer.Enabled := true;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
SerialClose;
end;
end.
もっと良い方法がありましたら、アドバイスお願いします^^;;;
全ユニットのヘルプ → http://synapse.ararat.cz/doc/help/
TBlockSerialのヘルプ → http://synapse.ararat.cz/doc/help/synaser.TBlockSerial.html
Lazarusのヘルプ → http://wiki.freepascal.org/Hardware_Access#Synaser
それにしても情報が少ないなぁ～