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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

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;

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

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

新かべきんブログ

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

コメントを残すコメントをキャンセル

趣味の日記

2018年6月
月	火	水	木	金	土	日
« 5月				7月 »
				1	2	3
4	5	6	7	8	9	10
11	12	13	14	15	16	17
18	19	20	21	22	23	24
25	26	27	28	29	30

Related posts:

コメントを残す コメントをキャンセル

趣味の日記

コメントを残すコメントをキャンセル