Oдна барышня звонила на какую-то фирму и ругалась, что они ей какой-то не такой софт подсунули, что он не инсталлируется, хотя она все, мол, делает в соответствии с инструкцией (а софт ентот с дискет ставился). Ну, послали спеца из фирмы, продавшей этот софт, на месте разобраться what's, собственно, up... Приехал он, а барышня ему и говорит:
- Вот у вас в инструкции написано - "вставьте дискету #1", ну я вставила, потом написано вставить дискету #2, ну,- говорит, - я ее вставила, потом - дискету #3, ну вставила я ее (с трудом, правда), но вот дискета #4 уже просто в дисковод не лезет!!!
unit Comm;
interfaceuses
Messages, WinTypes, WinProcs, Classes, Forms;
type
TPort = (tptNone, tptOne, tptTwo, tptThree, tptFour, tptFive, tptSix,
tptSeven,
tptEight);
TBaudRate = (tbr110, tbr300, tbr600, tbr1200, tbr2400, tbr4800, tbr9600,
tbr14400,
tbr19200, tbr38400, tbr56000, tbr128000, tbr256000);
TParity = (tpNone, tpOdd, tpEven, tpMark, tpSpace);
TDataBits = (tdbFour, tdbFive, tdbSix, tdbSeven, tdbEight);
TStopBits = (tsbOne, tsbOnePointFive, tsbTwo);
TCommEvent = (tceBreak, tceCts, tceCtss, tceDsr, tceErr, tcePErr, tceRing,
tceRlsd,
tceRlsds, tceRxChar, tceRxFlag, tceTxEmpty);
TCommEvents = setof TCommEvent;
const
PortDefault = tptNone;
BaudRateDefault = tbr9600;
ParityDefault = tpNone;
DataBitsDefault = tdbEight;
StopBitsDefault = tsbOne;
ReadBufferSizeDefault = 2048;
WriteBufferSizeDefault = 2048;
RxFullDefault = 1024;
TxLowDefault = 1024;
EventsDefault = [];
type
TNotifyEventEvent = procedure(Sender: TObject; CommEvent: TCommEvents) ofobject;
TNotifyReceiveEvent = procedure(Sender: TObject; Count: Word) ofobject;
TNotifyTransmitEvent = procedure(Sender: TObject; Count: Word) ofobject;
TComm = class(TComponent)
private
FPort: TPort;
FBaudRate: TBaudRate;
FParity: TParity;
FDataBits: TDataBits;
FStopBits: TStopBits;
FReadBufferSize: Word;
FWriteBufferSize: Word;
FRxFull: Word;
FTxLow: Word;
FEvents: TCommEvents;
FOnEvent: TNotifyEventEvent;
FOnReceive: TNotifyReceiveEvent;
FOnTransmit: TNotifyTransmitEvent;
FWindowHandle: hWnd;
hComm: Integer;
HasBeenLoaded: Boolean;
Error: Boolean;
procedure SetPort(Value: TPort);
procedure SetBaudRate(Value: TBaudRate);
procedure SetParity(Value: TParity);
procedure SetDataBits(Value: TDataBits);
procedure SetStopBits(Value: TStopBits);
procedure SetReadBufferSize(Value: Word);
procedure SetWriteBufferSize(Value: Word);
procedure SetRxFull(Value: Word);
procedure SetTxLow(Value: Word);
procedure SetEvents(Value: TCommEvents);
procedure WndProc(var Msg: TMessage);
procedure DoEvent;
procedure DoReceive;
procedure DoTransmit;
protectedprocedure Loaded; override;
publicconstructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Write(Data: PChar; Len: Word);
procedureRead(Data: PChar; Len: Word);
function IsError: Boolean;
publishedproperty Port: TPort read FPort write SetPort default PortDefault;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate
default BaudRateDefault;
property Parity: TParity read FParity write SetParity default ParityDefault;
property DataBits: TDataBits read FDataBits write SetDataBits
default DataBitsDefault;
property StopBits: TStopBits read FStopBits write SetStopBits
default StopBitsDefault;
property WriteBufferSize: Word read FWriteBufferSize
write SetWriteBufferSize default WriteBufferSizeDefault;
property ReadBufferSize: Word read FReadBufferSize
write SetReadBufferSize default ReadBufferSizeDefault;
property RxFullCount: Word read FRxFull write SetRxFull
default RxFullDefault;
property TxLowCount: Word read FTxLow write SetTxLow default TxLowDefault;
property Events: TCommEvents read FEvents write SetEvents
default EventsDefault;
property OnEvent: TNotifyEventEvent read FOnEvent write FOnEvent;
property OnReceive: TNotifyReceiveEvent read FOnReceive write FOnReceive;
property OnTransmit: TNotifyTransmitEvent read FOnTransmit write
FOnTransmit;
end;
procedureRegister;
implementationprocedure TComm.SetPort(Value: TPort);
const
CommStr: PChar = 'COM1:';
begin
FPort := Value;
if (csDesigning in ComponentState) or
(Value = tptNone) or (not HasBeenLoaded) then
exit;
if hComm >= 0 then
CloseComm(hComm);
CommStr[3] := chr(48 + ord(Value));
hComm := OpenComm(CommStr, ReadBufferSize, WriteBufferSize);
if hComm < 0 thenbegin
Error := True;
exit;
end;
SetBaudRate(FBaudRate);
SetParity(FParity);
SetDataBits(FDataBits);
SetStopBits(FStopBits);
SetEvents(FEvents);
EnableCommNotification(hComm, FWindowHandle, FRxFull, FTxLow);
end;
procedure TComm.SetBaudRate(Value: TBaudRate);
var
DCB: TDCB;
begin
FBaudRate := Value;
if hComm >= 0 thenbegin
GetCommState(hComm, DCB);
case Value of
tbr110: DCB.BaudRate := CBR_110;
tbr300: DCB.BaudRate := CBR_300;
tbr600: DCB.BaudRate := CBR_600;
tbr1200: DCB.BaudRate := CBR_1200;
tbr2400: DCB.BaudRate := CBR_2400;
tbr4800: DCB.BaudRate := CBR_4800;
tbr9600: DCB.BaudRate := CBR_9600;
tbr14400: DCB.BaudRate := CBR_14400;
tbr19200: DCB.BaudRate := CBR_19200;
tbr38400: DCB.BaudRate := CBR_38400;
tbr56000: DCB.BaudRate := CBR_56000;
tbr128000: DCB.BaudRate := CBR_128000;
tbr256000: DCB.BaudRate := CBR_256000;
end;
SetCommState(DCB);
end;
end;
procedure TComm.SetParity(Value: TParity);
var
DCB: TDCB;
begin
FParity := Value;
if hComm < 0 then
exit;
GetCommState(hComm, DCB);
case Value of
tpNone: DCB.Parity := 0;
tpOdd: DCB.Parity := 1;
tpEven: DCB.Parity := 2;
tpMark: DCB.Parity := 3;
tpSpace: DCB.Parity := 4;
end;
SetCommState(DCB);
end;
procedure TComm.SetDataBits(Value: TDataBits);
var
DCB: TDCB;
begin
FDataBits := Value;
if hComm < 0 then
exit;
GetCommState(hComm, DCB);
case Value of
tdbFour: DCB.ByteSize := 4;
tdbFive: DCB.ByteSize := 5;
tdbSix: DCB.ByteSize := 6;
tdbSeven: DCB.ByteSize := 7;
tdbEight: DCB.ByteSize := 8;
end;
SetCommState(DCB);
end;
procedure TComm.SetStopBits(Value: TStopBits);
var
DCB: TDCB;
begin
FStopBits := Value;
if hComm < 0 then
exit;
GetCommState(hComm, DCB);
case Value of
tsbOne: DCB.StopBits := 0;
tsbOnePointFive: DCB.StopBits := 1;
tsbTwo: DCB.StopBits := 2;
end;
SetCommState(DCB);
end;
procedure TComm.SetReadBufferSize(Value: Word);
begin
FReadBufferSize := Value;
SetPort(FPort);
end;
procedure TComm.SetWriteBufferSize(Value: Word);
begin
FWriteBufferSize := Value;
SetPort(FPort);
end;
procedure TComm.SetRxFull(Value: Word);
begin
FRxFull := Value;
if hComm < 0 then
exit;
EnableCommNotification(hComm, FWindowHandle, FRxFull, FTxLow);
end;
procedure TComm.SetTxLow(Value: Word);
begin
FTxLow := Value;
if hComm < 0 then
exit;
EnableCommNotification(hComm, FWindowHandle, FRxFull, FTxLow);
end;
procedure TComm.SetEvents(Value: TCommEvents);
var
EventMask: Word;
begin
FEvents := Value;
if hComm < 0 then
exit;
EventMask := 0;
if tceBreak in FEvents then
inc(EventMask, EV_BREAK);
if tceCts in FEvents then
inc(EventMask, EV_CTS);
if tceCtss in FEvents then
inc(EventMask, EV_CTSS);
if tceDsr in FEvents then
inc(EventMask, EV_DSR);
if tceErr in FEvents then
inc(EventMask, EV_ERR);
if tcePErr in FEvents then
inc(EventMask, EV_PERR);
if tceRing in FEvents then
inc(EventMask, EV_RING);
if tceRlsd in FEvents then
inc(EventMask, EV_RLSD);
if tceRlsds in FEvents then
inc(EventMask, EV_RLSDS);
if tceRxChar in FEvents then
inc(EventMask, EV_RXCHAR);
if tceRxFlag in FEvents then
inc(EventMask, EV_RXFLAG);
if tceTxEmpty in FEvents then
inc(EventMask, EV_TXEMPTY);
SetCommEventMask(hComm, EventMask);
end;
procedure TComm.WndProc(var Msg: TMessage);
beginwith Msg dobeginif Msg = WM_COMMNOTIFY thenbegincase lParamLo of
CN_EVENT: DoEvent;
CN_RECEIVE: DoReceive;
CN_TRANSMIT: DoTransmit;
end;
endelse
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
end;
procedure TComm.DoEvent;
var
CommEvent: TCommEvents;
EventMask: Word;
beginif (hComm < 0) ornot Assigned(FOnEvent) then
exit;
EventMask := GetCommEventMask(hComm, Integer($FFFF));
CommEvent := [];
if (tceBreak in Events) and (EventMask and EV_BREAK <> 0) then
CommEvent := CommEvent + [tceBreak];
if (tceCts in Events) and (EventMask and EV_CTS <> 0) then
CommEvent := CommEvent + [tceCts];
if (tceCtss in Events) and (EventMask and EV_CTSS <> 0) then
CommEvent := CommEvent + [tceCtss];
if (tceDsr in Events) and (EventMask and EV_DSR <> 0) then
CommEvent := CommEvent + [tceDsr];
if (tceErr in Events) and (EventMask and EV_ERR <> 0) then
CommEvent := CommEvent + [tceErr];
if (tcePErr in Events) and (EventMask and EV_PERR <> 0) then
CommEvent := CommEvent + [tcePErr];
if (tceRing in Events) and (EventMask and EV_RING <> 0) then
CommEvent := CommEvent + [tceRing];
if (tceRlsd in Events) and (EventMask and EV_RLSD <> 0) then
CommEvent := CommEvent + [tceRlsd];
if (tceRlsds in Events) and (EventMask and EV_Rlsds <> 0) then
CommEvent := CommEvent + [tceRlsds];
if (tceRxChar in Events) and (EventMask and EV_RXCHAR <> 0) then
CommEvent := CommEvent + [tceRxChar];
if (tceRxFlag in Events) and (EventMask and EV_RXFLAG <> 0) then
CommEvent := CommEvent + [tceRxFlag];
if (tceTxEmpty in Events) and (EventMask and EV_TXEMPTY <> 0) then
CommEvent := CommEvent + [tceTxEmpty];
FOnEvent(Self, CommEvent);
end;
procedure TComm.DoReceive;
var
Stat: TComStat;
beginif (hComm < 0) ornot Assigned(FOnReceive) then
exit;
GetCommError(hComm, Stat);
FOnReceive(Self, Stat.cbInQue);
GetCommError(hComm, Stat);
end;
procedure TComm.DoTransmit;
var
Stat: TComStat;
beginif (hComm < 0) ornot Assigned(FOnTransmit) then
exit;
GetCommError(hComm, Stat);
FOnTransmit(Self, Stat.cbOutQue);
end;
procedure TComm.Loaded;
begininherited Loaded;
HasBeenLoaded := True;
SetPort(FPort);
end;
constructor TComm.Create(AOwner: TComponent);
begininherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
HasBeenLoaded := False;
Error := False;
FPort := PortDefault;
FBaudRate := BaudRateDefault;
FParity := ParityDefault;
FDataBits := DataBitsDefault;
FStopBits := StopBitsDefault;
FWriteBufferSize := WriteBufferSizeDefault;
FReadBufferSize := ReadBufferSizeDefault;
FRxFull := RxFullDefault;
FTxLow := TxLowDefault;
FEvents := EventsDefault;
hComm := -1;
end;
destructor TComm.Destroy;
begin
DeallocatehWnd(FWindowHandle);
if hComm >= 0 then
CloseComm(hComm);
inherited Destroy;
end;
procedure TComm.Write(Data: PChar; Len: Word);
beginif hComm < 0 then
exit;
if WriteComm(hComm, Data, Len) < 0 then
Error := True;
GetCommEventMask(hComm, Integer($FFFF));
end;
procedure TComm.Read(Data: PChar; Len: Word);
beginif hComm < 0 then
exit;
if ReadComm(hComm, Data, Len) < 0 then
Error := True;
GetCommEventMask(hComm, Integer($FFFF));
end;
function TComm.IsError: Boolean;
begin
IsError := Error;
Error := False;
end;
procedureRegister;
begin
RegisterComponents('Additional', [TComm]);
end;
end.
Похоже, вы работаете над программой на Delphi, конкретно с компонентом Comm для сериальной связи.
Код предоставлен quite обширный, поэтому я только дам краткое изложение и подчеркну некоторые интересные части.
Обзор
Компонент TComm - это пользовательский компонент, который оборачивает underlying библиотеку для сериальной связи (Win32 API). Он предоставляет интерфейс для настройки сериальных соединений, отправки/получения данных и обработки событий, связанных со статусом соединения.
Ключевые функции
1. Выбор порта: Метод SetPort позволяет выбрать COM-порт (например, COM1, COM2 и т.д.) для связи.
2. Установка скорости передачи: Метод SetBaudRate позволяет установить скорость передачи с помощью значений от tbr110 до tbr256000.
3. Конфигурация байт данных и парности: Методы SetDataBits и SetParity позволяют настроить количество байт данных (4-8) и парность (никак, нечетное, четное, марк, пространство).
4. Установка стоп-битов: Метод SetStopBits позволяет установить количество стоп-битов с помощью значений от tsbOne до tsbTwo.
5. Размеры буферов: Методы SetReadBufferSize и SetWriteBufferSize позволяют настроить размеры буферов чтения и записи.
6. Обработка событий: Вы можете настроить обработчики событий с помощью свойств OnEvent, OnReceive и OnTransmit, которые триггерятся при наступлении определенных событий (например, приема сигнала разрыва).
7. Мониторинг статуса соединения: Свойство IsError позволяет проверить, произошло ли ошибка во время операции связи.
Интересные части
1. Метод SetPort проверяет на наличие ошибок на этапе дизайна или выполнения и корректирует настройки соответственно.
2. Методы DoEvent, DoReceive и DoTransmit обрабатывают уведомления о событиях, которые триггерятся underlying библиотекой для сериальной связи.
3. Метод Loaded инициализирует свойства компонента при загрузке.
В целом, этот код предоставляет прочную основу для создания пользовательского компонента для сериальной связи в Delphi.
Современная программа для управления асинхронной связью с помощью Serial Port в Delphi.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.