unit SerialNGBasic; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, SerialNG; type TSerialNGBasicDLG = class(TForm) OKBtn: TButton; CancelBtn: TButton; Bevel1: TBevel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; CBPort: TComboBox; CBBaud: TComboBox; CBData: TComboBox; CBStop: TComboBox; CBParity: TComboBox; CBFlow: TComboBox; private { Private declarations } public { Public declarations } procedure SetDLGData(SerialPortNG : TSerialPortNG); procedure GetDLGData(SerialPortNG : TSerialPortNG); end; var SerialNGBasicDLG: TSerialNGBasicDLG; implementation {$R *.DFM} procedure TSerialNGBasicDLG.SetDLGData(SerialPortNG : TSerialPortNG); var i : Integer; begin i := CBPort.Items.IndexOf(SerialPortNG.CommPort); if i >= 0 then CBPort.ItemIndex := i else CBPort.ItemIndex := 1; //COM2 i := CBBaud.Items.IndexOf(IntToStr(SerialPortNG.BaudRate)); if i >= 0 then CBBaud.ItemIndex := i else CBBaud.ItemIndex := 6; // 9600 i := CBData.Items.IndexOf(IntToStr(SerialPortNG.DataBits)+' Bit'); if i >= 0 then CBData.ItemIndex := i else CBData.ItemIndex := 4; // 8 Bit CBStop.ItemIndex := SerialPortNG.StopBits; CBParity.ItemIndex := SerialPortNG.ParityType; case SerialPortNG.FlowControl of fcNone : CBFlow.ItemIndex := 0; fcXON_XOFF : CBFlow.ItemIndex := 1; fcRTS_CTS : CBFlow.ItemIndex := 2; fcDSR_DTR : CBFlow.ItemIndex := 3; else CBFlow.ItemIndex := 0; end; end; procedure TSerialNGBasicDLG.GetDLGData(SerialPortNG : TSerialPortNG); begin SerialPortNG.CommPort := CBPort.Items[CBPort.ItemIndex]; SerialPortNG.BaudRate := StrToIntDef(CBBaud.Items[CBBaud.ItemIndex],9600); SerialPortNG.DataBits := StrToIntDef(Copy(CBData.Items[CBData.ItemIndex],1,1),8); SerialPortNG.StopBits := CBStop.ItemIndex; SerialPortNG.ParityType := CBParity.ItemIndex; SerialPortNG.FlowControl := BasicFlowModes[CBFlow.ItemIndex]; SerialPortNG.Active := True; end; end.
unit SerialNG; // DomIS Internet Solutions http://www.domis.de // Visit SerialNG Homepage http://www.domis.de/serialng.htm // This Source is distributed under the terms of Open-Source // This mean You can use this Source free for Open-Source development // Additionally I allow the use for any inhouse Projects // If You want to make a Closed-Source Project with this Source, // You have to reference Back to the Source and have to distribute the Source // Any changes should be marked and this header should remain here // Under all circumstances it is prohibited to use this source for military Products!!! // Refer the readme.txt // This is Version 2 of the Basic Communication Component // I've made a complete redesign of the whole Component // So the Component is incompatible with the Version 1 // News: // Using Overlapped features for Windows Platform Compatiblity // Using CommEvents for state detection // More (and more meaningfull) Events // Sending will not block the main Program // Support the development of SerialNG with a donation. Any amount will be welcome // You may transmit the Money to my Bank-Account // Kto. 654130-604, Postbank Frankfurt/M, BLZ 500 100 60, Kennwort SerialNG // for International transmission, use the IBAN Code // IBAN DE 56 5001 0060 0654 1306 04 // You may also use Paypal if You like // Link for EURO transmission // https://www.paypal.com/xclick/business=paypal%40domis.de&item_name=Support+SerialNG+Development&item_number=SerialNG-EUR&tax=0¤cy_code=EUR // Link for USD transmission // https://www.paypal.com/xclick/business=paypal%40domis.de&item_name=Support+SerialNG+Development&item_number=SerialNG-USD&tax=0¤cy_code=USD // Thank You for using and supporting SerialNG! // Installation // You have to register this component with the Delphi funktion "Component/Install Component" // create a new component library and add this component // the TSerialNG component appears in the "Samples" part of the component toolbar // See http://domis.de/serialnginst.htm // Usage // Please take a look to the Demofiles. // Start with SerialNGBasicDemo.dpr, this contains a very simple approach to the component // The Base of the Version 1.X of this unit is taken from "TSerialPort: Basic Serial Communications in Delphi" // created by Jason "Wedge" Perry, but I could not find him again // PC serial port Pins are as follows // Name Dir 9Pin 25Pin // DCD In 1 8 // RXD In 2 3 // TXD Out 3 2 // DTR Out 4 20 // GND - 5 7 // DSR In 6 6 // RTS Out 7 4 // CTS In 8 5 // RI In 9 22 // Dir means the direction from the ports view (e.g. DCD is an input, You can read this port) // Version History // All Version are available at http://www.domis.de/serialng.htm // 2.0.0 28. Aug 2001, Basic stable Version // 2.0.1 30. Aug 2001, Fixing Thread stoperror in PortWord // 2.0.2 17. Sep 2001, Deleting double declared Property Error, use instead CommError // Changed declaration of procedure GetCommNames(CommNames : TStrings); // prevent duplicate Entries in this function // 2.0.3 9. Nov 2001, Changed Cardinal type to DWORD in TWorkThread.Execute for // Delphi 3 backcompatibility // 2.0.4 28. Nov 2001, Problem in not Active Mode fixed ( // sleep(200) prevent consuming 100% of cpu-time in inactive mode) // 2.0.5 8. Jan 2002, Problem in GetDataAsPChar fixed ( // The pending Zero was not patched in the right place) // 2.0.6 4. Apr 2002, Changed *all* Cardinal type to DWORD and made several Changes in // Demo Forms for Delphi 3 backcompatibility // 2.0.7 16. Apr 2002, Found and fixed the norty Error which occours sometimes after // the Termination of the Threads (the Overlapped Result wrote into undefined Memory) // The Thread waits now until everything Pending Overlapped is done // 2.0.8 13. Mai 2002, Correct Error with the default timing settings (Thanks to Hynek Cernoch) // 2.0.9 27. Mai 2002, Patched an "\\.\" in front of Comportname to allow connection to virtual Comports // 2.0.10 27. Aug 2002, Function for finding the CommPorts in the Registry created and placed in // Unit CommPortList. The CheckOS function is moved into theis Unit too. // 2.0.11 6. Sep 2002, Again or Finally? Found and fixed the norty Error which occours sometimes after // the Termination of the Threads (the Overlapped Result wrote into undefined Memory) // Now the WaitCommEvent Overlapped is manually Terminated, by Setting (!) the hEvent manually // Some minor cleanups in Destroy and PortWork. It seem (!) to run now! // 2.0.12 10. Sep 2002, Again! Small, but significant Error in PortWork. Closing the Handles to the Overlapped // Records should not be there - fixed and running. Thanks to Jens G�hring // 2.0.13 25. Sep 2002, Fixed a Problem for multi instancing, e.g. running two or more SerialNGPorts at the same time // The Names of the Overlapped Events are allway the same, so the second Port used the event from // the previous instanced Port instead creating a new event // 2.0.14 1. Okt 2002, Made a more robust solution for creating the Eventnames. There is now a 1:200000 chance that // the program can not create a Eventname. This occours only on Multiport installation. // The 1:200000 chance is a compromise between hangup the program in an endless loop and returning an Error. // 2.0.15 17. Okt 2002, A Ssmall change in the ReadSettings from Registry Procedure suggested by Ron Hoving // After reading the Settings they are used now instantly // 2.0.16 14. Nov 2002, Patched an suggestion from Krystian (Poland) // The Linestates CTS, DSR and RLSD are now updated, even if no Event is assigned // 2.0.17 25. Mrz 2003 GetStatus is now (and must!) called prior to DoCommEvent, to ensure the actual state is used // Prozesserror gives the Self pointer (instead the wrong Owner pointer) // The silly Eventname stuff removed // 2.0.18 24. Jun 2003 Changes on the RI behaviour: // The RI Linestate is now updated at the same place as CTS,DSR and RLSD and valid in the OnCommEvent // The RI Event is now on Win9x/mE simulated as NT/2K/XP does, on the falling RI edge only!!! // Thus the OnRingEvent is called *only* on the falling edge of the signal // Additionally a new OnRIEvent has been inserted. This Event is manually generated if a // change in the RI Signal has been detected. // If Your Program should show a 'RING' ... 'RING' because a Modem is attached use the OnRingEvent // If Your Program will track the RI Pin State use the OnRIEvent // 2.0.19 07. Okt 2003 New Parameterlist fpr processerror, reinstall of component neccessary // 2.0.20 15. Okt 2003 Fixing a Thread error: StartTime was uninitilized in the case of receiving Chars between // the opening of the Port and the first 'ReadNoWait'. // Probably this Error will occour only in Debugsessions // 2.0.21 01. Dec 2003 Made some changes for (more) compatibility to francois piette's ICS. // If in a 'OnDataAvailable' Event of the TWSocket the SerialNG Thread calls 'Synchronize' // the Thread is locked, and the 'SendInProgress' Flag will never become reset. // This behaviour results (probably) in the WndProc work of ICS. // I made a work around: A new Property 'ThreadQuiteMode' is now integrated. // If this Flag become True the Thread will not call synchronize. // Be careful with this Flag, since You receive no messages, you may been misleaded. // You have to Poll incoming data by Yourself. // 2.0.22 13. Jan 2004 Fixed an Error in QuieteMode using Enter and LeaveCriticalSection. This is made // to add and remove the Data securily without the need of Threadsynchronize // 2.0.23 13. Mrz 2004 Found and fixed a Problem under fast (2.4GHz) Win2K and XP Computers: // Windows seems to send the EventCharEvent before the received Chars are moved into // the WindowsQueue. So the CommStatus.cbInQue contains an invalid char amount // I now call the ClearCommError at least twice until no changes in the results // 2.0.24 16. Nov 2004 Fixed a Problem occours under Win2K: wrong result out of GetOverlappedResult // Thanks to Phil Young (62Nds), and ThomasD // I am working on a Multiport-Single-Thread version, this will cause some incompatiblities to the current version // This will become Version 2.1.0 interface {$BOOLEVAL OFF} uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; // Definitions for the DCB found in windows.pas for reference only // All of the baud rates that the DCB supports. const BaudRateCount = 15; BaudRates : array[0..BaudRateCount-1] of DWord = (CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600, CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200, CBR_128000, CBR_256000); // The business with the TimeOuts during sending Data, and esspeccialy during // reception of Data depends on the selected Baudrate. // while on 9600 Baud every 1ms a Char is received, is this time on 256KBaud only 4�s // Strange enough, windows support only 1ms as shortest Intervall! // Below some standard TimeOuts for the given Baudrates in �s XTOCharDelayDef : array [0..BaudRateCount-1] of DWord = (100000, 37000, 18000, 9000, 4500, 2300, 1100, 760, 570, 290, 200, 190, 95, 85, 43); // Parity types for parity error checking // NOPARITY = 0; ODDPARITY = 1; EVENPARITY = 2; MARKPARITY = 3; SPACEPARITY = 4; // Stopbits // ONESTOPBIT = 0; ONE5STOPBITS = 1; TWOSTOPBITS = 2; // Bitmasks for the "Flags" Field of the DCB record const bmfBinary = $0001; // binary mode, no EOF check bmfParity = $0002; // enable parity checking bmfOutxCtsFlow = $0004; // CTS output flow control bmfOutxDsrFlow = $0008; // DSR output flow control // DTR Control Flow Values DTR_CONTROL_DISABLE = 0; DTR_CONTROL_ENABLE = 1; DTR_CONTROL_HANDSHAKE = 2; bmfDtrControlEnable = $0010; // DTR Enable bmfDtrControlHandshake = $0020; // DTR Handshake bmfDsrSensitivity = $0040; // DSR sensitivity bmfTXContinueOnXoff = $0080; // XOFF continues Tx bmfOutX = $0100; // XON/XOFF out flow control bmfInX = $0200; // XON/XOFF in flow control bmfErrorChar = $0400; // enable error replacement bmfNull = $0800; // enable null stripping // RTS Control Flow Values RTS_CONTROL_DISABLE = 0; RTS_CONTROL_ENABLE = 1; RTS_CONTROL_HANDSHAKE = 2; RTS_CONTROL_TOGGLE = 3; bmfRtsControlEnable = $1000; // RTS Enable bmfRtsControlHandshake = $2000; // RTS Enable bmfRtsControlToggle = $3000; // RTS Enable bmfAbortOnError = $4000; // abort reads/writes on error // Basic FlowControlModes // You may declare more _exotic_ Modes, like Sending RTS/CTS, receiving XOn/XOff :-) const fcNone = 0; fcXON_XOFF = bmfOutX or bmfInX or bmfTXContinueOnXoff; fcRTS_CTS = bmfOutxCtsFlow or bmfRtsControlHandshake; fcDSR_DTR = bmfOutxDsrFlow or bmfDtrControlHandshake; fcClearFlowCtrl = Not (fcXON_XOFF or fcRTS_CTS or fcDSR_DTR or bmfDtrControlEnable or bmfRtsControlEnable); const BasicFlowModes : array[0..3] of Word = (fcNone, fcXON_XOFF, fcRTS_CTS, fcDSR_DTR); // Constants for using in the ErrorNoise Property // I tried to catch Errors, send Warnings or sometimes Messages for Your convinience. // If You set the ErrorNoise Property to one of the Values this kind of Messages will be reported // while those with higher Numbers not const enError = 0; // Errors like unable to Open Port enWarning = 1; // Warnings like cant pause Thread enMsg = 2; // Messages like starting with Port opening enDebug = 3; // Debughelpermessage like im am here or there enAll = 255; // Show all const // Set some constant defaults. // These are the equivalent of COM2:9600,N,8,1; dflt_CommPort = 'COM2'; dflt_BaudRate = CBR_9600; dflt_ParityType = NOPARITY; dflt_ParityErrorChar = #0; dflt_ParityErrorReplacement = False; dflt_StopBits = ONESTOPBIT; dflt_DataBits = 8; dflt_XONChar = #$11; {ASCII 11h} dflt_XOFFChar = #$13; {ASCII 13h} dflt_XONLimDiv = 33; // Set the XONLimit to dflt_XONLimDiv/100*RxQueueSize dflt_XOFFLimDiv = 33; // Set the XONLimit to dflt_XONLimDiv/100*RxQueueSize dflt_FlowControl = fcNone; dflt_StripNullChars = False; dflt_BinaryMode = True; dflt_EventChar = #0; // Timeout defaults, fits only to 9600 Baud! // Look that CharDelay is in micro, ExtraDely in milli Seconds! dflt_RTOCharDelayTime = 1100; // 1100microsec (1100E-06 secs) dflt_RTOExtraDelayTime = 250; // 250msec ( 250E-03 secs) dflt_WTOCharDelayTime = 1100; // 1100microsec (1100E-06 secs) dflt_WTOExtraDelayTime = 250; // 1000msec ( 250E-03 secs) dflt_XTOAuto = True; // lets the Component adjust CharDelay timing on every Baudrate change dflt_ClusterSize = 3072; //Max Clustersize dflt_RTSState = True; dflt_DTRState = True; dflt_ErrorNoise = enMsg; dflt_BREAKState = False; dflt_RxQueueSize = 4096; dflt_TxQueueSize = 4096; dflt_ThreadQuietMode = False; dflt_AutoReadRequest = False; type // Special Event function for the Error and Warning TNotifyErrorEvent = procedure(Sender : TObject;Place, Code: DWord; Msg : String; Noise : Byte) of object; // TSerialCluster is a Object for the Receiving Process. // If You just want to receive some Data, don't care // Under normal circumstances You have not to deal with this Object // I decided to realize the receiving Process as follow: // Between two cycles in the WorkThread may the SerialPort receive more than one Character. // Basicly those Chars are named "Cluster" (and not "Telegram", as You might expect) // How many Chars are stored in one TSerialCluster depeds on, User controlled, Conditions // 1. the ClusterSize is reched // 2. the Receivingtime is reached // 3. an (Line-) Error occoured // 4. The Program set the "ReadRequest" Property to "True" // If the condition is met, the received Chars are Stored as a Cluster into the ClusterList PSerialCluster = ^TSerialCluster; TSerialCluster = class (TObject) private ClusterData : Pointer; // Pointer to Data ClusterSize : Integer; // How many Bytes in Datafield ClusterCCError : DWord; // This Value comes from the ClearCommError function and is a Bitfield // CE_RXOVER = 1; { Receive Queue overflow } // CE_OVERRUN = 2; { Receive Overrun Error } // CE_RXPARITY = 4; { Receive Parity Error } // CE_FRAME = 8; { Receive Framing error } // CE_BREAK = $10; { Break Detected } // CE_TXFULL = $100; { TX Queue is full } // CE_MODE = $8000; { Requested mode unsupported } public constructor Create(Data : Pointer; Size : Integer; CCError : DWord); function GetCCError : DWord; function GetSize : Integer; procedure GetData(Dest : Pointer); function GetDataAsString : String; function GetDataAsPChar(Dest : PChar) : PChar; destructor Destroy; override; end; // TSerialPortNG is the Heart of the Job, everything what has to do with the // SerialPort should be done with this Component // The Concept is as follows: // After instancing the Port is still closed // You should set the Property "CommPort" to the full Name of the Port e.g. 'COM1' // After this set the "Active" Property to "True" // Sending Data ist performed with the SendData or the SendString procedures // since Sendig is "Overlapped" the procedures returns immidiatly and You can do // some other Jobs in Your main Programm // You should not reentry this Procedures until they done there Job (Will give a warning). // If send is done the component call the "OnWriteDone" Event. // You also can ask the "SendInProgress" Property. // Reading Data is fairly simple, just Read the Data with one of the "ReadNextCluster..." functions // You place the read Access into the "OnRxClusterEvent". // See sample Programs for more Information TSerialPortNG = class(TComponent) private // Variables holding Values for Properties fCommPort : ShortString; fBaudRate : DWord; fParityType : Byte; fParityErrorChar : Char; fParityErrorReplacement : Boolean; fStopBits : Byte; fDataBits : Byte; fXONChar : Char; fXOFFChar : Char; fXONLimDiv : Byte; // 0..100 fXOFFLimDiv : Byte; // 0..100 fFlowControl : LongInt; fStripNullChars : Boolean; // Strip null chars? fEventChar : Char; fErrorNoise : Byte; // These fields are set in the EventThread fCommStateFlags : TComStateFlags; fCommStateInQueue : DWord; fCommStateOutQueue : DWord; fCommError : DWord; fCommEvent : DWord; fModemState : DWord; // TimeOut definitions fRTOCharDelayTime : DWord; // in �s max: 4.294.967.295�s aprox 1h 20min fRTOExtraDelayTime : Word; // in ms fWTOCharDelayTime : DWord; // in �s fWTOExtraDelayTime : Word; // in ms fXTOAuto : Boolean; fActive : Boolean; fRTSState : Boolean; fDTRState : Boolean; fBREAKState : Boolean; fCTSState : Boolean; fDSRState : Boolean; fRLSDState : Boolean; fRingState : Boolean; fClusterSize : Word; fRxQueueSize : Word; fTxQueueSize : Word; fReadRequest : Boolean; // Force Thread to Read the Queue fSendInProgress : Boolean; fWrittenBytes : DWord; fThreadQuietMode : Boolean; fAutoReadRequest : Boolean; // Eventvariables fOnTxQueueEmptyEvent : TNotifyEvent; fOnCommEvent : TNotifyEvent; fOnCommStat : TNotifyEvent; fOnBreakEvent : TNotifyEvent; fOnCTSEvent : TNotifyEvent; fOnDSREvent : TNotifyEvent; fOnLineErrorEvent : TNotifyEvent; fOnRingEvent : TNotifyEvent; fOnRIEvent : TNotifyEvent; fOnRLSDEvent : TNotifyEvent; fOnRxClusterEvent : TNotifyEvent; fOnRxCharEvent : TNotifyEvent; fOnRxEventCharEvent : TNotifyEvent; fOnWriteDone : TNotifyEvent; fOnProcessError : TNotifyErrorEvent; hCommPort : THandle; // Handle to the port. WriteOverlapped : TOverlapped; //Overlapped field for Write ReadOverlapped : TOverlapped; //Overlapped field for Read StatusOverlapped : TOverlapped; //Overlapped field for Status BytesToWrite : DWord; WriteStartTime : DWord; WorkThread : TThread; WorkThreadIsRunning : Boolean; WorkThreadIsTerminated : Boolean; ShutdownInProgress : Boolean; RxDClusterList : TList; LastErr : Integer; Platform : Integer; // 0 Win32s on Win3.11, 1 Win 9x, 2 WinNT CriticalSection: TRTLCriticalSection; // Procedures for setting the variables, refrenced in the Properties procedure SetCommPort(value : ShortString); procedure SetBaudRate(value : DWord); procedure SetParityType(value : Byte); procedure SetParityErrorChar(value : Char); procedure SetParityErrorReplacement(value : Boolean); procedure SetStopBits(value : Byte); procedure SetDataBits(value : Byte); procedure SetXONChar(value : Char); procedure SetXOFFChar(value : Char); procedure SetXONLimDiv(value : Byte); procedure SetXOFFLimDiv(value : Byte); procedure SetFlowControl(value : LongInt); procedure SetStripNullChars(value : Boolean); procedure SetEventChar(value : Char); procedure SetRTOCharDelayTime(value : DWord); procedure SetRTOExtraDelayTime(value : Word); procedure SetWTOCharDelayTime(value : DWord); procedure SetWTOExtraDelayTime(value : Word); procedure SetXTOAuto(value : Boolean); procedure SetClusterSize(value : Word); procedure SetRxQueueSize(value : Word); procedure SetTxQueueSize(value : Word); procedure SetErrorNoise(value : Byte); procedure SetSignalRTS(State : Boolean); procedure SetSignalDTR(State : Boolean); procedure SetSignalBREAK(State : Boolean); procedure SetReadRequest(value : Boolean); procedure SetActive(NewState : Boolean); // Rest of Procedures procedure InitOverlapped(var Overlapped : TOverlapped); procedure ResetOverlapped(var Overlapped : TOverlapped); procedure SetOverlapped(var Overlapped : TOverlapped); procedure SetupDCB; procedure PortWork (ReOpen : Boolean); //If ReOpen is True the Port will be (Re-) Opened, otherwise closed. The ActiveFlag will bes Set! procedure EnableEvents; procedure ProcessError(Place, Code : DWord; Msg : String; Noise : Byte); procedure WorkThreadDone(Sender: TObject); procedure WaitForThreadNotRunning(Counter : Integer); protected public // Procedures for external calling constructor Create(AOwner : TComponent); override; //Create the Component destructor Destroy; override; //Destroy procedure SendData (Data : Pointer; Size : DWord); //Send binary Data procedure SendString(S : String); //Send String Data // Clusterfunctions works on received Datapackages function NextClusterSize : Integer; function NextClusterCCError : DWord; function ReadNextCluster(var ClusterSize : Integer; var CCError : DWord) : Pointer; function ReadNextClusterAsString : String; function ReadNextClusterAsPChar(Dest : PChar) : PChar; // Clears the Queues procedure ClearTxDQueue; procedure ClearRxDQueue; // Sets the Timingfields in depedecy to the Baudrate procedure XTODefault; // Save and retrieves the Setting to/from the registry procedure WriteSettings(Regkey, RegSubKey : String); // e.g. WriteSettings('Software/DomIS','SerialNGAdvDemo') will save to HKEY_CURRENT_USER\Software\DomIS\SerialAdvDemo procedure ReadSettings(Regkey, RegSubKey : String); published //If You set Active to True, the component tries to Open the Port, if Opened the state remains True. property Active : Boolean read FActive write SetActive default False; property ComHandle : THandle read hCommPort default INVALID_HANDLE_VALUE; property CommPort : ShortString read fCommPort write SetCommPort; property BaudRate : DWord read fBaudRate write SetBaudRate default dflt_BaudRate; property ParityType : Byte read fParityType write SetParityType default dflt_ParityType; property ParityErrorChar : Char read fParityErrorChar write SetParityErrorChar default dflt_ParityErrorChar; property ParityErrorReplacement : Boolean read fParityErrorReplacement write SetParityErrorReplacement default dflt_ParityErrorReplacement; property StopBits : Byte read fStopBits write SetStopBits default dflt_StopBits; property DataBits : Byte read fDataBits write SetDataBits default dflt_DataBits; property XONChar : Char read fXONChar write SetXONChar default dflt_XONChar; property XOFFChar : Char read fXOFFChar write SetXOFFChar default dflt_XOFFChar; property XONLimDiv : Byte read fXONLimDiv write SetXONLimDiv default dflt_XOnLimDiv; property XOFFLimDiv : Byte read fXOFFLimDiv write SetXOFFLimDiv default dflt_XOffLimDiv; property FlowControl : LongInt read fFlowControl write SetFlowControl default dflt_FlowControl; property StripNullChars : Boolean read fStripNullChars write SetStripNullChars default dflt_StripNullChars; property EventChar : Char read fEventChar write SetEventChar default dflt_EventChar; // One part of the Clusterdefinition is here, please read carefully // The "RTOCharDelayTime" is the Time that may delay between two received Chars // This Time should be Computed depending from the Baudrate e.g. 9600 Baud -> 960 Chars per Second -> Delay 1ms // You can use the CharDelayDefault Procedure to set RTOCharDelayTime and WTOCharDelayTime depending // of the selected Baudrate! property RTOCharDelayTime : DWord read fRTOCharDelayTime write SetRTOCharDelayTime default dflt_RTOCharDelayTime; // The "RTOExtraDelayTime" is the Time that may delay addionally once // So if the (CharCount*RTOCharDelayTime)/1000 + RTOExtraDelayTime extends the measured Time, a Cluster will be build property RTOExtraDelayTime : Word read fRTOExtraDelayTime write SetRTOExtraDelayTime default dflt_RTOExtraDelayTime; // Clustersize specify how long one Cluster could become max property ClusterSize : Word read fClusterSize write SetClusterSize default dflt_ClusterSize; // RxQueueSize specify the amount of Chars that could be received without reading, // this should be longer than the Cluster size to prevent overrun errors property RxQueueSize : Word read fRxQueueSize write SetRxQueueSize default dflt_RxQueueSize; property TxQueueSize : Word read fTxQueueSize write SetTxQueueSize default dflt_TxQueueSize; property WTOCharDelayTime : DWord read fWTOCharDelayTime write SetWTOCharDelayTime default dflt_WTOCharDelayTime; property WTOExtraDelayTime : Word read fWTOExtraDelayTime write SetWTOExtraDelayTime default dflt_WTOExtraDelayTime; property XTOAuto : Boolean read fXTOAuto write SetXTOAuto default dflt_XTOAuto; property RTSState : Boolean read fRTSState write SetSignalRTS default dflt_RTSState; property DTRState : Boolean read fDTRState write SetSignalDTR default dflt_DTRState; property BREAKState : Boolean read fBREAKState write SetSignalBREAK default dflt_BreakState; property CTSState : Boolean read fCTSState; property DSRState : Boolean read fDSRSTate; property RLSDState : Boolean read fRLSDState; property RingState : Boolean read fRingState; property ErrorNoise : Byte read fErrorNoise write SetErrorNoise default dflt_ErrorNoise; property ReadRequest : Boolean read fReadRequest write SetReadRequest default False; property SendInProgress : Boolean read fSendInProgress; property CommError : DWord read fCommError; property CommStateFlags : TComStateFlags read fCommStateFlags; property CommStateInQueue: DWord read fCommStateInQueue; property CommStateOutQueue : DWord read fCommStateOutQueue; property ModemState : DWord read fModemState; property CommEvent : DWord read fCommEvent; property WrittenBytes : DWord read fWrittenBytes; property ThreadQuietMode : Boolean read fThreadQuietMode write fThreadQuietMode default dflt_ThreadQuietMode; //THIS FLAG SHOULD BE SET TO TRUE ONLY IN VERY SPECIAL CASES!!! No Syncromize call in the Thread if True. property AutoReadRequest : Boolean read fAutoReadRequest write fAutoReadRequest default dflt_AutoReadRequest; // Event Properties property OnCommEvent : TNotifyEvent read fOnCommEvent write fOnCommEvent; property OnCommStat : TNotifyEvent read fOnCommStat write fOnCommStat; property OnTxQueueEmptyEvent : TNotifyEvent read fOnTxQueueEmptyEvent write fOnTxQueueEmptyEvent; property OnWriteDone : TNotifyEvent read fOnWriteDone write fOnWriteDone; property OnBreakEvent : TNotifyEvent read fOnBreakEvent write fOnBreakEvent; property OnCTSEvent : TNotifyEvent read fOnCTSEvent write fOnCTSEvent; property OnDSREvent : TNotifyEvent read fOnDSREvent write fOnDSREvent; property OnLineErrorEvent : TNotifyEvent read fOnLineErrorEvent write fOnLineErrorEvent; property OnRingEvent : TNotifyEvent read fOnRingEvent write fOnRingEvent; // RING, RING on falling edge of the RI Pin property OnRIEvent : TNotifyEvent read fOnRIEvent write fOnRIEvent; // on every change of the RI Pin property OnRLSDEvent : TNotifyEvent read fOnRLSDEvent write fOnRLSDEvent; property OnRxClusterEvent : TNotifyEvent read fOnRxClusterEvent write fOnRxClusterEvent; property OnRxCharEvent : TNotifyEvent read fOnRxCharEvent write fOnRxCharEvent; property OnRxEventCharEvent : TNotifyEvent read fOnRxEventCharEvent write fOnRxEventCharEvent; property OnProcessError : TNotifyErrorEvent read fOnProcessError write fOnProcessError; end; // The TWorkThread class deals with several CommEvents and controll the receiving // of Clusters and check the Sendprocess // Under normal cirumstances You don't have to deal with TWorkThread = class(TThread) private Owner : TSerialPortNG; Place, Code : DWord; Msg : String; Noise : Byte; Cluster : TSerialCluster; procedure ThreadSynchronize(Method: TThreadMethod); procedure SetProcessError(APlace, ACode : DWord; AMsg : String; ANoise : Byte); procedure ProcessError; procedure RxClusterEvent; procedure CommEvent; procedure CommStatEvent; procedure BreakEvent; procedure CTSEvent; procedure DSREvent; procedure LineErrorEvent; procedure RingEvent; procedure RIEvent; procedure RLSDEvent; procedure RxCharEvent; procedure RxEventCharEvent; procedure TxQueueEmptyEvent; procedure WriteDone; protected public constructor Create(AOwner : TSerialPortNG); procedure Execute; override; end; procedure Register; implementation uses Registry, CommPortList; var VersionInfo : TOSVersionInfo; procedure Register; begin RegisterComponents('Samples', [TSerialPortNG]); end; // // TSerialCluster Component // constructor TSerialCluster.Create(Data : Pointer; Size : Integer; CCError : DWord); begin inherited Create; ClusterData := Data; // Take the Pointer ClusterSize := Size; // Size of Data ClusterCCError := CCError; end; function TSerialCluster.GetCCError : DWord; begin GetCCError := ClusterCCError; end; function TSerialCluster.GetSize : Integer; begin GetSize := ClusterSize; end; procedure TSerialCluster.GetData(Dest : Pointer); begin if Dest <> Nil then Move(ClusterData^, Dest^, ClusterSize); end; function TSerialCluster.GetDataAsString : String; var S : String; begin SetLength(S,ClusterSize); Move(ClusterData^, S[1], ClusterSize); GetDataAsString := S; end; function TSerialCluster.GetDataAsPChar(Dest : PChar) : PChar; type TMaxSize = array[0..MaxLongInt-1] of Char; PMaxSize = ^TMaxSize; begin if Dest <> Nil then begin Move(ClusterData^, Dest^, ClusterSize); PMaxSize(Dest)^[ClusterSize] := #0; end; GetDataAsPChar := Dest; end; destructor TSerialCluster.Destroy; begin Dispose(ClusterData); inherited Destroy; end; // // TSerialPortNG Component definition // // // Serveral "Set..." procedure for the Property mapping procedure TSerialPortNG.SetCommPort(value : ShortString); begin if value <> fCommPort then begin fCommPort := value; PortWork(fActive); end; end; procedure TSerialPortNG.SetBaudRate(value : DWord); begin if value <> fBaudRate then begin fBaudRate := value; if fXTOAuto then XTODefault; // Adjust the CharDelay Timeouts if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetParityType(value : Byte); begin if value <> fParityType then begin fParityType := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetParityErrorChar(value : Char); begin if value <> fParityErrorChar then begin fParityErrorChar := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetParityErrorReplacement(value : Boolean); begin if value <> fParityErrorReplacement then begin fParityErrorReplacement := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetStopBits(value : Byte); begin if value <> fStopBits then begin fStopBits := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetDataBits(value : Byte); begin if value <> fDataBits then begin fDataBits := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetXONChar(value : Char); begin if value <> fXONChar then begin fXONChar := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetXOFFChar(value : Char); begin if value <> fXOFFChar then begin fXOFFChar := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetXONLimDiv(value : Byte); begin if value <> fXONLimDiv then begin if value > 100 then begin ProcessError(0100,value,'Warning XOnLimDef set to 100',enWarning); value := 100; end; fXONLimDiv := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetXOFFLimDiv(value : Byte); begin if value <> fXOFFLimDiv then begin if value > 100 then begin ProcessError(0100,value,'Warning XOffLimDef set to 100',enWarning); value := 100; end; fXOFFLimDiv := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetFlowControl(value : LongInt); begin if value <> fFlowControl then begin fFlowControl := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetStripNullChars(value : Boolean); begin if value <> fStripNullChars then begin fStripNullChars := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetEventChar(value : Char); begin if value <> fEventChar then begin fEventChar := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetRTOCharDelayTime(value : DWord); begin if value <> fRTOCharDelayTime then fRTOCharDelayTime := value; end; procedure TSerialPortNG.SetRTOExtraDelayTime(value : Word); begin if value <> fRTOExtraDelayTime then fRTOExtraDelayTime := value; end; procedure TSerialPortNG.SetWTOCharDelayTime(value : DWord); begin if value <> fWTOCharDelayTime then begin fWTOCharDelayTime := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetWTOExtraDelayTime(value : Word); begin if value <> fWTOExtraDelayTime then begin fWTOExtraDelayTime := value; if fActive then SetupDCB; end; end; procedure TSerialPortNG.SetXTOAuto(value : Boolean); begin if value <> fXTOAuto then begin fXTOAuto := value; if fXTOAuto then XTODefault; end; end; procedure TSerialPortNG.SetClusterSize(value : Word); begin fClusterSize := value; end; procedure TSerialPortNG.SetRxQueueSize(value : Word); begin if value <> fRxQueueSize then begin fRxQueueSize := value; if not SetupComm(hCommPort,fRxQueueSize,fTxQueueSize) then ProcessError(0101,GetLastError,'Error can not set Quesize',enError); end; end; procedure TSerialPortNG.SetTxQueueSize(value : Word); begin if value <> fTxQueueSize then begin fTxQueueSize := value; if not SetupComm(hCommPort,fRxQueueSize,fTxQueueSize) then ProcessError(0102,GetLastError,'Error can not set Quesize',enError); end; end; procedure TSerialPortNG.SetErrorNoise(value : Byte); begin fErrorNoise := value; end; procedure TSerialPortNG.SetReadRequest(value : Boolean); begin fReadRequest := value; end; procedure TSerialPortNG.SetActive(NewState : Boolean); begin // You may expect that this function set only the fActive Value // This is done by the PortWork procedure, depending from the successful // opened Port if NewState <> fActive then PortWork(NewState); end; // // Several Methods procedure TSerialPortNG.ProcessError(Place, Code : DWord; Msg : String; Noise : Byte); begin if ShutdownInProgress then Exit; // No Messages now the Component is in Destroystate if Noise <= fErrorNoise then if assigned(fOnProcessError) then fOnProcessError(Self,Place,Code,Msg,Noise); //Owner replaced by Self end; procedure TSerialPortNG.InitOverlapped(var Overlapped : TOverlapped); begin Overlapped.Offset := 0; Overlapped.OffsetHigh := 0; Overlapped.Internal := 0; Overlapped.InternalHigh := 0; Overlapped.hEvent := CreateEvent(nil,True,False,''); if Overlapped.hEvent = 0 then ProcessError(1001,GetLastError,'Error Creating Overlapped Event',enError) else if GetLastError = ERROR_ALREADY_EXISTS then ProcessError(1002,ERROR_ALREADY_EXISTS,'Error Overlapped Event Exists',enError) end; procedure TSerialPortNG.ResetOverlapped(var Overlapped : TOverlapped); begin if not ResetEvent(Overlapped.hEvent) then ProcessError(1101,GetLastError,'Error resetting Overlapped Event',enError); end; procedure TSerialPortNG.SetOverlapped(var Overlapped : TOverlapped); begin if not SetEvent(Overlapped.hEvent) then // EVENT_MODIFY_STATE ProcessError(1101,GetLastError,'Error resetting Overlapped Event',enError); end; // // Create method. constructor TSerialPortNG.Create(AOwner : TComponent); begin inherited Create(AOwner); InitializeCriticalSection(CriticalSection); ShutdownInProgress := False; hCommPort := INVALID_HANDLE_VALUE; Platform := CheckOS(VersionInfo); // Set initial settings. Even though // the default parameter was specified // in the property, if you were to // create a component at runtime, the // defaults would not get set. So it // is important to call them again in // the create of the component. fCommPort := dflt_CommPort; fBaudRate := dflt_BaudRate; fParityType := dflt_ParityType; fStopBits := dflt_StopBits; fDataBits := dflt_DataBits; fXONChar := dflt_XONChar; fXOFFChar := dflt_XOFFChar; fXONLimDiv := dflt_XONLimDiv; fXOFFLimDiv := dflt_XOFFLimDiv; fFlowControl := dflt_FlowControl; fRTOCharDelayTime := dflt_RTOCharDelayTime; fRTOExtraDelayTime := dflt_RTOExtraDelayTime; fWTOCharDelayTime := dflt_WTOCharDelayTime; fWTOExtraDelayTime := dflt_WTOExtraDelayTime; fXTOAuto := dflt_XTOAuto; fClusterSize := dflt_ClusterSize; fRxQueueSize := dflt_RxQueueSize; fTxQueueSize := dflt_TxQueueSize; fErrorNoise := enAll; fReadRequest := False; fRTSState := dflt_RTSState; fDTRState := dflt_DTRState; fBREAKState := dflt_BREAKState; fOnTxQueueEmptyEvent := Nil; fOnBreakEvent := Nil; fOnCTSEvent := Nil; fOnDSREvent := Nil; fOnLineErrorEvent := Nil; fOnRingEvent := Nil; fOnRLSDEvent := Nil; fOnRxCharEvent := Nil; fOnRxEventCharEvent := Nil; fOnRxClusterEvent := Nil; fOnProcessError := Nil; fThreadQuietMode := dflt_ThreadQuietMode; fAutoReadRequest := dflt_AutoReadRequest; LastErr := 0; RxDClusterList := TList.Create; // Create the List to store the received Clusters InitOverlapped(WriteOverlapped); InitOverlapped(ReadOverlapped); InitOverlapped(StatusOverlapped); WorkThread := TWorkThread.Create(Self); WorkThread.OnTerminate := WorkThreadDone; end; // Destroy method. destructor TSerialPortNG.Destroy; var i : Integer; begin ShutdownInProgress := True; PortWork(False); WorkThread.Terminate; WaitForThreadNotRunning(10); CloseHandle(WriteOverlapped.hEvent); CloseHandle(StatusOverlapped.hEvent); CloseHandle(ReadOverlapped.hEvent); for i := 0 to RxDClusterList.Count-1 do begin if RxDClusterList.Items[i] <> Nil then begin TSerialCluster(RxDClusterList.Items[i]).Free; RxDClusterList.Items[i] := Nil; end; end; RxDClusterList.Free; WorkThread.Free; DeleteCriticalSection(CriticalSection); inherited Destroy; end; // PortWork Closes or Opens the Port depending of the Parm // It sets the fActive Variable depending of result of Opening the Port procedure TSerialPortNG.PortWork(ReOpen : Boolean); var CommPortName : array [0..127] of Char; begin if fActive then // The Port is Open, Close first begin ProcessError(0100,0,'Msg start deactivating Port',enMsg); if not SetCommMask(hCommPort,0) then ProcessError(0101,GetLastError,'Error disabling CommEvents',enError); fActive := False; // The WorkThread check this Flag if not PurgeComm(hCommPort, PURGE_RXABORT or PURGE_RXCLEAR or PURGE_TXABORT or PURGE_TXCLEAR) then ProcessError(0102,GetLastError,'Error clearing Queues',enError); WaitForThreadNotRunning(15); if WorkThreadIsRunning then ProcessError(0104,0,'Warning ThreadIsRunning',enWarning); SetSignalDTR(False); SetSignalRTS(False); if not CloseHandle(hCommPort) then ProcessError(0103,GetLastError,'Error closing Port',enError); hCommPort := INVALID_HANDLE_VALUE; end; // The Port is Closed, the Thread is Idle if ReOpen then begin // Reopen the Port with (new) Parms ProcessError(0110,0,'Msg start reactivating Port',enMsg); hCommPort := CreateFile(StrPCopy(CommPortName,'\\.\'+Copy(fCommPort,1,79)), GENERIC_READ OR GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED,0); fActive := (hCommPort <> INVALID_HANDLE_VALUE); if fActive then begin if not SetupComm(hCommPort,fRxQueueSize,fTxQueueSize) then ProcessError(0111,GetLastError,'Error setup Queuesize',enError); SetupDCB; SetSignalDTR(dflt_DTRState); SetSignalRTS(dflt_RTSState); EnableEvents; end else ProcessError(0112,GetLastError,'Error reopening Port',enError); end; end; // Internal method to enable all Events procedure TSerialPortNG.EnableEvents; begin if not SetCommMask(hCommPort, EV_BREAK or EV_CTS or EV_DSR or EV_ERR or EV_RING or EV_RLSD or EV_RXCHAR or EV_RXFLAG or EV_TXEMPTY) then ProcessError(0201,GetLastError,'Error activating CommEventMask',enError); end; // Public method to cancel and flush the receive buffer. procedure TSerialPortNG.ClearRxDQueue; begin if fActive then if not PurgeComm(hCommPort, PURGE_RXABORT or PURGE_RXCLEAR) then ProcessError(0301,GetLastError,'Error clearing RxD Queue',enError); end; // Public method to cancel and flush the transmit buffer. procedure TSerialPortNG.ClearTxDQueue; begin if fActive then if not PurgeComm(hCommPort, PURGE_TXABORT or PURGE_TXCLEAR) then ProcessError(0401,GetLastError,'Error clearing TxD Queue',enError); end; // Public method to Play with the RTS Line // It is an Error to work on this Line while in the Flowmode bmfOutxCtsFlow is set! procedure TSerialPortNG.SetSignalRTS(State : Boolean); begin if fActive then begin if State then begin if not EscapeCommFunction(hCommPort,SETRTS) then ProcessError(0501,GetLastError,'Error setting RTS',enError) end else begin if not EscapeCommFunction(hCommPort,CLRRTS) then ProcessError(0502,GetLastError,'Error clearing RTS',enError) end; fRTSState := State; end; end; // Public method to Play with the DTR Line // It is an Error to work on this Line while in the Flowmode bmfOutxDtrFlow is set! procedure TSerialPortNG.SetSignalDTR(State : Boolean); begin if fActive then begin if State then begin if not EscapeCommFunction(hCommPort,SETDTR) then ProcessError(0601,GetLastError,'Error setting DTR',enError) end else begin if not EscapeCommFunction(hCommPort,CLRDTR) then ProcessError(0602,GetLastError,'Error clearing DTR',enError) end; fDTRState := State; end; end; // Public method to set the break State procedure TSerialPortNG.SetSignalBREAK(State : Boolean); begin if fActive then begin if State then begin if not SetCommBreak(hCommPort) then ProcessError(0701,GetLastError,'Error setting BREAK State',enError) end else begin if not ClearCommBreak(hCommPort) then ProcessError(0702,GetLastError,'Error clearing BREAK State',enError) end; fBREAKState := State; end; end; // Initialize the device control block. procedure TSerialPortNG.SetupDCB; var MyDCB : TDCB; MyCommTimeouts : TCommTimeouts; // SDCB : array[0..79] of Char; begin // The GetCommState function fills in a // device-control block (a DCB structure) // with the current control settings for // a specified communications device. // (Win32 Developers Reference) // Get a default fill of the DCB. if not GetCommState(hCommPort, MyDCB) then begin ProcessError(0801,GetLastError,'Error getting DCB from CommState',enError); Exit; end; MyDCB.BaudRate := fBaudRate; MyDCB.Flags := bmfBinary; //Must be set under Win32 if fParityType <> NOPARITY then // If a ParityType is selceted, set Paritybit automatic MyDCB.Flags := MyDCB.Flags or bmfParity; MyDCB.Parity := fParityType; if fParityErrorReplacement then MyDCB.Flags := MyDCB.Flags or bmfErrorChar; MyDCB.Flags := MyDCB.Flags or fFlowControl; if fStripNullChars then MyDCB.Flags := MyDCB.Flags or bmfNull; MyDCB.ErrorChar := fParityErrorChar; MyDCB.EvtChar := fEventChar; MyDCB.StopBits := fStopBits; MyDCB.ByteSize := fDataBits; MyDCB.XONChar := fXONChar; MyDCB.XOFFChar := fXOFFChar; MyDCB.XONLim := fRxQueueSize * fXONLimDiv div 100; // Send XOn if e.g fXONLimDiv = 33 -> 33% full MyDCB.XOFFLim := fRxQueueSize * fXOFFLimDiv div 100; // Send XOff if e.g fXOffLimDiv = 33 -> 100%-33%=67% Percent full MyDCB.EOFChar := #0; //Ignored under Win32 // The SetCommTimeouts function sets // the time-out parameters for all // read and write operations on a // specified communications device. // (Win32 Developers Reference) // The GetCommTimeouts function retrieves // the time-out parameters for all read // and write operations on a specified // communications device. GetCommTimeouts(hCommPort, MyCommTimeouts); //Read Timeouts are disabled here, because they realized manually in the WorkThread MycommTimeouts.ReadIntervalTimeout := MAXDWORD; MycommTimeouts.ReadTotalTimeoutMultiplier := 0; MycommTimeouts.ReadTotalTimeoutConstant := 0; //Write Timeouts disable here MycommTimeouts.WriteTotalTimeoutMultiplier := 0; MycommTimeouts.WriteTotalTimeoutConstant := 0; if not SetCommTimeouts(hCommPort, MyCommTimeouts) then ProcessError(0802,GetLastError,'Error setting CommTimeout',enError); if not SetCommState(hCommPort, MyDCB) then ProcessError(0802,GetLastError,'Error setting CommState, 87 indicate that Parms are incorrect',enError); end; // Public Send data method. procedure TSerialPortNG.SendData(Data : Pointer; Size : DWord); var MyCommTimeOuts : TCommTimeOuts; begin if fSendInProgress then begin ProcessError(0901,0,'Msg, dont enter SendData while SendInProgress is set',enMsg); Exit; end else begin GetCommTimeouts(hCommPort, MyCommTimeouts); //Read Timeouts are disabled MycommTimeouts.ReadIntervalTimeout := MAXDWORD; MycommTimeouts.ReadTotalTimeoutMultiplier := 0; MycommTimeouts.ReadTotalTimeoutConstant := 0; //Write Timeouts calculated from the settings MycommTimeouts.WriteTotalTimeoutMultiplier := 0; MycommTimeouts.WriteTotalTimeoutConstant := ((fWTOCharDelayTime*Size) div 1000) + fWTOExtraDelayTime; if not SetCommTimeouts(hCommPort, MyCommTimeouts) then ProcessError(0902,GetLastError,'Error setting CommTimeout',enError); BytesToWrite := Size; if not WriteFile(hCommPort, Data^, Size, fWrittenBytes, @WriteOverlapped) then begin LastErr := GetLastError; if LastErr <> ERROR_IO_PENDING then begin ProcessError(0903,LastErr,'Error writing Data',enError); ResetOverlapped(WriteOverlapped); fSendInProgress := False; end else begin WriteStartTime := GetTickCount; fSendInProgress := True; end; end else // Write was done immidiatly begin if Assigned(fOnWriteDone) then fOnWriteDone(Self); end; end; end; // Public SendString Method procedure TSerialPortNG.SendString(S : String); begin if Length(S) > 0 then SendData(@S[1], Length(S)); end; // Public NextClusterSize Method // Return the Number of Databytes // 0..MAXINT indicates that a Cluster is available, 0 = No Bytes, but an Error code // -1 not Cluster is available function TSerialPortNG.NextClusterSize : Integer; begin EnterCriticalSection(CriticalSection); try if RxDClusterList.Count > 0 then if RxDClusterList.Items[0] = Nil then RxDClusterList.Pack; if RxDClusterList.Count > 0 then NextClusterSize := TSerialCluster(RxDClusterList.Items[0]).GetSize else NextClusterSize := -1; finally LeaveCriticalSection(CriticalSection); end; end; // Public NextClusterCCError Method // Returns the ErrorCode of the Next Cluster // Returns MAXDWORD if no Cluster in List function TSerialPortNG.NextClusterCCError : DWord; begin EnterCriticalSection(CriticalSection); try if RxDClusterList.Count > 0 then if RxDClusterList.Items[0] = Nil then RxDClusterList.Pack; if RxDClusterList.Count > 0 then NextClusterCCError := TSerialCluster(RxDClusterList.Items[0]).GetCCError else NextClusterCCError := MAXDWORD; finally LeaveCriticalSection(CriticalSection); end; end; // Public Method to read and remove the next Cluster from the List // If no Cluster is avail the Method retuns NIL // Else, You have to deal with the Pointer, and Free him self function TSerialPortNG.ReadNextCluster(var ClusterSize : Integer; var CCError : DWord) : Pointer; var DataBuffer : Pointer; begin EnterCriticalSection(CriticalSection); try if RxDClusterList.Count > 0 then if RxDClusterList.Items[0] = Nil then RxDClusterList.Pack; if RxDClusterList.Count > 0 then begin CCError := TSerialCluster(RxDClusterList.Items[0]).GetCCError; ClusterSize := TSerialCluster(RxDClusterList.Items[0]).GetSize; GetMem(DataBuffer, ClusterSize); TSerialCluster(RxDClusterList.Items[0]).GetData(DataBuffer); TSerialCluster(RxDClusterList.Items[0]).Free; RxDClusterList.Delete(0); ReadNextCluster := DataBuffer; end else begin ClusterSize := -1; CCError := MAXDWORD; ReadNextCluster := Nil; end; finally LeaveCriticalSection(CriticalSection); end; end; // Public Method to read and remove the next Cluster from the List // The Cluster is moved into a String function TSerialPortNG.ReadNextClusterAsString : String; begin EnterCriticalSection(CriticalSection); try if RxDClusterList.Count > 0 then if RxDClusterList.Items[0] = Nil then RxDClusterList.Pack; if RxDClusterList.Count > 0 then begin ReadNextClusterAsString := TSerialCluster(RxDClusterList.Items[0]).GetDataAsString; TSerialCluster(RxDClusterList.Items[0]).Free; RxDClusterList.Delete(0); end else ReadNextClusterAsString := ''; finally LeaveCriticalSection(CriticalSection); end; end; // Public Method to read and remove the next Cluster from the List // The Cluster is moved into "Dest". "Dest" should Point to enough Space to avoid // Exception Errors function TSerialPortNG.ReadNextClusterAsPChar(Dest : PChar) : PChar; begin EnterCriticalSection(CriticalSection); try if Dest <> Nil then begin if RxDClusterList.Count > 0 then if RxDClusterList.Items[0] = Nil then RxDClusterList.Pack; if RxDClusterList.Count > 0 then begin ReadNextClusterAsPChar := TSerialCluster(RxDClusterList.Items[0]).GetDataAsPChar(Dest); TSerialCluster(RxDClusterList.Items[0]).Free; RxDClusterList.Delete(0); end else ReadNextClusterAsPChar := Nil; end else ReadNextClusterAsPChar := Nil; finally LeaveCriticalSection(CriticalSection); end; end; // Private Method procedure TSerialPortNG.WorkThreadDone(Sender: TObject); begin WorkThreadIsRunning := False; end; // Public Method to fit the TimeOut Values to the current Baudrate // If the Property XTOAuto is true this method will be called from the SetBaud method procedure TSerialPortNG.XTODefault; var i : Integer; NewXTO : DWord; begin NewXTO := 1100; for i := 0 to BaudRateCount-1 do begin if fBaudRate >= BaudRates[i] then NewXTO := XTOCharDelayDef[i]; end; SetRTOCharDelayTime(NewXTO); SetWTOCharDelayTime(NewXTO); end; // Saves all Setting into the Registry // e.g. WriteSettings('Software/DomIS','SerialNGAdvDemo') // will save to HKEY_CURRENT_USER\Software\DomIS\SerialAdvDemo procedure TSerialPortNG.WriteSettings(Regkey, RegSubKey : String); var FIniFile : TRegIniFile; begin FIniFile := TRegIniFile.Create(RegKey); try try with FIniFile do begin WriteString(RegSubKey, 'CommPort', fCommPort); WriteString(RegSubKey, 'BaudRate', IntToStr(fBaudRate)); WriteString(RegSubKey, 'ParityType', IntToStr(fParityType)); WriteString(RegSubKey, 'ParityErrorChar', fParityErrorChar); WriteBool (RegSubKey, 'ParityErrorReplacement', fParityErrorReplacement); WriteString(RegSubKey, 'StopBits', IntToStr(fStopBits)); WriteString(RegSubKey, 'DataBits', IntToStr(fDataBits)); WriteString(RegSubKey, 'XONChar', fXONChar); WriteString(RegSubKey, 'XOFFChar', fXOFFChar); WriteString(RegSubKey, 'XONLimDiv', IntToStr(fXONLimDiv)); WriteString(RegSubKey, 'XOFFLimDiv', IntToStr(fXOFFLimDiv)); WriteString(RegSubKey, 'FlowControl', IntToStr(fFlowControl)); WriteBool (RegSubKey, 'StripNullChars', fStripNullChars); WriteString(RegSubKey, 'EventChar', fEventChar); WriteString(RegSubKey, 'RTOCharDelayTime', IntToStr(fRTOCharDelayTime)); WriteString(RegSubKey, 'RTOExtraDelayTime', IntToStr(fRTOExtraDelayTime)); WriteString(RegSubKey, 'ClusterSize', IntToStr(fClusterSize)); WriteString(RegSubKey, 'RxQueueSize', IntToStr(fRxQueueSize)); WriteString(RegSubKey, 'TxQueueSize', IntToStr(fTxQueueSize)); WriteString(RegSubKey, 'WTOCharDelayTime', IntToStr(fWTOCharDelayTime)); WriteString(RegSubKey, 'WTOExtraDelayTime', IntToStr(fWTOExtraDelayTime)); WriteBool (RegSubKey, 'XTOAuto', fXTOAuto); WriteBool (RegSubKey, 'RTSState', fRTSState); WriteBool (RegSubKey, 'DTRState', fDTRState); WriteBool (RegSubKey, 'BREAKState', fBREAKState); WriteString(RegSubKey, 'ErrorNoise', IntToStr(fErrorNoise)); WriteBool (RegSubKey, 'Active', FActive); ProcessError(0501,0,'Settings saved',enMsg); end; except ProcessError(0502,0,'Error saving Settings',enError); end; finally FIniFile.Free; end; end; // Read all Settings from the Registry // e.g. ReadSettings('Software/DomIS','SerialNGAdvDemo') // will read from HKEY_CURRENT_USER\Software\DomIS\SerialAdvDemo procedure TSerialPortNG.ReadSettings(Regkey, RegSubKey : String); var FIniFile : TRegIniFile; Activate : Boolean; function CharFromStr(S : String):Char; begin if Length(S) > 0 then CharFromStr := S[1] else CharFromStr := #0; end; begin FIniFile := TRegIniFile.Create(RegKey); try try with FIniFile do begin Activate := ReadBool(RegSubKey, 'Active', False); //Read the Active Flag into a save place if Activate then // The Port should be activated // if the Port is the same as opened, the port stays open CommPort := ReadString(RegSubKey, 'CommPort', dflt_CommPort) else begin // The Port should be deactivated Active := False; // Deactivate fCommPort := ReadString(RegSubKey, 'CommPort', dflt_CommPort) //Store new name end; fBaudRate := StrToIntDef(ReadString(RegSubKey, 'BaudRate', ''),dflt_BaudRate); fParityType := StrToIntDef(ReadString(RegSubKey, 'ParityType', ''), dflt_ParityType); ParityErrorChar := CharFromStr(ReadString(RegSubKey, 'ParityErrorChar', dflt_ParityErrorChar)); fParityErrorReplacement := ReadBool(RegSubKey, 'ParityErrorReplacement', dflt_ParityErrorReplacement); fStopBits := StrToIntDef(ReadString(RegSubKey, 'StopBits', ''), dflt_StopBits); fDataBits := StrToIntDef(ReadString(RegSubKey, 'DataBits', ''), dflt_DataBits); fXONChar := CharFromStr(ReadString(RegSubKey, 'XONChar', dflt_XONChar)); fXOFFChar := CharFromStr(ReadString(RegSubKey, 'XOFFChar', dflt_XOFFChar)); fXONLimDiv := StrToIntDef(ReadString(RegSubKey, 'XONLimDiv',''), dflt_XONLimDiv); fXOFFLimDiv := StrToIntDef(ReadString(RegSubKey, 'XOFFLimDiv',''), dflt_XOFFLimDiv); fFlowControl := StrToIntDef(ReadString(RegSubKey, 'FlowControl',''), dflt_FlowControl); fStripNullChars := ReadBool(RegSubKey, 'StripNullChars', dflt_StripNullChars); fEventChar := CharFromStr(ReadString(RegSubKey, 'EventChar', dflt_EventChar)); fRTOCharDelayTime := StrToIntDef(ReadString(RegSubKey, 'RTOCharDelayTime',''), dflt_RTOCharDelayTime); fRTOExtraDelayTime := StrToIntDef(ReadString(RegSubKey, 'RTOExtraDelayTime',''), dflt_RTOExtraDelayTime); fClusterSize := StrToIntDef(ReadString(RegSubKey, 'ClusterSize',''), dflt_ClusterSize); fRxQueueSize := StrToIntDef(ReadString(RegSubKey, 'RxQueueSize',''), dflt_RxQueueSize); fTxQueueSize := StrToIntDef(ReadString(RegSubKey, 'TxQueueSize',''), dflt_TxQueueSize); fWTOCharDelayTime := StrToIntDef(ReadString(RegSubKey, 'WTOCharDelayTime',''), dflt_WTOCharDelayTime); fWTOExtraDelayTime := StrToIntDef(ReadString(RegSubKey, 'WTOExtraDelayTime',''), dflt_WTOExtraDelayTime); fXTOAuto := ReadBool(RegSubKey, 'XTOAuto', dflt_XTOAuto); fRTSState := ReadBool(RegSubKey, 'RTSState', dflt_RTSState); fDTRState := ReadBool(RegSubKey, 'DTRState', dflt_DTRState); fBREAKState := ReadBool (RegSubKey, 'BREAKState', dflt_BREAKState); fErrorNoise := StrToIntDef(ReadString(RegSubKey, 'ErrorNoise',''), dflt_ErrorNoise); Active := Activate; //After all force the new settings ProcessError(0401,0,'Settings readed',enMsg); end; except ProcessError(0402,0,'Error reading Settings',enError); end; finally FIniFile.Free; end; end; procedure TSerialPortNG.WaitForThreadNotRunning(Counter : Integer); begin while (Counter > 0) and (WorkThreadIsRunning) do begin Sleep(75); Dec(Counter); end; end; // // WorkThread Definitions // The Workthread manage all the Work in the Background // - Checks wether the writing is done // - Checks if Data are received // - Checks the Status // - Calls the Events // Saves the process error Variables procedure TWorkThread.SetProcessError(APlace, ACode : DWord; AMsg : String; ANoise : Byte); begin Place := APlace; Code := ACode; Msg := AMsg; Noise := ANoise; end; // Calls the ProcessError Eventhandler procedure TWorkThread.ProcessError; begin Owner.ProcessError(Place,Code,Msg,Noise); end; // Create the Thread constructor TWorkThread.Create(AOwner : TSerialPortNG); begin Owner := AOwner; inherited Create(False); end; // Events... procedure TWorkThread.RxClusterEvent; begin if assigned(Owner.fOnRxClusterEvent) then Owner.fOnRxClusterEvent(Owner); end; procedure TWorkThread.CommEvent; begin Owner.fOnCommEvent(Owner); end; procedure TWorkThread.CommStatEvent; begin Owner.fOnCommStat(Owner); end; procedure TWorkThread.BreakEvent; begin Owner.fOnBreakEvent(Owner); end; procedure TWorkThread.CTSEvent; begin Owner.fOnCTSEvent(Owner); end; procedure TWorkThread.DSREvent; begin Owner.fOnDSREvent(Owner); end; procedure TWorkThread.LineErrorEvent; begin Owner.fOnLineErrorEvent(Owner); end; procedure TWorkThread.RingEvent; begin Owner.fOnRingEvent(Owner); end; procedure TWorkThread.RIEvent; begin Owner.fOnRIEvent(Owner); end; procedure TWorkThread.RLSDEvent; begin Owner.fOnRLSDEvent(Owner); end; procedure TWorkThread.RxCharEvent; begin Owner.fOnRxCharEvent(Owner); end; procedure TWorkThread.RxEventCharEvent; begin Owner.fOnRxEventCharEvent(Owner); end; procedure TWorkThread.TxQueueEmptyEvent; begin Owner.fOnTxQueueEmptyEvent(Owner); end; procedure TWorkThread.WriteDone; begin if Assigned(Owner.fOnWriteDone) then Owner.fOnWriteDone(Owner); end; procedure TWorkThread.ThreadSynchronize(Method: TThreadMethod); begin if not Owner.fThreadQuietMode then Synchronize(Method); end; // // Workthread Maincycle procedure TWorkThread.Execute; var WrittenBytes : DWORD; BytesRead : DWORD; CommStatus : TComStat; CommErrorCode : DWORD; CommEventFlags : DWORD; ModemState : DWORD; RetCode : DWord; StartTime, TickTime : DWord; ClusterData : Pointer; Buffer : Pointer; BufferSize : DWord; WaitForReadEvent : Boolean; WaitForCommEvent : Boolean; HandleEvent : array[0..1] of DWord; ActiveMode, TerminateMode : Boolean; // The local Procedure evaluates the Events generated by the CommPort // and calles the Events of the Mainprogram procedure DoCommEvent; begin if Owner.ShutdownInProgress then Exit; Owner.fCommEvent := CommEventFlags; if (CommEventFlags and EV_BREAK) <> 0 then if assigned(Owner.fOnBreakEvent) then ThreadSynchronize(BreakEvent); if (CommEventFlags and EV_CTS) <> 0 then begin if assigned(Owner.fOnCTSEvent) then ThreadSynchronize(CTSEvent); end; if (CommEventFlags and EV_DSR) <> 0 then begin if assigned(Owner.fOnDSREvent) then ThreadSynchronize(DSREvent); end; if (CommEventFlags and EV_ERR) <> 0 then begin if assigned(Owner.fOnLineErrorEvent) then ThreadSynchronize(LineErrorEvent); end; if (CommEventFlags and EV_RING) <> 0 then begin if assigned(Owner.fOnRingEvent) then ThreadSynchronize(RingEvent); end; if (CommEventFlags and EV_RLSD) <> 0 then begin if assigned(Owner.fOnRLSDEvent) then ThreadSynchronize(RLSDEvent); end; if (CommEventFlags and EV_RXCHAR) <> 0 then begin if assigned(Owner.fOnRxCharEvent) then ThreadSynchronize(RxCharEvent); end; if (CommEventFlags and EV_RXFLAG) <> 0 then begin if assigned(Owner.fOnRxEventCharEvent) then ThreadSynchronize(RxEventCharEvent); end; if (CommEventFlags and EV_TXEMPTY) <> 0 then begin if assigned(Owner.fOnTxQueueEmptyEvent) then ThreadSynchronize(TxQueueEmptyEvent); end; if CommEventFlags <> 0 then if assigned(Owner.fOnCommEvent) then ThreadSynchronize(CommEvent); end; // Fetch the ModemStatus and CommErrorCode and CommStatus and generate // a CommStatEvent if something changed procedure GetStatus; var ExecDoCommEvent : Boolean; ExecRIEvent : Boolean; ClrCommErrDone : Boolean; begin ExecDoCommEvent := False; ExecRIEvent := False; if GetCommModemStatus(Owner.hCommPort,ModemState) then begin // There is a Bug in Win9x on signalizing the RING Event // We catch this manually here // The RingEvent is singnalize only on the falling edge of the RI! if Owner.Platform = VER_PLATFORM_WIN32_WINDOWS then begin if ((ModemState and MS_RING_ON) = 0) and ((Owner.fModemState and MS_RING_ON) <> 0) then // The RingIndicator Line has changed and is now False // generate Event begin CommEventFlags := EV_RING; Owner.fRingState := (ModemState and MS_RING_ON) <> 0; ExecDoCommEvent := True; end; end; if ((ModemState xor Owner.fModemState) and MS_RING_ON) <> 0 then ExecRIEvent := True; Owner.fModemState := ModemState; // Krystian from Poland suggest to add these 3 lines and got correct states // even if no Event is assigned. Owner.fCTSState := (ModemState and MS_CTS_ON) <> 0; Owner.fDSRState := (ModemState and MS_DSR_ON) <> 0; Owner.fRLSDState := (ModemState and MS_RLSD_ON) <> 0; Owner.fRingState := (ModemState and MS_RING_ON) <> 0; if ExecRIEvent and assigned(Owner.fOnRIEvent) then ThreadSynchronize(RIEvent); if ExecDoCommEvent then DoCommEvent; end else begin SetProcessError(9905,GetLastError,'Error getting ModemStatus',enError); ThreadSynchronize(ProcessError); end; ClrCommErrDone := False; repeat if ClearCommError(owner.hCommPort, CommErrorCode, @CommStatus) then begin if (Owner.fCommError <> CommErrorCode) or (Owner.fCommStateFlags <> CommStatus.Flags) or (Owner.fCommStateInQueue <> CommStatus.cbInQue) or (Owner.fCommStateOutQueue <> CommStatus.cbOutQue) then begin Owner.fCommError := CommErrorCode; Owner.fCommStateFlags := CommStatus.Flags; Owner.fCommStateInQueue := CommStatus.cbInQue; Owner.fCommStateOutQueue := CommStatus.cbOutQue; if Assigned(Owner.fOnCommStat) then ThreadSynchronize(CommStatEvent); end else ClrCommErrDone := True; end else begin SetProcessError(9803,GetLastError,'Error ClearCommError',enError); ThreadSynchronize(ProcessError); ClrCommErrDone := True; end until ClrCommErrDone; end; // This local procedure checks if the Writing is done procedure CheckWriter; begin if Owner.fSendInProgress then begin if GetOverlappedResult(Owner.hCommPort,Owner.WriteOverlapped,WrittenBytes, FALSE) then begin Owner.fWrittenBytes := WrittenBytes; Owner.fSendInProgress := False; if WrittenBytes <> Owner.BytesToWrite then begin SetProcessError(9701,RetCode,'Error write TimeOut',enError); ThreadSynchronize(ProcessError); end; ThreadSynchronize(WriteDone); end else begin RetCode := GetLastError; case RetCode of ERROR_IO_INCOMPLETE :; ERROR_IO_PENDING : begin TickTime := GetTickCount; if ((WrittenBytes*Owner.fWTOCharDelayTime)/1000+Owner.fWTOExtraDelayTime) < (Owner.WriteStartTime - TickTime) then begin Owner.fWrittenBytes := WrittenBytes; Owner.fSendInProgress := False; Owner.ResetOverlapped(Owner.WriteOverlapped); SetProcessError(9701,RetCode,'Error write TimeOut',enError); ThreadSynchronize(ProcessError); ThreadSynchronize(WriteDone); end; end; else // Its an Error!!! Owner.fSendInProgress := False; Owner.ResetOverlapped(Owner.WriteOverlapped); SetProcessError(9702,RetCode,'Error getting Overlapped Result',enError); ThreadSynchronize(ProcessError); ThreadSynchronize(WriteDone); end; end; end; end; //This procedure stores the received Cluster into the List procedure DoRxClusterStore; begin if not Owner.ShutdownInProgress then begin if BytesRead > 0 then begin GetMem(ClusterData,BytesRead); Move(Buffer^,ClusterData^,BytesRead); Cluster := TSerialCluster.Create(ClusterData,BytesRead,CommErrorCode); end else Cluster := TSerialCluster.Create(Nil,0,CommErrorCode); // The Storing of the Cluster into the Queue is done a CriticalSection EnterCriticalSection(Owner.CriticalSection); try Owner.RxDClusterList.Add(Cluster); finally //End of safe block LeaveCriticalSection(Owner.CriticalSection); end; ThreadSynchronize(RxClusterEvent); end; end; //Checks if Data is wainting in the RxDQueue and reads if Conditions are met //is called only if no Overlapp is running procedure ReadNoWait; begin if CommStatus.cbInQue = 0 then // No Char received StartTime := GetTickCount // Remember this Time as a Startpoint else // at least one Char was received begin // A Cluster is completed if one of the followoing conditions fit // - Owner request reading now // - cbInQue is greater than ClusterSize // - (cbInQue * fRTOCharDelayTime)/1000 + fRTOExtraDelayTime is greater than the elapsed Time // - a (Line-) Error occoured TickTime := GetTickCount; if (Owner.fReadRequest) or (CommStatus.cbInQue >= Owner.ClusterSize) or (((CommStatus.cbInQue * Owner.fRTOCharDelayTime)/1000 + Owner.fRTOExtraDelayTime) < (TickTime - StartTime)) or ((CommErrorCode and (CE_RXOVER or CE_OVERRUN or CE_RXPARITY or CE_FRAME or CE_BREAK)) <> 0) then begin BufferSize := CommStatus.cbInQue; GetMem(Buffer,BufferSize); if ReadFile(owner.hCommPort, PChar(Buffer)^, BufferSize, BytesRead, @Owner.ReadOverlapped) then begin //We have received something Owner.fReadRequest := False; // Reset the Requestflag DoRxClusterStore; // Store Data and fire Event... FreeMem(Buffer,BufferSize); // Free Buffer Buffer := Nil; StartTime := GetTickCount // Remember this Time as a Startpoint end else // ReadFile was not successful, this may caused by the Overlapped function begin RetCode := GetLastError; if RetCode = ERROR_IO_PENDING then // Yes, Reading is in Progress WaitForReadEvent := True else begin // Error while reading Owner.fReadRequest := False; FreeMem(Buffer,BufferSize); Buffer := Nil; SetProcessError(9804,RetCode,'Error reading Data',enError); ThreadSynchronize(ProcessError); end; end; end; end; end; // Checks for new events //is called only if no Overlapp is running procedure CommEventNoWait; begin CommEventFlags := 0; if WaitCommEvent(Owner.hCommPort,CommEventFlags,@Owner.StatusOverlapped) then begin GetStatus; // Update Statusflags 25.3.2003 DoCommEvent; // Event Occours, fire Events end else begin RetCode := GetLastError; if RetCode = ERROR_IO_PENDING then WaitForCommEvent := True //Check the Overlapped.hEvent else begin SetProcessError(9907,RetCode,'Error calling WaitCommEvent',enError); ThreadSynchronize(ProcessError); end; end; end; // Checks for received Data while an Overlapp is running procedure ProcessWaitForRead; begin if not GetOverlappedResult(Owner.hCommPort,Owner.ReadOverlapped,BytesRead, False) then begin RetCode := GetLastError; if RetCode = ERROR_OPERATION_ABORTED then SetProcessError(9907,RetCode,'Error read aborted',enError) else SetProcessError(9908,RetCode,'Error getting Overlappedresult',enError); ThreadSynchronize(ProcessError); end else // Successfull Overlapped read begin DoRxClusterStore; // Store Data and fire Event... FreeMem(Buffer,BufferSize); // Free Buffer Buffer := Nil; StartTime := GetTickCount // Remember this Time as a Startpoint end; WaitForReadEvent := False; end; // Checks for new Events while an Overlapp is running procedure ProcessWaitForComm; begin if (Owner.fActive) then begin GetStatus; DoCommEvent; end; WaitForCommEvent := False; end; // Main Cycle of the Thread begin StartTime := GetTickCount; WaitForCommEvent := False; WaitForReadEvent := False; ActiveMode := Owner.fActive; TerminateMode := Terminated; while not TerminateMode do begin if ActiveMode then begin Owner.WorkThreadIsRunning := True; if (Owner.fActive) then GetStatus; // Picup several Information about the actual State of Com CheckWriter; // Checks for pending Writeprocess if (not WaitForReadEvent) and (Owner.fActive) then // Start new Action only if not deactivating ReadNoWait; // Reads if avail, no waiting here if not WaitForCommEvent and (Owner.fActive) then // Start new Action only if not deactivating CommEventNoWait; // Check for Events, no waiting here // WaitForMultiple Events if (WaitForReadEvent and WaitForCommEvent) then begin HandleEvent[0] := Owner.ReadOverlapped.hEvent; HandleEvent[1] := Owner.StatusOverlapped.hEvent; RetCode := WaitForMultipleObjects(2,@HandleEvent,False,75); if (Owner.fActive) then GetStatus; // Picup several Information about the actual State of Com case RetCode of WAIT_OBJECT_0 : begin ProcessWaitForRead; end; WAIT_OBJECT_0 + 1 : begin ProcessWaitForComm; end; WAIT_TIMEOUT : begin end; else SetProcessError(9911,RetCode,'Error getting Overlappedresult',enError); ThreadSynchronize(ProcessError); WaitForReadEvent := False; WaitForCommEvent := False; end; end else if WaitForReadEvent then begin RetCode := WaitForSingleObject(Owner.ReadOverlapped.hEvent,75); if (Owner.fActive) then GetStatus; // Picup several Information about the actual State of Com case RetCode of WAIT_OBJECT_0 : begin if (Owner.fActive) then ProcessWaitForRead; end; WAIT_TIMEOUT : begin end; else SetProcessError(9912,RetCode,'Error getting Overlappedresult',enError); ThreadSynchronize(ProcessError); WaitForReadEvent := False; end; end else if WaitForCommEvent then// WaitForCommEvent begin RetCode := WaitForSingleObject(Owner.StatusOverlapped.hEvent,75); if (Owner.fActive) then GetStatus; // Picup several Information about the actual State of Com case RetCode of WAIT_OBJECT_0 : begin ProcessWaitForComm; end; WAIT_TIMEOUT : begin end; else SetProcessError(9913,RetCode,'Error getting Overlappedresult',enError); ThreadSynchronize(ProcessError); WaitForCommEvent := False; end; end; if not Owner.fActive then // The owner wants to deactivate the port begin if WaitForReadEvent then Owner.SetOverlapped(Owner.ReadOverlapped); if WaitForCommEvent then begin SetCommMask(Owner.hCommPort,0); Owner.SetOverlapped(Owner.StatusOverlapped); end; if (not WaitForCommEvent) and (not WaitForReadEvent) and (not Owner.fSendInProgress) then ActiveMode := False; // We do so if everything pending is finished end; end else // not ActiveMode begin Owner.WorkThreadIsRunning := False; ActiveMode := Owner.fActive; Sleep(200); //prevent consuming 100% of cpu-time in inactive mode end; if Terminated and (not ActiveMode) then //No termination before deactivation TerminateMode := True; end; // while not Terminated Owner.WorkThreadIsTerminated := True; end; end.
object Form1: TForm1 Left = 226 Top = 214 BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = #1051#1086#1075#1080#1095#1077#1089#1082#1080#1081' '#1072#1085#1072#1083#1080#1079#1072#1090#1086#1088 ClientHeight = 473 ClientWidth = 607 Color = clBlack Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnClose = FormClose OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object SpeedButton1: TSpeedButton Left = 536 Top = 352 Width = 65 Height = 41 OnClick = SpeedButton1Click end object SpeedButton2: TSpeedButton Left = 432 Top = 352 Width = 65 Height = 41 OnClick = SpeedButton2Click end object Label1: TLabel Left = 8 Top = 400 Width = 117 Height = 14 Caption = #1043#1083#1091#1073#1080#1085#1072' '#1087#1088#1077#1076#1087#1091#1089#1082#1086#1074#1086#1081 Color = clBlack Font.Charset = DEFAULT_CHARSET Font.Color = clWindow Font.Height = -11 Font.Name = 'Arial' Font.Style = [] ParentColor = False ParentFont = False end object Label2: TLabel Left = 8 Top = 416 Width = 67 Height = 14 Caption = #1088#1077#1075#1080#1089#1090#1088#1072#1094#1080#1080':' Font.Charset = DEFAULT_CHARSET Font.Color = clWindow Font.Height = -11 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Label3: TLabel Left = 328 Top = 384 Width = 22 Height = 22 Caption = 'Hz' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Label4: TLabel Left = 200 Top = 408 Width = 181 Height = 18 Caption = #1058#1072#1081#1084#1072#1091#1090' '#1086#1078#1080#1076#1072#1085#1080#1103' '#1087#1091#1089#1082#1072':' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Label5: TLabel Left = 256 Top = 432 Width = 63 Height = 22 Caption = #1062#1080#1082#1083#1086#1074 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Chart1: TChart Left = 95 Top = 12 Width = 514 Height = 301 AllowPanning = pmHorizontal AllowZoom = False BackWall.Brush.Color = clBlack BackWall.Color = clBlack BackWall.Pen.Color = clWhite Title.Brush.Color = clWhite Title.Color = clWhite Title.Frame.Color = clWhite Title.Text.Strings = ( 'TChart') Title.Visible = False BackColor = clBlack BottomAxis.Automatic = False BottomAxis.AutomaticMaximum = False BottomAxis.AutomaticMinimum = False BottomAxis.Axis.Color = clWhite BottomAxis.Grid.Color = clWhite BottomAxis.LabelsFont.Charset = DEFAULT_CHARSET BottomAxis.LabelsFont.Color = clWhite BottomAxis.LabelsFont.Height = -11 BottomAxis.LabelsFont.Name = 'Arial' BottomAxis.LabelsFont.Style = [] BottomAxis.Maximum = 16.000000000000000000 BottomAxis.MinorGrid.Color = clWhite BottomAxis.MinorTicks.Color = clWhite BottomAxis.Ticks.Color = clWhite BottomAxis.TicksInner.Color = clWhite DepthAxis.Automatic = False DepthAxis.AutomaticMaximum = False DepthAxis.AutomaticMinimum = False DepthAxis.Axis.Color = clWhite DepthAxis.Grid.Color = clWhite DepthAxis.LabelsFont.Charset = DEFAULT_CHARSET DepthAxis.LabelsFont.Color = clWhite DepthAxis.LabelsFont.Height = -11 DepthAxis.LabelsFont.Name = 'Arial' DepthAxis.LabelsFont.Style = [] DepthAxis.Maximum = 500.000000000000000000 DepthAxis.Minimum = 16.000000000000000000 DepthAxis.MinorGrid.Color = clWhite DepthAxis.MinorTicks.Color = clWhite DepthAxis.Ticks.Color = clWhite DepthAxis.TicksInner.Color = clWhite DepthAxis.Title.Font.Charset = DEFAULT_CHARSET DepthAxis.Title.Font.Color = clWhite DepthAxis.Title.Font.Height = -11 DepthAxis.Title.Font.Name = 'Arial' DepthAxis.Title.Font.Style = [] Frame.Color = clWhite LeftAxis.Automatic = False LeftAxis.AutomaticMaximum = False LeftAxis.AutomaticMinimum = False LeftAxis.Axis.Color = clWhite LeftAxis.Grid.Color = clWhite LeftAxis.Inverted = True LeftAxis.Maximum = 8.000000000000000000 LeftAxis.MinorGrid.Color = clWhite LeftAxis.MinorTicks.Color = clWhite LeftAxis.Ticks.Color = clWhite LeftAxis.TicksInner.Color = clSilver Legend.Font.Charset = DEFAULT_CHARSET Legend.Font.Color = clWhite Legend.Font.Height = -11 Legend.Font.Name = 'Arial' Legend.Font.Style = [] Legend.Frame.Color = clWhite Legend.Visible = False RightAxis.Axis.Color = clSilver ScaleLastPage = False TopAxis.Automatic = False TopAxis.AutomaticMaximum = False TopAxis.AutomaticMinimum = False TopAxis.Axis.Color = clSilver TopAxis.Grid.Color = clSilver TopAxis.LabelsFont.Charset = DEFAULT_CHARSET TopAxis.LabelsFont.Color = clWhite TopAxis.LabelsFont.Height = -11 TopAxis.LabelsFont.Name = 'Arial' TopAxis.LabelsFont.Style = [] TopAxis.Maximum = 16.000000000000000000 TopAxis.Minimum = 16.000000000000000000 View3D = False BevelOuter = bvNone Color = clBlack TabOrder = 0 object Series1: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clRed Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series2: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clGreen Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series3: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clYellow Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series4: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clBlue Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series5: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clWhite Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series6: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clGray Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series7: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clFuchsia Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end object Series8: TLineSeries Marks.ArrowLength = 8 Marks.Visible = False SeriesColor = clTeal Dark3D = False Pointer.InflateMargins = True Pointer.Style = psRectangle Pointer.Visible = False Stairs = True XValues.DateTime = False XValues.Name = 'X' XValues.Multiplier = 1.000000000000000000 XValues.Order = loAscending YValues.DateTime = False YValues.Name = 'Y' YValues.Multiplier = 1.000000000000000000 YValues.Order = loNone end end object ColorBox1: TColorBox Left = 88 Top = 32 Width = 38 Height = 22 Selected = clGreen Color = clBlack ItemHeight = 16 TabOrder = 1 end object ColorBox2: TColorBox Left = 88 Top = 64 Width = 38 Height = 22 Selected = clGradientActiveCaption Color = clBlack ItemHeight = 16 TabOrder = 2 end object ColorBox3: TColorBox Left = 88 Top = 96 Width = 38 Height = 22 Selected = clRed Color = clBlack ItemHeight = 16 TabOrder = 3 end object ColorBox4: TColorBox Left = 88 Top = 128 Width = 38 Height = 22 Selected = clLime Color = clBlack ItemHeight = 16 TabOrder = 4 end object ColorBox5: TColorBox Left = 88 Top = 160 Width = 38 Height = 22 Selected = clYellow Color = clBlack ItemHeight = 16 TabOrder = 5 end object ColorBox6: TColorBox Left = 88 Top = 192 Width = 38 Height = 22 Selected = clBlue Color = clBlack ItemHeight = 16 TabOrder = 6 end object ColorBox7: TColorBox Left = 88 Top = 223 Width = 38 Height = 22 Selected = clFuchsia Color = clBlack ItemHeight = 16 TabOrder = 7 end object ColorBox8: TColorBox Left = 88 Top = 255 Width = 38 Height = 22 Selected = clAqua Color = clBlack ItemHeight = 16 TabOrder = 8 end object ScrollBar1: TScrollBar Left = 120 Top = 300 Width = 481 Height = 17 Max = 484 PageSize = 0 TabOrder = 9 OnChange = ScrollChange end object StaticText1: TStaticText Left = 8 Top = 32 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 1' Color = clBlack Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentColor = False ParentFont = False TabOrder = 10 end object StaticText2: TStaticText Left = 8 Top = 64 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 2' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 11 end object StaticText3: TStaticText Left = 8 Top = 96 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 3' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 12 end object StaticText4: TStaticText Left = 8 Top = 128 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 4' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 13 end object StaticText5: TStaticText Left = 8 Top = 160 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 5' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 14 end object StaticText6: TStaticText Left = 8 Top = 192 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 6' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 15 end object StaticText7: TStaticText Left = 8 Top = 225 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 7' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 16 end object StaticText8: TStaticText Left = 8 Top = 253 Width = 72 Height = 28 Caption = #1050#1072#1085#1072#1083' 8' Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 17 end object StaticText9: TStaticText Left = 432 Top = 328 Width = 172 Height = 28 Caption = #1052#1072#1089#1096#1090#1072#1073#1080#1088#1086#1074#1072#1085#1080#1077 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 18 end object GroupBox1: TGroupBox Left = 8 Top = 320 Width = 145 Height = 73 Caption = #1047#1072#1087#1091#1089#1082 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 19 object RadioButton1: TRadioButton Left = 8 Top = 24 Width = 134 Height = 17 Caption = #1055#1086' '#1087#1077#1088#1077#1076#1085#1077#1084#1091' '#1092#1088#1086#1085#1090#1091 Checked = True Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 0 TabStop = True end object RadioButton2: TRadioButton Left = 8 Top = 48 Width = 129 Height = 17 Caption = #1055#1086' '#1079#1072#1076#1085#1077#1084#1091' '#1092#1088#1086#1085#1090#1091 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 1 end object RadioButton3: TRadioButton Left = 8 Top = 72 Width = 113 Height = 17 Caption = #1055#1086' '#1096#1072#1073#1083#1086#1085#1091 Enabled = False Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 2 Visible = False end end object ComboBox1: TComboBox Left = 200 Top = 336 Width = 185 Height = 21 ItemHeight = 13 TabOrder = 20 Text = #1042#1099#1073#1086#1088' '#1087#1091#1089#1082#1086#1074#1086#1075#1086' '#1082#1072#1085#1072#1083#1072 Items.Strings = ( #1050#1072#1085#1072#1083' 1' #1050#1072#1085#1072#1083' 2' #1050#1072#1085#1072#1083' 3' #1050#1072#1085#1072#1083' 4' #1050#1072#1085#1072#1083' 5' #1050#1072#1085#1072#1083' 6' #1050#1072#1085#1072#1083' 7' #1050#1072#1085#1072#1083' 8' #1053#1077#1090) end object ComboBox2: TComboBox Left = 200 Top = 360 Width = 185 Height = 21 ItemHeight = 13 TabOrder = 21 Text = #1042#1099#1073#1086#1088' '#1090#1072#1082#1090#1086#1074#1086#1075#1086' '#1075#1077#1085#1077#1088#1072#1090#1086#1088#1072 OnChange = ComboBox2Change Items.Strings = ( '(clk/6) 1 228 800 Hz' '(clk/8) 921 600 Hz' '(clk/16) 460 800 Hz' '(clk/32) 230 400 Hz' '(clk/64) 115 200 Hz' '(clk/128) 57 600 Hz' '(clk/256) 28 800 Hz' #1055#1088#1086#1080#1079#1074#1086#1083#1100#1085#1099#1081) end object BitBtn1: TBitBtn Left = 432 Top = 408 Width = 169 Height = 41 Caption = #1047#1072#1087#1091#1089#1082 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -19 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 22 OnClick = BitBtn1Click end object TrackBar1: TTrackBar Left = 0 Top = 432 Width = 113 Height = 45 Max = 100 SelStart = 100 TabOrder = 23 OnChange = TrackBar1Change end object Edit1: TEdit Left = 120 Top = 432 Width = 33 Height = 24 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Courier New' Font.Style = [] ParentFont = False ReadOnly = True TabOrder = 24 Text = '0' end object MaskEdit1: TMaskEdit Left = 200 Top = 384 Width = 119 Height = 22 EditMask = '!99999;1; ' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Courier New' Font.Style = [] MaxLength = 5 ParentFont = False TabOrder = 25 Text = ' 0' end object MaskEdit2: TMaskEdit Left = 200 Top = 432 Width = 47 Height = 24 EditMask = '!99999;1; ' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Courier New' Font.Style = [] MaxLength = 5 ParentFont = False TabOrder = 26 Text = '65535' OnChange = MaskEdit2Change end object SerialPortNG1: TSerialPortNG CommPort = 'COM1' BaudRate = 19200 RTOCharDelayTime = 570 WTOCharDelayTime = 570 ErrorNoise = 255 OnRxClusterEvent = SerialPortNG1RxClusterEvent end end
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls, ComCtrls, Buttons, ComDrv32, SerialNG, Mask, Math; type TForm1 = class(TForm) Chart1: TChart; Series1: TLineSeries; Series2: TLineSeries; Series3: TLineSeries; Series4: TLineSeries; Series5: TLineSeries; Series6: TLineSeries; Series7: TLineSeries; Series8: TLineSeries; ColorBox1: TColorBox; ColorBox2: TColorBox; ColorBox3: TColorBox; ColorBox4: TColorBox; ColorBox5: TColorBox; ColorBox6: TColorBox; ColorBox7: TColorBox; ColorBox8: TColorBox; StaticText1: TStaticText; StaticText2: TStaticText; StaticText3: TStaticText; StaticText4: TStaticText; StaticText5: TStaticText; StaticText6: TStaticText; StaticText7: TStaticText; StaticText8: TStaticText; ScrollBar1: TScrollBar; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; StaticText9: TStaticText; GroupBox1: TGroupBox; RadioButton1: TRadioButton; RadioButton2: TRadioButton; RadioButton3: TRadioButton; ComboBox1: TComboBox; ComboBox2: TComboBox; BitBtn1: TBitBtn; SerialPortNG1: TSerialPortNG; TrackBar1: TTrackBar; Edit1: TEdit; Label1: TLabel; Label2: TLabel; MaskEdit1: TMaskEdit; Label3: TLabel; Label4: TLabel; MaskEdit2: TMaskEdit; Label5: TLabel; procedure FormCreate(Sender: TObject); procedure ScrollChange(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure BitBtn1Click(Sender: TObject); procedure SerialPortNG1RxClusterEvent(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure ComboBox2Change(Sender: TObject); procedure MaskEdit2Change(Sender: TObject); private { Private declarations } scale:word; dwError:dword; pName:PWideChar; flag:byte; function StrToIntM(str:string):dword; public { Public declarations } end; TArrBuf512 = array[0..511] of byte; var Form1: TForm1; implementation uses SerialNGBasic; {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var i:word; s:string; begin SerialPortNG1.Active := True; scale := 500; ScrollBar1.Visible := False; Chart1.BottomAxis.Minimum := 0; Chart1.BottomAxis.Maximum := scale; Series1.Clear; Series2.Clear; Series3.Clear; Series4.Clear; Series5.Clear; Series6.Clear; Series7.Clear; Series8.Clear; for i := 0 to 500 do begin Series1.AddXY(i, ((i mod 1)*0.5)+0.25, '', ColorBox1.Selected); Series2.AddXY(i, ((i mod 2)*0.5)+1.25, '', ColorBox2.Selected); Series3.AddXY(i, ((i mod 2)*0.5)+2.25, '', ColorBox3.Selected); Series4.AddXY(i, ((i mod 2)*0.5)+3.25, '', ColorBox4.Selected); Series5.AddXY(i, ((i mod 2)*0.5)+4.25, '', ColorBox5.Selected); Series6.AddXY(i, ((i mod 2)*0.5)+5.25, '', ColorBox6.Selected); Series7.AddXY(i, ((i mod 2)*0.5)+6.25, '', ColorBox7.Selected); Series8.AddXY(i, ((i mod 2)*0.5)+7.25, '', ColorBox8.Selected); end; end; procedure TForm1.ScrollChange(Sender: TObject); begin Chart1.BottomAxis.Minimum := ScrollBar1.Position; Chart1.BottomAxis.Maximum := ScrollBar1.Position + scale; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin Close; end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin if (scale < 500) then scale := scale + 10; if (scale = 500) then ScrollBar1.Visible := False else ScrollBar1.Visible := True; ScrollBar1.Max := 500 - scale; if (ScrollBar1.Position > (500 - scale)) then ScrollBar1.Position := (500 - scale); Chart1.BottomAxis.Minimum := ScrollBar1.Position; Chart1.BottomAxis.Maximum := ScrollBar1.Position + scale; end; procedure TForm1.SpeedButton2Click(Sender: TObject); begin if (scale > 0) then scale := scale - 10; if (scale = 500) then ScrollBar1.Visible := False else ScrollBar1.Visible := True; ScrollBar1.Max := 500 - scale; Chart1.BottomAxis.Minimum := ScrollBar1.Position; Chart1.BottomAxis.Maximum := ScrollBar1.Position + scale; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin SerialPortNG1.Active := False; end; procedure TForm1.BitBtn1Click(Sender: TObject); var s:string; begin if (ComboBox2.ItemIndex <> -1) and (ComboBox1.ItemIndex <> -1) then begin s := ' '; s[1] := char($FF); s[2] := char($AA); s[3] := char($3A); s[4] := char((((ComboBox1.ItemIndex shl 1) or byte(RadioButton2.Checked))or (ComboBox2.ItemIndex shl 5))); SerialPortNG1.SendString(s); flag := 1; end else MessageBox(0, '���������� ������� ����� ��������� ������ � ������� �������� ���������!', '������', MB_OK or MB_ICONINFORMATION); end; procedure TForm1.SerialPortNG1RxClusterEvent(Sender: TObject); var i:integer; n:integer; p:^TArrBuf512; size:integer; error:DWord; begin n := SerialPortNG1.NextClusterSize; if n >= 0 then begin p := SerialPortNG1.ReadNextCluster(size, error); if (flag=1) then begin Series1.Clear; Series2.Clear; Series3.Clear; Series4.Clear; Series5.Clear; Series6.Clear; Series7.Clear; Series8.Clear; for i := 0 to n do begin Series8.AddXY(i, -(((p^[i] shr 7) and 1)*0.5)+7.75, '', ColorBox8.Selected); Series7.AddXY(i, -(((p^[i] shr 6) and 1)*0.5)+6.75, '', ColorBox7.Selected); Series6.AddXY(i, -(((p^[i] shr 5) and 1)*0.5)+5.75, '', ColorBox6.Selected); Series5.AddXY(i, -(((p^[i] shr 4) and 1)*0.5)+4.75, '', ColorBox5.Selected); Series4.AddXY(i, -(((p^[i] shr 3) and 1)*0.5)+3.75, '', ColorBox4.Selected); Series3.AddXY(i, -(((p^[i] shr 2) and 1)*0.5)+2.75, '', ColorBox3.Selected); Series2.AddXY(i, -(((p^[i] shr 1) and 1)*0.5)+1.75, '', ColorBox2.Selected); Series1.AddXY(i, -(( p^[i] and 1)*0.5)+0.75, '', ColorBox1.Selected); end; flag := 0; end; end; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin Edit1.Text := IntToStr(TrackBar1.Position); end; procedure TForm1.ComboBox2Change(Sender: TObject); begin if ComboBox2.ItemIndex = 7 then begin MaskEdit1.Visible := true; Label3.Visible := true; MaskEdit1.Text := ''; end else begin MaskEdit1.Visible := False; Label3.Visible := false; end; end; procedure TForm1.MaskEdit2Change(Sender: TObject); begin if MaskEdit2.Text <> '' then if StrToIntM(MaskEdit2.Text) > 65535 then MaskEdit2.Text := '65535'; end; function TForm1.StrToIntM(str:string):dword; var i,num:integer; begin num := 0; if (length(str) > 0) and (length(str) < 6) then for i := length(str) downto 1 do if ((str[i] >= '0')and(str[i] <= '9')) then begin num := num + (byte(str[i])-byte('0'))*Round(Power(10,length(str)-i)); end; StrToIntM := num; end; end.
object Form2: TForm2 Left = 291 Top = 205 AutoScroll = False BorderIcons = [biSystemMenu, biMinimize] Caption = #1043#1077#1085#1077#1088#1072#1090#1086#1088' '#1073#1072#1081#1090#1110#1074 ClientHeight = 473 ClientWidth = 607 Color = clBlack Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = Form2Create PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 104 Top = 24 Width = 112 Height = 18 Caption = #1056#1077#1076#1072#1082#1090#1080#1088#1086#1074#1072#1090#1100 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Label2: TLabel Left = 104 Top = 56 Width = 121 Height = 18 Caption = #1050#1086#1083#1080#1095#1077#1089#1090#1074#1086' '#1073#1072#1081#1090 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Label3: TLabel Left = 104 Top = 88 Width = 82 Height = 18 Caption = #1053#1072#1095#1072#1083#1100#1085#1099#1081 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object Label4: TLabel Left = 104 Top = 120 Width = 71 Height = 18 Caption = #1050#1086#1085#1077#1095#1085#1099#1081 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False end object ListBox1: TListBox Left = 8 Top = 8 Width = 65 Height = 433 ItemHeight = 13 TabOrder = 0 OnClick = ListBoxClick end object RadioGroup1: TRadioGroup Left = 408 Top = 16 Width = 185 Height = 105 Caption = #1043#1077#1085#1077#1088#1072#1094#1080#1103' '#1073#1072#1081#1090#1086#1074 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ItemIndex = 0 Items.Strings = ( #1062#1080#1082#1083#1080#1095#1077#1089#1082#1072#1103 #1056#1072#1079#1086#1074#1072#1103 #1055#1086#1096#1072#1075#1086#1074#1072#1103) ParentFont = False TabOrder = 1 end object BitBtn1: TBitBtn Left = 408 Top = 136 Width = 185 Height = 41 Caption = #1055#1091#1089#1082'/'#1064#1072#1075 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' Font.Style = [fsBold] ParentFont = False TabOrder = 2 OnClick = BitBtn1Click end object BitBtn2: TBitBtn Left = 408 Top = 192 Width = 185 Height = 41 Caption = #1057#1090#1086#1087 Enabled = False Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Arial' Font.Style = [fsBold] ParentFont = False TabOrder = 3 OnClick = BitBtn2Click end object CheckBox1: TCheckBox Left = 8 Top = 448 Width = 537 Height = 17 Caption = #1056#1072#1073#1086#1090#1072' '#1075#1077#1085#1077#1088#1072#1090#1086#1088#1072' '#1089#1083#1086#1074' '#1080' '#1083#1086#1075#1080#1095#1077#1089#1082#1086#1075#1086' '#1072#1085#1072#1083#1080#1079#1072#1090#1086#1088#1072' '#1074' '#1087#1072#1088#1077 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False TabOrder = 4 OnClick = CheckBox1Click end object GroupBox1: TGroupBox Left = 96 Top = 192 Width = 281 Height = 153 Caption = #1056#1077#1078#1080#1084' '#1091#1089#1090#1072#1085#1086#1074#1082#1080' '#1095#1072#1089#1090#1086#1090#1099 Font.Charset = DEFAULT_CHARSET Font.Color = clWhite Font.Height = -16 Font.Name = 'Arial' Font.Style = [] ParentFont = False TabOrder = 5 object Label5: TLabel Left = 192 Top = 56 Width = 18 Height = 18 Caption = 'Hz' Enabled = False end object Label6: TLabel Left = 192 Top = 112 Width = 18 Height = 18 Caption = 'Hz' end object RadioButton1: TRadioButton Left = 16 Top = 24 Width = 113 Height = 17 Caption = #1042#1099#1073#1086#1088#1086#1095#1085#1099#1081 TabOrder = 0 OnClick = RadioButton1Click end object RadioButton2: TRadioButton Left = 16 Top = 80 Width = 137 Height = 17 Caption = #1055#1088#1086#1080#1079#1074#1086#1083#1100#1085#1099#1081 Checked = True TabOrder = 1 TabStop = True OnClick = RadioButton2Click end object ComboBox1: TComboBox Left = 40 Top = 48 Width = 145 Height = 26 Enabled = False ItemHeight = 18 TabOrder = 2 Text = #1042#1099#1073#1086#1088' '#1095#1072#1089#1090#1086#1090#1099 end object MaskEdit5: TMaskEdit Left = 40 Top = 104 Width = 144 Height = 26 EditMask = '!999999;1; ' MaxLength = 6 TabOrder = 3 Text = ' ' end end object MaskEdit1: TMaskEdit Left = 232 Top = 24 Width = 33 Height = 21 EditMask = 'aa;1;0' MaxLength = 2 TabOrder = 6 Text = ' ' OnChange = MaskEdit1Change OnKeyPress = MaskEdit1KeyPress end object MaskEdit2: TMaskEdit Left = 232 Top = 56 Width = 33 Height = 21 EditMask = 'aaaa;1; ' MaxLength = 4 TabOrder = 7 Text = '1024' OnChange = MaskEdit2Change OnKeyPress = MaskEdit2KeyPress end object MaskEdit3: TMaskEdit Left = 232 Top = 88 Width = 33 Height = 21 EditMask = 'aaa;1;0' MaxLength = 3 TabOrder = 8 Text = ' ' OnChange = MaskEdit3Change OnKeyPress = MaskEdit3KeyPress end object MaskEdit4: TMaskEdit Left = 232 Top = 120 Width = 33 Height = 21 EditMask = 'aaa;1;0' MaxLength = 3 TabOrder = 9 Text = ' ' OnChange = MaskEdit4Change OnKeyPress = MaskEdit4KeyPress end end
unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Mask; type TForm2 = class(TForm) ListBox1: TListBox; RadioGroup1: TRadioGroup; BitBtn1: TBitBtn; BitBtn2: TBitBtn; CheckBox1: TCheckBox; Label1: TLabel; GroupBox1: TGroupBox; RadioButton1: TRadioButton; RadioButton2: TRadioButton; ComboBox1: TComboBox; Label5: TLabel; Label6: TLabel; MaskEdit1: TMaskEdit; Label2: TLabel; MaskEdit2: TMaskEdit; MaskEdit3: TMaskEdit; Label3: TLabel; Label4: TLabel; MaskEdit4: TMaskEdit; MaskEdit5: TMaskEdit; procedure RadioButton1Click(Sender: TObject); procedure RadioButton2Click(Sender: TObject); procedure ListBoxClick(Sender: TObject); procedure Form2Create(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure MaskEdit1KeyPress(Sender: TObject; var Key: Char); procedure MaskEdit1Change(Sender: TObject); procedure MaskEdit2KeyPress(Sender: TObject; var Key: Char); procedure MaskEdit2Change(Sender: TObject); procedure MaskEdit3KeyPress(Sender: TObject; var Key: Char); procedure MaskEdit4KeyPress(Sender: TObject; var Key: Char); procedure MaskEdit4Change(Sender: TObject); procedure MaskEdit3Change(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); private { Private declarations } index:integer; count:integer; buf:array[0..1023]of byte; function StrToHex(str:string):integer; public { Public declarations } end; var Form2: TForm2; implementation uses Unit1; {$R *.dfm} procedure TForm2.RadioButton1Click(Sender: TObject); begin MaskEdit5.Enabled := false; Label6.Enabled := false; ComboBox1.Enabled := true; Label5.Enabled := true; end; procedure TForm2.RadioButton2Click(Sender: TObject); begin ComboBox1.Enabled := false; Label5.Enabled := false; MaskEdit5.Enabled := true; Label6.Enabled := true; end; procedure TForm2.ListBoxClick(Sender: TObject); var s:string; begin s := ListBox1.Items.ValueFromIndex[ListBox1.ItemIndex]; index := ListBox1.ItemIndex; MaskEdit1.Text := s[4]+s[5]; end; procedure TForm2.Form2Create(Sender: TObject); var i,j:integer; s,s1:string; begin count := 1024; index := 0; ListBox1.Clear; for i := 0 to count-1 do begin s := Format('%x',[i]); for j := 1 to 3-length(s) do s1 := s1 + '0'; for j := 1 to length(s) do s1 := s1 + s[j]; ListBox1.Items.Add(s1+':00'); s1 := ''; buf[i] := 0; end; end; procedure TForm2.CheckBox1Click(Sender: TObject); begin if (CheckBox1.Checked = True) then Form1.Visible := true; end; procedure TForm2.MaskEdit1KeyPress(Sender: TObject; var Key: Char); begin if not(((Key >= '0') and (Key <= '9')) or ((Key >= 'A') and (Key <= 'F')) or ((Key >= 'a') and (Key <= 'f'))) then Key := ' '; if (Key >= 'a') and (Key <= 'f') then Key := UpCase(Key) end; procedure TForm2.MaskEdit1Change(Sender: TObject); var s,s1,s2:string; i:byte; begin s1 := ''; s := Format('%x',[index]); for i := 1 to 3-length(s) do s1 := s1 + '0'; for i := 1 to length(s) do s1 := s1 + s[i]; s2 := s1 + ':'; s1 := ''; s := Format('%x',[StrToHex(MaskEdit1.Text)]); for i := 1 to 2-length(s) do s1 := s1 + '0'; for i := 1 to length(s) do s1 := s1 + s[i]; buf[index] := StrToHex(MaskEdit1.Text); s2 := s2 + s1; ListBox1.Items.Strings[index] := s2; end; procedure TForm2.MaskEdit2KeyPress(Sender: TObject; var Key: Char); var i,j:integer; s,s1:string; begin if not((Key >= '0') and (Key <= '9') or (Key = #13)) then Key := ' '; if Key = #13 then begin ListBox1.Clear; for i := 0 to count-1 do begin s := Format('%x',[i]); for j := 1 to 3-length(s) do s1 := s1 + '0'; for j := 1 to length(s) do s1 := s1 + s[j]; ListBox1.Items.Add(s1+':00'); s1 := ''; end; end; end; procedure TForm2.MaskEdit2Change(Sender: TObject); var i:integer; s,s1:string; begin s1 := ''; s := MaskEdit2.Text; if s <> '' then for i := 1 to length(s) do if s[i] <> ' ' then s1 := s1 + s[i]; if s1 <> '' then begin if (StrToInt(s1) > 1024) then begin MaskEdit2.Text := '1024'; count := 1024; end; count := StrToInt(s1); end; end; function TForm2.StrToHex(str:string):integer; var i,num:integer; begin num := 0; if (length(str) > 0) and (length(str) < 5) then for i := length(str) downto 1 do begin if ((str[i] >= '0')and(str[i] <= '9')) then num := num + (byte(str[i])-byte('0'))shl(4*(length(str)-i)); if ((str[i] >= 'A')and(str[i] <= 'F')) then num := num + (byte(str[i])-byte('A')+10)shl(4*(length(str)-i)); if ((str[i] >= 'a')and(str[i] <= 'f')) then num := num + (byte(str[i])-byte('a')+10)shl(4*(length(str)-i)); end; StrToHex := num; end; procedure TForm2.MaskEdit3KeyPress(Sender: TObject; var Key: Char); begin if not(((Key >= '0') and (Key <= '9')) or ((Key >= 'A') and (Key <= 'F')) or ((Key >= 'a') and (Key <= 'f'))) then Key := ' '; if (Key >= 'a') and (Key <= 'f') then Key := UpCase(Key); end; procedure TForm2.MaskEdit4KeyPress(Sender: TObject; var Key: Char); begin if not(((Key >= '0') and (Key <= '9')) or ((Key >= 'A') and (Key <= 'F')) or ((Key >= 'a') and (Key <= 'f'))) then Key := ' '; if (Key >= 'a') and (Key <= 'f') then Key := UpCase(Key); end; procedure TForm2.MaskEdit4Change(Sender: TObject); begin if MaskEdit4.Text <> '' then begin if StrToHex(MaskEdit4.Text) > count-1 then MaskEdit4.Text := Format('%3x', [count-1]); if StrToHex(MaskEdit4.Text) < StrToHex(MaskEdit3.Text) then MaskEdit4.Text := MaskEdit3.Text; end; end; procedure TForm2.MaskEdit3Change(Sender: TObject); begin if MaskEdit3.Text <> '' then begin if StrToHex(MaskEdit3.Text) > count-1 then MaskEdit3.Text := Format('%3x', [count-1]); if StrToHex(MaskEdit4.Text) < StrToHex(MaskEdit3.Text) then MaskEdit3.Text := MaskEdit4.Text; end; end; procedure TForm2.BitBtn1Click(Sender: TObject); var i:integer; //a:array[1..] begin BitBtn1.Enabled := False; BitBtn2.Enabled := True; //Form1.SerialPortNG1.SendData(); Form1.SerialPortNG1.SendData(@buf[StrToHex(MaskEdit3.Text)],StrToHex(MaskEdit4.Text)-StrToHex(MaskEdit3.Text)); end; procedure TForm2.BitBtn2Click(Sender: TObject); begin BitBtn1.Enabled := True; BitBtn2.Enabled := False; end; end.
object Form3: TForm3 Left = 239 Top = 164 AutoScroll = False BorderIcons = [biSystemMenu, biMinimize] Caption = 'Form3' ClientHeight = 287 ClientWidth = 509 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False Visible = True PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 24 Top = 16 Width = 474 Height = 29 Caption = #1042#1110#1088#1090#1091#1072#1083#1100#1085#1080#1081' '#1074#1080#1084#1110#1088#1102#1074#1072#1083#1100#1085#1080#1081' '#1082#1086#1084#1087#1083#1077#1082#1089 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -24 Font.Name = 'Arial' Font.Style = [fsBold] ParentFont = False end object BitBtn1: TBitBtn Left = 16 Top = 64 Width = 153 Height = 41 Caption = #1051#1086#1075#1110#1095#1085#1080#1081' '#1072#1085#1072#1083#1110#1079#1072#1090#1086#1088 TabOrder = 0 OnClick = BitBtn1Click end object BitBtn2: TBitBtn Left = 16 Top = 120 Width = 153 Height = 41 Caption = #1043#1077#1085#1077#1088#1072#1090#1086#1088' '#1073#1072#1081#1090 TabOrder = 1 OnClick = BitBtn2Click end object BitBtn3: TBitBtn Left = 16 Top = 176 Width = 153 Height = 41 Caption = 'BitBtn3' Enabled = False TabOrder = 2 end object BitBtn4: TBitBtn Left = 16 Top = 232 Width = 153 Height = 41 Caption = 'BitBtn4' Enabled = False TabOrder = 3 end end
unit Unit3; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons; type TForm3 = class(TForm) BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn3: TBitBtn; BitBtn4: TBitBtn; Label1: TLabel; procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form3: TForm3; implementation uses Unit1, Unit2; {$R *.dfm} procedure TForm3.BitBtn1Click(Sender: TObject); begin Form1.Visible := True; end; procedure TForm3.BitBtn2Click(Sender: TObject); begin Form2.Visible := true; end; end.
<AVRStudio><MANAGEMENT><ProjectName>111</ProjectName><Created>24-Dec-2008 16:50:50</Created><LastEdit>09-Feb-2009 02:47:50</LastEdit><ICON>208</ICON><ProjectType>0</ProjectType><Created>24-Dec-2008 16:50:50</Created><Version>4</Version><Build>4, 13, 0, 557</Build><ProjectTypeName>Atmel AVR Assembler</ProjectTypeName></MANAGEMENT><CODE_CREATION><ObjectFile>111.obj</ObjectFile><EntryFile>D:\_DISK C\diplom\main.asm</EntryFile><SaveFolder>D:\_DISK C\diplom\</SaveFolder></CODE_CREATION><DEBUG_TARGET><CURRENT_TARGET>AVR Simulator</CURRENT_TARGET><CURRENT_PART>ATmega8515</CURRENT_PART><BREAKPOINTS></BREAKPOINTS><IO_EXPAND><HIDE>false</HIDE></IO_EXPAND><REGISTERNAMES><Register>R00</Register><Register>R01</Register><Register>R02</Register><Register>R03</Register><Register>R04</Register><Register>R05</Register><Register>R06</Register><Register>R07</Register><Register>R08</Register><Register>R09</Register><Register>R10</Register><Register>R11</Register><Register>R12</Register><Register>R13</Register><Register>R14</Register><Register>R15</Register><Register>R16</Register><Register>R17</Register><Register>R18</Register><Register>R19</Register><Register>R20</Register><Register>R21</Register><Register>R22</Register><Register>R23</Register><Register>R24</Register><Register>R25</Register><Register>R26</Register><Register>R27</Register><Register>R28</Register><Register>R29</Register><Register>R30</Register><Register>R31</Register></REGISTERNAMES><COM>Auto</COM><COMType>0</COMType><WATCHNUM>0</WATCHNUM><WATCHNAMES><Pane0></Pane0><Pane1></Pane1><Pane2></Pane2><Pane3></Pane3></WATCHNAMES><BreakOnTrcaeFull>0</BreakOnTrcaeFull></DEBUG_TARGET><Debugger><modules><module></module></modules><Triggers></Triggers></Debugger><AvrAssembler><Folder>D:\_DISK C\diplom\</Folder><RelPath>main.asm</RelPath><EntryFile>D:\_DISK C\diplom\main.asm</EntryFile><IncludePath>F:\Program Files\Atmel\AVR Tools\AvrAssembler\Appnotes</IncludePath><V2IncludePath></V2IncludePath><V2Parameters></V2Parameters><FileType>I</FileType><ObjectName>111</ObjectName><Wrap>0</Wrap><ErrorAsWarning>0</ErrorAsWarning><MapFile>1</MapFile><ListFile>0</ListFile><Version1>0</Version1><PreCompile></PreCompile><PostCompile></PostCompile><SourceFiles>,</SourceFiles></AvrAssembler><AVRSimulator><FuseExt>0</FuseExt><FuseHigh>246</FuseHigh><FuseLow>96</FuseLow><LockBits>237</LockBits><Frequency>7372800</Frequency><ExtSRAM>0</ExtSRAM><SimBoot>1</SimBoot><SimBootnew>1</SimBootnew></AVRSimulator><ProjectIncludeDirs><Dirs><Dir>F:\Program Files\Atmel\AVR Tools\AvrAssembler2\Appnotes</Dir></Dirs></ProjectIncludeDirs><ProjectFiles><Files><Name>\main.asm</Name><Name>F:\Program Files\Atmel\AVR Tools\AvrAssembler2\Appnotes\m8515def.inc</Name></Files></ProjectFiles><IOView><usergroups/></IOView><Files><File00000><FileId>00000</FileId><FileName>main.asm</FileName><Status>257</Status></File00000></Files><Events><Bookmarks></Bookmarks></Events><Trace><Filters></Filters></Trace></AVRStudio>
:020000020000FC :1000000010C000000000000000000000000006C258 :100010000000EDC100000000000000000000000032 :10002000000002E00EBF0FE50DBF0FE001BD00ECC8 :1000300005BF789414D202E009BF00E003BF222775 :10004000442700E007BB0FEF08BBA895413009F03B :10005000CDC1442708E10AB9C0E0DCE77FEF052FF6 :10006000007E06950695069506950695003069F57D :10007000052F0071E9F4052F0E70069511E0003090 :1000800019F0110F0A95D9F7052F017049F4A895B9 :1000900066B36123E1F7A89566B36123E1F308C075 :1000A000A89566B36123E1F3A89566B36123E1F7F0 :1000B00006B309937A95E1F77A9506B309937A9591 :1000C000E1F77A9506B3099379C1013089F5052FD7 :1000D0000071E9F4052F0E70069511E0003019F05B :1000E000110F0A95D9F7052F017049F4A89566B349 :1000F0006123E1F7A89566B36123E1F308C0A895F1 :1001000066B36123E1F3A89566B36123E1F706B313 :100110000993000000007A95D1F77A9506B3099308 :10012000000000007A95D1F77A9506B3099346C18D :100130000230A9F5052F0071E9F4052F0E70069520 :1001400011E0003019F0110F0A95D9F7052F017051 :1001500049F4A89566B36123E1F7A89566B36123D6 :10016000E1F308C0A89566B36123E1F3A89566B3EF :100170006123E1F706B3099313E01A95F1F7000044 :100180007A95C1F77A9506B3099313E01A95F1F7BA :1001900000007A95C1F77A9506B309930FC1033031 :1001A000B9F5052F0071E9F4052F0E70069511E0E1 :1001B000003019F0110F0A95D9F7052F017049F495 :1001C000A89566B36123E1F7A89566B36123E1F3CF :1001D00008C0A89566B36123E1F3A89566B36123CF :1001E000E1F706B3099318E01A95F1F70000000053 :1001F0007A95B9F77A9506B3099318E01A95F1F74D :10020000000000007A95D1F77A9506B30993D6C01D :100210000430A9F5052F0071E9F4052F0E7006953D :1002200011E0003019F0110F0A95D9F7052F017070 :1002300049F4A89566B36123E1F7A89566B36123F5 :10024000E1F308C0A89566B36123E1F3A89566B30E :100250006123E1F706B3099313E11A95F1F7000062 :100260007A95C1F77A9506B3099313E11A95F1F7D8 :1002700000007A95C1F77A9506B309939FC00530BF :10028000B9F5052F0071E9F4052F0E70069511E000 :10029000003019F0110F0A95D9F7052F017049F4B4 :1002A000A89566B36123E1F7A89566B36123E1F3EE :1002B00008C0A89566B36123E1F3A89566B36123EE :1002C000E1F706B3099318E21A95F1F70000000070 :1002D0007A95B9F77A9506B3099318E21A95F1F76A :1002E000000000007A95B9F77A9506B3099366C0C5 :1002F0000630A9F5052F0071E9F4052F0E7006955B :1003000011E0003019F0110F0A95D9F7052F01708F :1003100049F4A89566B36123E1F7A89566B3612314 :10032000E1F308C0A89566B36123E1F3A89566B32D :100330006123E1F706B3099313E51A95F1F700007D :100340007A95C1F77A9506B3099313E51A95F1F7F3 :1003500000007A95C1F77A9506B309932FC007304C :1003600009F042C0052F0071E9F4052F0E700695C3 :1003700011E0003019F0110F0A95D9F7052F01701F :1003800049F4A89566B36123E1F7A89566B36123A4 :10039000E1F308C0A89566B36123E1F3A89566B3BD :1003A0006123E1F706B309937A95E1F77A9506B3ED :1003B00009937A95E1F77A9506B30993C0E0DCE7F3 :1003C0000991A8955D9BFDCF0CB97A95C9F77A95EF :1003D0000991A8955D9BFDCF0CB97A95C9F7099154 :1003E000A8955D9BFDCF0CB908E90AB92ECE0F93F5 :1003F0000FB70F930CB1213059F00A3A59F405E0C8 :1004000003BF002702BF21E0C0E0DCE733270AEA90 :10041000099333950F910FBF0F9118950F931F9369 :100420000FB70F9300E003BFC0E0DCE7333089F47F :1004300009910A3A71F409910A3359F40991502F3C :1004400041E0C0E0DCE70027099309930993099391 :10045000099322270F910FBF1F910F91189508E95B :100460000AB906E000BD00E017E100BD19B901E0DE :10047000009300C00895F894A8955D9BFDCF0CB93A :0404800078940895CF :00000001FF
cls @F:\avr\avreal\avreal32 +MEGA8515 -p1 -w -v -o1000 -fBODEN=1,BLEV=1,CKSEL=0,BRST=1,CKOPT=0,SUT=1,EESV=1,BLB0=1,BLB1=1,S8515C=0 @pause
#include <m8515def.inc> .def tmp = r16 .def tmp1 = r17 .def RX_flag = r18 .def RX_Counter = r19 .def RX_Complete = r20 .def command = r21 .def tmp2 = r22 .def tmp3 = r23 .equ UC_REG = 0xC000 .equ RX_Buffer = 0x7C00 .macro USART_TRANSMITT_M utm_l0: wdr sbis UCSRA, UDRE rjmp utm_l0 out UDR, tmp .endm .macro WAIT_PUSK mov tmp, command andi tmp, 0b00010000 brne wp_l5 mov tmp, command andi tmp, 0b00001110 lsr tmp ldi tmp1, 1 wp_l0: cpi tmp, 0 breq wp_l1 lsl tmp1 dec tmp brne wp_l0 wp_l1: mov tmp, command andi tmp, 0b00000001 brne wp_l2 wp_l3: wdr in tmp2, PINB and tmp2, tmp1 brne wp_l3 wp_l4: wdr in tmp2, PINB and tmp2, tmp1 breq wp_l4 rjmp wp_l5 wp_l2: wdr in tmp2, PINB and tmp2, tmp1 breq wp_l2 wp_l6: wdr in tmp2, PINB and tmp2, tmp1 brne wp_l6 wp_l5: .endm .macro ANALYZE_CLK_6 ac6_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle dec tmp3 // 1 cycle brne ac6_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac6_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle dec tmp3 // 1 cycle brne ac6_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_8 ac8_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle nop // +2 cyle nop dec tmp3 // 1 cycle brne ac8_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac8_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle nop // +2 cyle nop dec tmp3 // 1 cycle brne ac8_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_16 ac16_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 3 // +10 cyle ac16_l2: dec tmp1 brne ac16_l2 nop dec tmp3 // 1 cycle brne ac16_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac16_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 3 // +10 cyle ac16_l3: dec tmp1 brne ac16_l3 nop dec tmp3 // 1 cycle brne ac16_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_32 ac32_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 8 // +26 cyle ac32_l2: dec tmp1 brne ac32_l2 nop nop dec tmp3 // 1 cycle brne ac32_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac32_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 8 // +26 cyle ac32_l3: dec tmp1 brne ac32_l3 nop nop dec tmp3 // 1 cycle brne ac32_l3 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_64 ac64_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 19 // +58 cyle ac64_l2: dec tmp1 brne ac64_l2 nop dec tmp3 // 1 cycle brne ac64_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac64_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 19 // +58 cyle ac64_l3: dec tmp1 brne ac64_l3 nop dec tmp3 // 1 cycle brne ac64_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_128 ac128_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 40 // +122 cyle ac128_l2: dec tmp1 brne ac128_l2 nop nop dec tmp3 // 1 cycle brne ac128_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac128_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 40 // +122 cyle ac128_l3: dec tmp1 brne ac128_l3 nop nop dec tmp3 // 1 cycle brne ac128_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_256 ac256_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 83 // +250 cyle ac256_l2: dec tmp1 brne ac256_l2 nop dec tmp3 // 1 cycle brne ac256_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle ac256_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle ldi tmp1, 83 // +250 cyle ac256_l3: dec tmp1 brne ac256_l3 nop dec tmp3 // 1 cycle brne ac256_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .macro ANALYZE_CLK_VN acv_l0: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle dec tmp3 // 1 cycle brne acv_l0 // 2 cycles or // 1 cycle dec tmp3 // 1 cycle acv_l1: in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle dec tmp3 // 1 cycle brne acv_l1 // 2 cycles dec tmp3 in tmp, PINB // 1 cycle st Y+, tmp // 2 cycle .endm .org 0 rjmp RESET nop;rjmp INT0 nop;rjmp INT1 nop;rjmp TIMER1_CAPT nop;rjmp TIMER1_COMPA nop;rjmp TIMER1_COMPB nop;rjmp TIMER1_OVF rjmp TIMER0_OVF nop;rjmp SPI_STC rjmp USART_RXC nop;rjmp USART_UDRE nop;rjmp USART_TXC nop;rjmp ANA_COMP nop;rjmp INT2 nop;rjmp TIMER0_COMP nop;rjmp EE_RDY nop;rjmp SPM_RDY RESET: ; set stack pointer to top of RAM ldi tmp, high(RAMEND) out SPH, tmp ldi tmp, low(RAMEND) out SPL, tmp ; enable WDT with 2,1s timeout ldi tmp, (1<<WDE)|(7<<WDP0) out WDTCR, tmp ; enable external SRAM ldi tmp, (1<<SRE)|(1<<SRW10) out MCUCR, tmp ; enable interrupts sei ; USART init rcall USART_Init // Unmask timer 0 overflov interrupt ldi tmp, (1<<TOIE0) out TIMSK, tmp // Stop timer0 ldi tmp, 0b00000000 out TCCR0, tmp clr RX_Flag clr RX_Complete ldi tmp, 0 out DDRB, tmp ldi tmp, 0b11111111 out PORTB, tmp loop: wdr cpi RX_Complete, 1 breq c_l0 rjmp l0 c_l0: // reset RX_Complete clr RX_Complete // mask RXCIE ldi tmp, (1<<TXEN) | (1<<RXEN) out UCSRB, tmp // reset RX_Buffer ldi YL, low(RX_Buffer) ldi YH, high(RX_Buffer) ldi tmp3, 0xFF // do command mov tmp, command andi tmp, 0b11100000 lsr tmp lsr tmp lsr tmp lsr tmp lsr tmp cpi tmp, 0 brne dc_l0 WAIT_PUSK ANALYZE_CLK_6 rjmp dc_end dc_l0: cpi tmp, 1 brne dc_l1 WAIT_PUSK ANALYZE_CLK_8 rjmp dc_end dc_l1: cpi tmp, 2 brne dc_l2 WAIT_PUSK ANALYZE_CLK_16 rjmp dc_end dc_l2: cpi tmp, 3 brne dc_l3 WAIT_PUSK ANALYZE_CLK_32 rjmp dc_end dc_l3: cpi tmp, 4 brne dc_l4 WAIT_PUSK ANALYZE_CLK_64 rjmp dc_end dc_l4: cpi tmp, 5 brne dc_l5 WAIT_PUSK ANALYZE_CLK_128 rjmp dc_end dc_l5: cpi tmp, 6 brne dc_l6 WAIT_PUSK ANALYZE_CLK_256 rjmp dc_end dc_l6: cpi tmp, 7 breq cdc_unk rjmp dc_unk cdc_unk: WAIT_PUSK ANALYZE_CLK_VN dc_end: /* // wait if need befor pusk WAIT_PUSK // analyse and store (6 cycles) // clock time (1/7372800Mhz)*6 = 813,8ns ANALYZE_CLK_6 */ // reset RX_Buffer ldi YL, low(RX_Buffer) ldi YH, high(RX_Buffer) // transmitt data l1: ld tmp, Y+ USART_TRANSMITT_M dec tmp3 brne l1 dec tmp3 l2: ld tmp, Y+ USART_TRANSMITT_M dec tmp3 brne l2 ld tmp, Y+ USART_TRANSMITT_M dc_unk: // unmask RXCIE ldi tmp, (1<<TXEN) | (1<<RXEN) | (1<<RXCIE) out UCSRB, tmp l0: rjmp loop ///////////////////////////////////////////////////// // USART receive complete ISR USART_RXC: push tmp in tmp, SREG push tmp // tmp <- RX in tmp, UDR // if (RX_Flag == 1) goto urxc_l0 cpi RX_Flag, 1 breq urxc_l0 // if (RX == AA) cpi tmp, 0xAA brne urxc_end // init timeout ldi tmp, 0b00000101 out TCCR0, tmp clr tmp out TCNT0, tmp // set recive_flag ldi RX_Flag, 1 // reset RX_Buffer ldi YL, low(RX_Buffer) ldi YH, high(RX_Buffer) clr RX_Counter ldi tmp, 0xAA urxc_l0: // push RX to buffer st Y+, tmp inc RX_Counter urxc_end: pop tmp out SREG, tmp pop tmp reti ///////////////////////////////////////////////////// // Timer0 overflow ISR TIMER0_OVF: push tmp push tmp1 in tmp, SREG push tmp // Stop timer0 ldi tmp, 0b00000000 out TCCR0, tmp // reset RX_Buffer ldi YL, low(RX_Buffer) ldi YH, high(RX_Buffer) cpi RX_Counter, 3 brne t0ovf_l0 ld tmp, Y+ cpi tmp, 0xAA brne t0ovf_l0 ld tmp, Y+ cpi tmp, 0x3A brne t0ovf_l0 ld tmp, Y+ mov command, tmp ldi RX_Complete, 1 //clear buffer ldi YL, low(RX_Buffer) ldi YH, high(RX_Buffer) clr tmp st Y+, tmp st Y+, tmp st Y+, tmp st Y+, tmp st Y+, tmp t0ovf_l0: // clear recive_flag clr RX_Flag pop tmp out SREG, tmp pop tmp1 pop tmp reti ///////////////////////////////////////////////////// // USART init routine // uses: tmp, tmp1 USART_Init: ldi tmp, (1<<TXEN) | (1<<RXEN) | (1<<RXCIE) out UCSRB, tmp ldi tmp, (1<<UCSZ0) | (1<<UCSZ1) out UCSRC, tmp ldi tmp, 0 ldi tmp1, 23 out UBRRH, tmp out UBRRL, tmp1 ldi tmp, 0b00000001 sts UC_REG, tmp ret ///////////////////////////////////////////////////// // USART transmit routine // uses: tmp USART_Transmit: cli ut_l0: wdr sbis UCSRA, UDRE rjmp ut_l0 out UDR, tmp sei ret
program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2}, Unit3 in 'Unit3.pas' {Form3}; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm3, Form3); Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm2, Form2); Application.Run; end.
#### ###��##��##################�### ###��##��##################(### ###@#####################################�##�###��#�###�#�#��##���#���###�##�###��#�###�#�#��##���##1###############�33331##########��3333##########33333###########������###########33331##DD#######����##FvvD######���1#Gggfv@#####���1#&vvggd######��1#wwgbvt######��1wwwr"gf@#####��1wwwr"vv@#####��3#wr""gf@#####��3#wr""&f@#####���#ww"w""@######��1�wr'""@######��1��w""$#######��1rwr"�########��3#'w"/�#######��3#"ww$�########��##""##�#######��1#####�#######��1#####��######��3####���p######�31###��##�3333;�31###��##�33333��3###���#��333���3####��#���������####������������####������������#####�###############�#�#���#���#���#���#���#���##�� #�##?�##?�###�###�###�###�###�###�##?�##?�##?�###����������#��~#��>###?###?###?�##?�##?�##?����####0###��##M#A#I#N#I#C#O#N########################### ######�#####
МІНІСТЕРСТВО ОСВІТИ І НАУКИ УКРАЇНИ
НАЦІОНАЛЬНИЙ ТЕХНІЧНИЙ УНІВЕРСИТЕТ
“ХАРКІВСЬКИЙ ПОЛІТЕХНІЧНИЙ ІНСТИТУТ”
Факультет xxxx Кафедра Обчислювальна техніка та програмування__
Спеціальність Системне програмування xxxx___________
До захисту допускаю
Завідувач кафедри
________________проф._xxxxxxxx
(ініціали та прізвище)
_________________________________
(підпис, дата)
ДИПЛОМНИЙ ПРОЕКТ
Освітньо-каліфікаційного рівня спеціаліст__
Тема проекту: Віртуальний вимірювальний комплекс на базі учбового______ лабораторного стенду EV8031________________________________________
затверджена наказом по НТУ «ХПІ» від “21” листопада 2008 р. № xxxxx
Харків 2009
Найменування виробу, об'єкту або теми | Найменування документу | Фор- мат | Кільк. арк. | При-мітка | ||||||
|
|
|
|
| ||||||
| Документи загальні |
|
|
| ||||||
|
|
|
|
| ||||||
| Завдання | А4 | 2 |
| ||||||
| Звіт | А4 | 91 |
| ||||||
|
|
|
|
| ||||||
|
|
|
|
| ||||||
|
|
|
|
| ||||||
| Програмні документи |
|
|
| ||||||
Документи дипломного проекту | Технічне завдання | А4 | 8 |
| ||||||
| Специфікація | А4 | 2 |
| ||||||
| Текст програми | А4 | 48 |
| ||||||
| Опис програми | А4 | 8 |
| ||||||
| Керівництво оператора | А4 | 7 |
| ||||||
|
|
|
|
| ||||||
| Плакати |
|
|
| ||||||
Тема проекту |
| А1 | 1 |
| ||||||
Структурна схема стенду, та розподілення його ресурсів |
| А1 | 1 |
| ||||||
Результати роботи |
| А1 | 1 |
| ||||||
Протокол обміну з COM портом |
А1
1
Формули для розрахунків
А1
1
Схема алгоритму
А4
8
XXXXX-23А 03077.13 ВД
Прізвище
Підп
Дата
Розроб.
Xxxxx
Віртуальний висірювальний комплекс на базі учбового лабораторного стенду EV8031
Відомість документів
Літ.
Аркуш
Аркушів
Перев.
Xxxxx
ДПС
1
1
НТУ «ХПІ»
Кафедра ОТП
Н. конт.
Xxxxx
Затв.
Домнін