Programlama yapalım ve Öğrenelim.

Serial communication ?...

{

Someone was looking for a serial communication control, I just don't

quite remember who it was. Hopefully this code will help him/her..

}

unit Comm;

interface

uses

Messages,WinTypes,WinProcs,Classes,Excepts,Forms,MsgDlg;

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=set of 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) of object;

TNotifyReceiveEvent=

procedure(Sender:TObject;Count:Word) of object;

TNotifyTransmitEvent=

procedure(Sender:TObject;Count:Word) of object;

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;

protected

procedure Loaded;override;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

procedure Write(Data:PChar;Len:Word);

procedure Read(Data:PChar;Len:Word);

function IsError:Boolean;

published

property 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;

procedure Register;

implementation

procedure 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 then

begin

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 then

begin

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;

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);

begin

with Msg do

begin

if Msg=WM_COMMNOTIFY then

begin

case lParamLo of

CN_EVENT:

DoEvent;

CN_RECEIVE:

DoReceive;

CN_TRANSMIT:

DoTransmit;

end;

end

else

Result:=DefWindowProc(FWindowHandle,Msg,wParam,lParam);

end;

procedure TComm.DoEvent;

var

CommEvent:TCommEvents;

EventMask:Word;

begin

if (hComm<0) or not 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;

begin

if (hComm<0) or not Assigned(FOnReceive) then exit;

GetCommError(hComm,Stat);

FOnReceive(Self,Stat.cbInQue);

end;

procedure TComm.DoTransmit;

var

Stat:TComStat;

begin

if (hComm<0) or not Assigned(FOnTransmit) then exit;

GetCommError(hComm,Stat);

FOnTransmit(Self,Stat.cbOutQue);

end;

procedure TComm.Loaded;

begin

inherited Loaded;

HasBeenLoaded:=True;

SetPort(FPort);

end;

constructor TComm.Create(AOwner:TComponent);

begin

inherited 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);

begin

if hComm<0 then exit;

if WriteComm(hComm,Data,Len)<0 then Error:=True;

end;

procedure TComm.Read(Data:PChar;Len:Word);

begin

if hComm<0 then exit;

if ReadComm(hComm,Data,Len)<0 then Error:=True;

end;

function TComm.IsError:Boolean;

begin

IsError:=Error;

Error:=False;

end;

procedure Register;

begin

RegisterComponents('Additional',[TComm]);

end;

end.

{------------------------------------------------------------------------------}

unit Main;

interface

uses

Messages,WinTypes, WinProcs, Classes,

Graphics, Forms, Controls,StdCtrls, Comm;

type

TForm1 = class(TForm)

Memo1: TMemo;

Comm1: TComm;

procedure Memo1KeyPress(Sender: TObject; var Key: Char);

procedure Comm1Receive(Sender: TObject; Count: Word);

end;

var

Form1: TForm1;

implementation

{$R *.FRM}

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

Comm1.Write(@Key,SizeOf(Key));

end;

procedure TForm1.Comm1Receive(Sender: TObject; Count: Word);

var

CommChar:Char;

i:Word;

begin

for i:=1 to Count do

begin

Comm1.Read(@CommChar,SizeOf(CommChar));

PostMessage(Memo1.Handle,WM_CHAR,Word(CommChar),0);

end;

begin

RegisterClasses([TForm1, TMemo, TComm]);

Form1 := TForm1.Create(Application);

end.

Delphi - .....................................

neoturk: ...Serial communication ?...

{

Someone was looking for a serial communication control, I just don't

quite remember who it was. Hopefully this code will help him/her..

}

unit Comm;

interface

uses

Messages,WinTypes,WinProcs,Classes,Excepts,Forms,MsgDlg;

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=set of 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) of object;

TNotifyReceiveEvent=

procedure(Sender:TObject;Count:Word) of object;

TNotifyTransmitEvent=

procedure(Sender:TObject;Count:Word) of object;

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;

protected

procedure Loaded;override;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

procedure Write(Data:PChar;Len:Word);

procedure Read(Data:PChar;Len:Word);

function IsError:Boolean;

published

property 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;

procedure Register;

implementation

procedure 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 then

begin

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 then

begin

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;

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);

begin

with Msg do

begin

if Msg=WM_COMMNOTIFY then

begin

case lParamLo of

CN_EVENT:

DoEvent;

CN_RECEIVE:

DoReceive;

CN_TRANSMIT:

DoTransmit;

end;

end

else

Result:=DefWindowProc(FWindowHandle,Msg,wParam,lParam);

end;

procedure TComm.DoEvent;

var

CommEvent:TCommEvents;

EventMask:Word;

begin

if (hComm<0) or not 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;

begin

if (hComm<0) or not Assigned(FOnReceive) then exit;

GetCommError(hComm,Stat);

FOnReceive(Self,Stat.cbInQue);

end;

procedure TComm.DoTransmit;

var

Stat:TComStat;

begin

if (hComm<0) or not Assigned(FOnTransmit) then exit;

GetCommError(hComm,Stat);

FOnTransmit(Self,Stat.cbOutQue);

end;

procedure TComm.Loaded;

begin

inherited Loaded;

HasBeenLoaded:=True;

SetPort(FPort);

end;

constructor TComm.Create(AOwner:TComponent);

begin

inherited 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);

begin

if hComm<0 then exit;

if WriteComm(hComm,Data,Len)<0 then Error:=True;

end;

procedure TComm.Read(Data:PChar;Len:Word);

begin

if hComm<0 then exit;

if ReadComm(hComm,Data,Len)<0 then Error:=True;

end;

function TComm.IsError:Boolean;

begin

IsError:=Error;

Error:=False;

end;

procedure Register;

begin

RegisterComponents('Additional',[TComm]);

end;

end.

{------------------------------------------------------------------------------}

unit Main;

interface

uses

Messages,WinTypes, WinProcs, Classes,

Graphics, Forms, Controls,StdCtrls, Comm;

type

TForm1 = class(TForm)

Memo1: TMemo;

Comm1: TComm;

procedure Memo1KeyPress(Sender: TObject; var Key: Char);

procedure Comm1Receive(Sender: TObject; Count: Word);

end;

var

Form1: TForm1;

implementation

{$R *.FRM}

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

Comm1.Write(@Key,SizeOf(Key));

end;

procedure TForm1.Comm1Receive(Sender: TObject; Count: Word);

var

CommChar:Char;

i:Word;

begin

for i:=1 to Count do

begin

Comm1.Read(@CommChar,SizeOf(CommChar));

PostMessage(Memo1.Handle,WM_CHAR,Word(CommChar),0);

end;

begin

RegisterClasses([TForm1, TMemo, TComm]);

Form1 := TForm1.Create(Application);

end.

Delphi - .....................................

neoturk: ...Delay procedure in delphi ?...

{This is an equivalent to the Delay procedure in Borland Pascal. You may

find it of interest. It is not mine. It was given to me by someone else

who did not cite the source. Hope it helps your important WWW page. Take

care.

}

procedure TForm1.Delay(msecs:integer);

var

FirstTickCount:longint;

begin

FirstTickCount:=GetTickCount;

repeat

Application.ProcessMessages; {allowing access to other

controls, etc.}

until ((GetTickCount-FirstTickCount) >= Longint(msecs));

end;

Delphi - .....................................

neoturk: ...Delay procedure in delphi ?...

{This is an equivalent to the Delay procedure in Borland Pascal. You may

find it of interest. It is not mine. It was given to me by someone else

who did not cite the source. Hope it helps your important WWW page. Take

care.

}

procedure TForm1.Delay(msecs:integer);

var

FirstTickCount:longint;

begin

FirstTickCount:=GetTickCount;

repeat

Application.ProcessMessages; {allowing access to other

controls, etc.}

until ((GetTickCount-FirstTickCount) >= Longint(msecs));

end;

Delphi - .....................................

neoturk: ...How to use a custom cursor ?...

Q: How do I use one of the cursor files in the c:delphiimagescursors?

A: Use the image editor to load the cursor into a RES file.

The following example assumes that you saved the cursor in the RES file

as "cursor_1", and you save the RES file as MYFILE.RES.

(*** BEGIN CODE ***)

{$R c:programsdelphiMyFile.res} { This is your RES file }

const PutTheCursorHere_Dude = 1; { arbitrary positive number }

procedure stuff;

begin

screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance,

PChar('cursor_1'));

screen.cursor := PutTheCursorHere_Dude;

end;

Delphi - .....................................

neoturk: ...How to use a custom cursor ?...

Q: How do I use one of the cursor files in the c:delphiimagescursors?

A: Use the image editor to load the cursor into a RES file.

The following example assumes that you saved the cursor in the RES file

as "cursor_1", and you save the RES file as MYFILE.RES.

(*** BEGIN CODE ***)

{$R c:programsdelphiMyFile.res} { This is your RES file }

const PutTheCursorHere_Dude = 1; { arbitrary positive number }

procedure stuff;

begin

screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance,

PChar('cursor_1'));

screen.cursor := PutTheCursorHere_Dude;

end;

Delphi - .....................................

neoturk: ...Currency edit component ?...

unit CurrEdit;

(**************************************************************************

This is my first custom control, so please be merciful. I needed a simple

currency edit field, so below is my attempt. It has pretty good behavior

and I have posted it up to encourage others to share their code as well.

Essentially, the CurrencyEdit field is a modified memo field. I have put

in keyboard restrictions, so the user cannot enter invalid characters.

When the user leaves the field, the number is reformatted to display

appropriately. You can left-, center-, or right-justify the field, and

you can also specify its display format - see the FormatFloat command.

The field value is stored in a property called Value so you should read

and write to that in your program. This field is of type Extended.

If you like this control you can feel free to use it, however, if you

modify it, I would like you to send me whatever you did to it. If you

send me your CIS ID, I will send you copies of my custom controls that

I develop in the future. Please feel free to send me anything you are

working on as well. Perhaps we can spark ideas!

Robert Vivrette, Owner

Prime Time Programming

PO Box 5018

Walnut Creek, CA 94596-1018

Fax: (510) 939-3775

CIS: 76416,1373

Net: RobertV@ix.netcom.com

Thanks to Massimo Ottavini, Thorsten Suhr, Bob Osborn, Mark Erbaugh, Ralf

Gosch, Julian Zagorodnev, and Grant R. Boggs for their enhancements!

Please look for this and other components in the "Unofficial Newsletter of

Delphi Users" posted on the Borland Delphi forum on Compuserve (GO DELPHI)

in the "Delphi IDE" file section.

**************************************************************************)

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Menus, Forms, Dialogs, StdCtrls;

type

TCurrencyEdit = class(TCustomMemo)

private

DispFormat: string;

FieldValue: Extended;

FDecimalPlaces : Word;

FPosColor : TColor;

FNegColor : TColor;

procedure SetFormat(A: string);

procedure SetFieldValue(A: Extended);

procedure SetDecimalPlaces(A: Word);

procedure SetPosColor(A: TColor);

procedure SetNegColor(A: TColor);

procedure CMEnter(var Message: TCMEnter); message CM_ENTER;

procedure CMExit(var Message: TCMExit); message CM_EXIT;

procedure FormatText;

procedure UnFormatText;

protected

procedure KeyPress(var Key: Char); override;

procedure CreateParams(var Params: TCreateParams); override;

public

constructor Create(AOwner: TComponent); override;

published

property Alignment default taRightJustify;

property AutoSize default True;

property BorderStyle;

property Color;

property Ctl3D;

property DecimalPlaces: Word read FDecimalPlaces write SetDecimalPlaces default 2;

property DisplayFormat: string read DispFormat write SetFormat;

property DragCursor;

property DragMode;

property Enabled;

property Font;

property HideSelection;

property MaxLength;

property NegColor: TColor read FNegColor write SetNegColor default clRed;

property ParentColor;

property ParentCtl3D;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property PosColor: TColor read FPosColor write SetPosColor default clBlack;

property ReadOnly;

property ShowHint;

property TabOrder;

property Value: Extended read FieldValue write SetFieldValue;

property Visible;

property OnChange;

property OnClick;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnEndDrag;

property OnEnter;

property OnExit;

property OnKeyDown;

property OnKeyPress;

property OnKeyUp;

property OnMouseDown;

property OnMouseMove;

property OnMouseUp;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Additional', [TCurrencyEdit]);

end;

constructor TCurrencyEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoSize := False;

Alignment := taRightJustify;

Width := 121;

Height := 25;

DispFormat := '$,0.00;($,0.00)';

FieldValue := 0.0;

FDecimalPlaces := 2;

FPosColor := Font.Color;

FNegColor := clRed;

AutoSelect := False;

{WantReturns := False;}

WordWrap := False;

FormatText;

end;

procedure TCurrencyEdit.SetFormat(A: String);

begin

if DispFormat <> A then

begin

DispFormat:= A;

FormatText;

end;

procedure TCurrencyEdit.SetFieldValue(A: Extended);

begin

if FieldValue <> A then

begin

FieldValue := A;

FormatText;

end;

procedure TCurrencyEdit.SetDecimalPlaces(A: Word);

begin

if DecimalPlaces <> A then

begin

DecimalPlaces := A;

FormatText;

end;

procedure TCurrencyEdit.SetPosColor(A: TColor);

begin

if FPosColor <> A then

begin

FPosColor := A;

FormatText;

end;

procedure TCurrencyEdit.SetNegColor(A: TColor);

begin

if FNegColor <> A then

begin

FNegColor := A;

FormatText;

end;

procedure TCurrencyEdit.UnFormatText;

var

TmpText : String;

Tmp : Byte;

IsNeg : Boolean;

begin

IsNeg := (Pos('-',Text) > 0) or (Pos('(',Text) > 0);

TmpText := '';

For Tmp := 1 to Length(Text) do

if Text[Tmp] in ['0'..'9',DecimalSeparator] then

TmpText := TmpText + Text[Tmp];

try

If TmpText='' Then TmpText := '0.00';

FieldValue := StrToFloat(TmpText);

if IsNeg then FieldValue := -FieldValue;

except

MessageBeep(mb_IconAsterisk);

end;

procedure TCurrencyEdit.FormatText;

begin

Text := FormatFloat(DispFormat,FieldValue);

if FieldValue < 0 then

Font.Color := NegColor

else

Font.Color := PosColor;

end;

procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);

begin

SelectAll;

inherited;

end;

procedure TCurrencyEdit.CMExit(var Message: TCMExit);

begin

UnformatText;

FormatText;

Inherited;

end;

procedure TCurrencyEdit.KeyPress(var Key: Char);

Var

S : String;

frmParent : TForm;

btnDefault : TButton;

i : integer;

wID : Word;

LParam : LongRec;

begin

{#8 is for Del and Backspace keys.}

if Not (Key in ['0'..'9','.','-', #8, #13]) Then Key := #0;

case Key of

#13 : begin

frmParent := GetParentForm(Self);

UnformatText;

{find default button on the parent form if any}

btnDefault := nil;

for i := 0 to frmParent.ControlCount -1 do

if frmParent.Controls[i] is TButton then

if (frmParent.Controls[i] as TButton).Default then

btnDefault := (frmParent.Controls[i] as TButton);

{if there's a default button, then make the parent form think it was pressed}

if btnDefault <> nil then

begin

wID := GetWindowWord(btnDefault.Handle, GWW_ID);

LParam.Lo := btnDefault.Handle;

LParam.Hi := BN_CLICKED;

SendMessage(frmParent.Handle, WM_COMMAND, wID, longint(LParam) );

end;

Key := #0;

end;

{ allow only one dot in the number }

'.' : if ( Pos('.',Text) >0 ) then Key := #0;

{ allow only one '-' in the number and only in the first position: }

'-' : if ( Pos('-',Text) >0 ) or ( SelStart > 0 ) then Key := #0;

else

{ make sure no other character appears before the '-' }

if ( Pos('-',Text) >0 ) and ( SelStart = 0 ) and (SelLength=0) then Key := #0;

end;

if Key <> Char(vk_Back) then

begin

{S is a model of Text if we accept the keystroke. Use SelStart and

SelLength to find the cursor (insert) position.}

S := Copy(Text,1,SelStart)+Key+Copy(Text,SelStart+SelLength+1,Length(Text));

if ((Pos(DecimalSeparator, S) > 0) and

(Length(S) - Pos(DecimalSeparator, S) > FDecimalPlaces)) {too many decimal places}

or ((Key = '-') and (Pos('-', Text) <> 0)) {only one minus...}

or (Pos('-', S) > 1) {... and only at beginning}

then Key := #0;

end;

if Key <> #0 then inherited KeyPress(Key);

end;

procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);

var

lStyle : longint;

begin

inherited CreateParams(Params);

case Alignment of

taLeftJustify : lStyle := ES_LEFT;

taRightJustify : lStyle := ES_RIGHT;

taCenter : lStyle := ES_CENTER;

end;

Params.Style := Params.Style or lStyle;

end;

end.