Lazarusからシリアルポートを使う方法メモ

Last Updated on 2018年6月20日 by kabekin

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

それにしても情報が少ないなぁ～