Delphİ İle Comdan AliŞverİŞ

[irfanani2]

Arkadaşlar Merhaba;
Ben Laboratuar Cihazının çalıştıgı testi Delphi ile yazılan program ile okumak ve gerektiğinde ona bilgi gondermek istiyorum. Tabi bunları COM (RS232) ile gerçekleştirmek istiyorum. Allah Aşkına yardım edin hiçmi bu konuyu bilen yok.!!!!
irfanani2@gmail.com bilgi paylaşmak yada kaynak vermek isteyen arkadaşlara.

[powertrk]

Merhaba,
Bu com port kontrol için gerekli bileşen.

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

Buda nasıl kullanacağına dair bir örnek.

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;
end;
begin
  RegisterClasses([TForm1, TMemo, TComm]);
  Form1 := TForm1.Create(Application);
end.