controls/comport/MCKMHComPort.pas

   1 unit MCKMHComPort;
   2 //  MHComPort Êîìïîíåíò (MHComPort Component)
   3 //  Àâòîð (Author): Æàðîâ Äìèòðèé (Zharov Dmitry) aka Ãýíäàëüô (Gandalf)
   4 //  Äàòà ñîçäàíèÿ (Create date): 4-ìàé(may)-2002
   5 //  Äàòà êîððåêöèè (Last correction Date): 15-ôåâ(feb)-2003
   6 //  Âåðñèÿ (Version): 1.12
   7 //  EMail: Gandalf@kol.mastak.ru
   8 //  WWW: http://kol.mastak.ru
   9 //  Áëàãîäàðíîñòè (Thanks):
  10 //    Dejan Crnila
  11 //    Alexander Pravdin
  12 //  Íîâîå â (New in):
  13 //  V1.12
  14 //  [+] Ïîääåðæêà D7 (D7 Support) [KOLnMCK]
  15 //
  16 //  V1.11
  17 //  [+] Ïîääåðæêà D6 (D6 Support) <Thanks to Alexander Pravdin> [KOLnMCK]
  18 //
  19 //  V1.1
  20 //  [!] Ñîîáùåíèÿ (Events) [KOLnMCK]
  21 //  [+] Ïðèâÿçêà ñîáûòèé (Assign Events) [MCK]
  22 //
  23 //  Ñïèñîê äåë (To-Do list):
  24 //  1. Àññåìáëåð (Asm)
  25 //  2. Îïòèìèçèðîâàòü (Optimize)
  26 //  3. Ïîä÷èñòèòü (Clear Stuff)
  27 //  4. Îøèáêè (Errors)
  28 //  5. Óäàëèòü RxOnBuf (Strip RxOnBuf)
  29 //  6. Íîðìàëüíàÿ èêîíêà (Icon Correct)
  30
  31 interface
  32
  33 uses
  34   KOL, KOLMHComPort, mirror, Classes;
  35
  36 type
  37   TKOLMHComPort = class;
  38
  39   TComFlowControl = class(TPersistent)
  40   private
  41     FComPort: TKOLMHComPort;
  42     FOutCTSFlow: Boolean;
  43     FOutDSRFlow: Boolean;
  44     FControlDTR: TDTRFlowControl;
  45     FControlRTS: TRTSFlowControl;
  46     FXonXoffOut: Boolean;
  47     FXonXoffIn:  Boolean;
  48     FDSRSensitivity: Boolean;
  49     FTxContinueOnXoff: Boolean;
  50     FXonChar: Char;
  51     FXoffChar: Char;
  52     procedure SetComPort(const AComPort:TKOLMHComPort);
  53     procedure SetOutCTSFlow(const Value: Boolean);
  54     procedure SetOutDSRFlow(const Value: Boolean);
  55     procedure SetControlDTR(const Value: TDTRFlowControl);
  56     procedure SetControlRTS(const Value: TRTSFlowControl);
  57     procedure SetXonXoffOut(const Value: Boolean);
  58     procedure SetXonXoffIn(const Value: Boolean);
  59     procedure SetDSRSensitivity(const Value: Boolean);
  60     procedure SetTxContinueOnXoff(const Value: Boolean);
  61     procedure SetXonChar(const Value: Char);
  62     procedure SetXoffChar(const Value: Char);
  63     procedure SetFlowControl(const Value: TFlowControl);
  64     function GetFlowControl: TFlowControl;
  65   protected
  66     procedure AssignTo(Dest: TPersistent); override;
  67   public
  68     constructor Create;
  69     property ComPort: TKOLMHComPort read FComPort;
  70   published
  71     property FlowControl: TFlowControl read GetFlowControl write SetFlowControl stored False;
  72     property OutCTSFlow: Boolean read FOutCTSFlow write SetOutCTSFlow;
  73     property OutDSRFlow: Boolean read FOutDSRFlow write SetOutDSRFlow;
  74     property ControlDTR: TDTRFlowControl read FControlDTR write SetControlDTR;
  75     property ControlRTS: TRTSFlowControl read FControlRTS write SetControlRTS;
  76     property XonXoffOut: Boolean read FXonXoffOut write SetXonXoffOut;
  77     property XonXoffIn:  Boolean read FXonXoffIn write SetXonXoffIn;
  78     property DSRSensitivity: Boolean
  79       read FDSRSensitivity write SetDSRSensitivity default False;
  80     property TxContinueOnXoff: Boolean
  81       read FTxContinueOnXoff write SetTxContinueOnXoff default False;
  82     property XonChar: Char read FXonChar write SetXonChar default #17;
  83     property XoffChar: Char read FXoffChar write SetXoffChar default #19;
  84   end;
  85
  86   TComTimeouts = class(TPersistent)
  87   private
  88     FComPort: TKOLMHComPort;
  89     FReadInterval: Integer;
  90     FReadTotalM: Integer;
  91     FReadTotalC: Integer;
  92     FWriteTotalM: Integer;
  93     FWriteTotalC: Integer;
  94     procedure SetComPort(const AComPort: TKOLMHComPort);
  95     procedure SetReadInterval(const Value: Integer);
  96     procedure SetReadTotalM(const Value: Integer);
  97     procedure SetReadTotalC(const Value: Integer);
  98     procedure SetWriteTotalM(const Value: Integer);
  99     procedure SetWriteTotalC(const Value: Integer);
 100   protected
 101     procedure AssignTo(Dest: TPersistent); override;
 102   public
 103     constructor Create;
 104     property ComPort: TKOLMHComPort read FComPort;
 105   published
 106     property ReadInterval: Integer read FReadInterval write SetReadInterval default -1;
 107     property ReadTotalMultiplier: Integer read FReadTotalM write SetReadTotalM default 0;
 108     property ReadTotalConstant: Integer read FReadTotalC write SetReadTotalC default 0;
 109     property WriteTotalMultiplier: Integer
 110       read FWriteTotalM write SetWriteTotalM default 100;
 111     property WriteTotalConstant: Integer
 112       read FWriteTotalC write SetWriteTotalC default 1000;
 113   end;
 114
 115   TComParity = class(TPersistent)
 116   private
 117     FComPort: TKOLMHComPort;
 118     FBits: TParityBits;
 119     FCheck: Boolean;
 120     FReplace: Boolean;
 121     FReplaceChar: Char;
 122     procedure SetComPort(const AComPort: TKOLMHComPort);
 123     procedure SetBits(const Value: TParityBits);
 124     procedure SetCheck(const Value: Boolean);
 125     procedure SetReplace(const Value: Boolean);
 126     procedure SetReplaceChar(const Value: Char);
 127   protected
 128     procedure AssignTo(Dest: TPersistent); override;
 129   public
 130     constructor Create;
 131     property ComPort: TKOLMHComPort read FComPort;
 132   published
 133     property Bits: TParityBits read FBits write SetBits;
 134     property Check: Boolean read FCheck write SetCheck default False;
 135     property Replace: Boolean read FReplace write SetReplace default False;
 136     property ReplaceChar: Char read FReplaceChar write SetReplaceChar default #0;
 137   end;
 138
 139   TComBuffer = class(TPersistent)
 140   private
 141     FComPort: TKOLMHComPort;
 142     FInputSize: Integer;
 143     FOutputSize: Integer;
 144     procedure SetComPort(const AComPort: TKOLMHComPort);
 145     procedure SetInputSize(const Value: Integer);
 146     procedure SetOutputSize(const Value: Integer);
 147   protected
 148     procedure AssignTo(Dest: TPersistent); override;
 149   public
 150     constructor Create;
 151     property ComPort: TKOLMHComPort read FComPort;
 152   published
 153     property InputSize: Integer read FInputSize write SetInputSize default 1024;
 154     property OutputSize: Integer read FOutputSize write SetOutputSize default 1024;
 155   end;
 156
 157   TKOLMHComPort = class(TKOLObj)
 158   private
 159 //    FWindow: THandle;
 160 //    FUpdateCount: Integer;
 161     FBaudRate: TBaudRate;
 162     FCustomBaudRate: Integer;
 163     FPort: TPort;
 164     FStopBits: TStopBits;
 165     FDataBits: TDataBits;
 166     FDiscardNull: Boolean;
 167     FEventChar: Char;
 168     FEvents: TComEvents;
 169     FBuffer: TComBuffer;
 170     FParity: TComParity;
 171     FTimeouts: TComTimeouts;
 172     FFlowControl: TComFlowControl;
 173     FSyncMethod: TSyncMethod;
 174     FStoredProps: TStoredProps;
 175     FOnRxChar: TRxCharEvent;
 176     FOnRxBuf: TRxBufEvent;
 177     FOnTxEmpty: TOnEvent;
 178     FOnBreak: TOnEvent;
 179     FOnRing: TOnEvent;
 180     FOnCTSChange: TComSignalEvent;
 181     FOnDSRChange: TComSignalEvent;
 182     FOnRLSDChange: TComSignalEvent;
 183     FOnError: TComErrorEvent;
 184     FOnRxFlag: TOnEvent;
 185     FOnAfterOpen: TOnEvent;
 186     FOnAfterClose: TOnEvent;
 187     FOnBeforeOpen: TOnEvent;
 188     FOnBeforeClose: TOnEvent;
 189     FOnRx80Full: TOnEvent;
 190     procedure SetBaudRate(const Value: TBaudRate);
 191     procedure SetCustomBaudRate(const Value: Integer);
 192     procedure SetPort(const Value: TPort);
 193     procedure SetStopBits(const Value: TStopBits);
 194     procedure SetDataBits(const Value: TDataBits);
 195     procedure SetDiscardNull(const Value: Boolean);
 196     procedure SetEventChar(const Value: Char);
 197     procedure SetSyncMethod(const Value: TSyncMethod);
 198     procedure SetParity(const Value: TComParity);
 199     procedure SetTimeouts(const Value: TComTimeouts);
 200     procedure SetBuffer(const Value: TComBuffer);
 201     procedure SetFlowControl(const Value: TComFlowControl);
 202     procedure SetOnRxChar(const Value:TRxCharEvent);
 203   protected
 204     function  AdditionalUnits: string; override;
 205     procedure AssignEvents( SL: TStringList; const AName: String ); override;
 206     procedure SetupFirst(SL: TStringList; const AName,AParent, Prefix: String); override;
 207   public
 208     constructor Create(AOwner: TComponent); override;
 209     destructor Destroy; override;
 210   published
 211     property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
 212     property CustomBaudRate: Integer read FCustomBaudRate write SetCustomBaudRate;
 213     property Port: TPort read FPort write SetPort;
 214     property Parity: TComParity read FParity write SetParity;
 215     property StopBits: TStopBits read FStopBits write SetStopBits;
 216     property DataBits: TDataBits read FDataBits write SetDataBits;
 217     property DiscardNull: Boolean read FDiscardNull write SetDiscardNull default False;
 218     property EventChar: Char read FEventChar write SetEventChar default #0;
 219     property Events: TComEvents read FEvents write FEvents;
 220     property Buffer: TComBuffer read FBuffer write SetBuffer;
 221     property FlowControl: TComFlowControl read FFlowControl write SetFlowControl;
 222     property Timeouts: TComTimeouts read FTimeouts write SetTimeouts;
 223     property SyncMethod: TSyncMethod read FSyncMethod write SetSyncMethod default smThreadSync;
 224     property OnAfterOpen: TOnEvent read FOnAfterOpen write FOnAfterOpen;
 225     property OnAfterClose: TOnEvent read FOnAfterClose write FOnAfterClose;
 226     property OnBeforeOpen: TOnEvent read FOnBeforeOpen write FOnBeforeOpen;
 227     property OnBeforeClose: TOnEvent read FOnBeforeClose write FOnBeforeClose;
 228     property OnRxChar: TRxCharEvent read FOnRxChar write SetOnRxChar;
 229     property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf;
 230     property OnTxEmpty: TOnEvent read FOnTxEmpty write FOnTxEmpty;
 231     property OnBreak: TOnEvent read FOnBreak write FOnBreak;
 232     property OnRing: TOnEvent read FOnRing write FOnRing;
 233     property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange;
 234     property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange;
 235     property OnRLSDChange: TComSignalEvent read FOnRLSDChange write FOnRLSDChange;
 236     property OnRxFlag: TOnEvent read FOnRxFlag write FOnRxFlag;
 237     property OnError: TComErrorEvent read FOnError write FOnError;
 238     property OnRx80Full: TOnEvent read FOnRx80Full write FOnRx80Full;
 239   end;
 240
 241   procedure Register;
 242
 243 implementation
 244
 245 constructor TComFlowControl.Create;
 246 begin
 247   inherited Create;
 248   FXonChar := #17;
 249   FXoffChar := #19;
 250 end;
 251
 252 // copy properties to other class
 253 procedure TComFlowControl.AssignTo(Dest: TPersistent);
 254 begin
 255   if Dest is TComFlowControl then
 256   begin
 257     with TComFlowControl(Dest) do
 258     begin
 259       FOutCTSFlow       := Self.OutCTSFlow;
 260       FOutDSRFlow       := Self.OutDSRFlow;
 261       FControlDTR       := Self.ControlDTR;
 262       FControlRTS       := Self.ControlRTS;
 263       FXonXoffOut       := Self.XonXoffOut;
 264       FXonXoffIn        := Self.XonXoffIn;
 265       FTxContinueOnXoff := Self.TxContinueOnXoff;
 266       FDSRSensitivity   := Self.DSRSensitivity;
 267       FXonChar          := Self.XonChar;
 268       FXoffChar         := Self.XoffChar;
 269     end
 270   end
 271   else
 272     inherited AssignTo(Dest);
 273 end;
 274
 275 procedure TComFlowControl.SetComPort(const AComPort:TKOLMHComPort);
 276 begin
 277   FComPort:=AComPort;
 278 end;
 279
 280
 281 // set input flow control for DTR (data-terminal-ready)
 282 procedure TComFlowControl.SetControlDTR(const Value: TDTRFlowControl);
 283 begin
 284   if Value <> FControlDTR then
 285   begin
 286     FControlDTR := Value;
 287 //    if FComPort <> nil then
 288 //      FComPort.ApplyDCB;
 289   end;
 290 end;
 291
 292 // set input flow control for RTS (request-to-send)
 293 procedure TComFlowControl.SetControlRTS(const Value: TRTSFlowControl);
 294 begin
 295   if Value <> FControlRTS then
 296   begin
 297     FControlRTS := Value;
 298 //    if FComPort <> nil then
 299 //      FComPort.ApplyDCB;
 300   end;
 301 end;
 302
 303 // set ouput flow control for CTS (clear-to-send)
 304 procedure TComFlowControl.SetOutCTSFlow(const Value: Boolean);
 305 begin
 306   if Value <> FOutCTSFlow then
 307   begin
 308     FOutCTSFlow := Value;
 309 //    if FComPort <> nil then
 310 //      FComPort.ApplyDCB;
 311   end;
 312 end;
 313
 314 // set output flow control for DSR (data-set-ready)
 315 procedure TComFlowControl.SetOutDSRFlow(const Value: Boolean);
 316 begin
 317   if Value <> FOutDSRFlow then
 318   begin
 319     FOutDSRFlow := Value;
 320 //    if FComPort <> nil then
 321 //      FComPort.ApplyDCB;
 322   end;
 323 end;
 324
 325 // set software input flow control
 326 procedure TComFlowControl.SetXonXoffIn(const Value: Boolean);
 327 begin
 328   if Value <> FXonXoffIn then
 329   begin
 330     FXonXoffIn := Value;
 331 //    if FComPort <> nil then
 332 //      FComPort.ApplyDCB;
 333   end;
 334 end;
 335
 336 // set software ouput flow control
 337 procedure TComFlowControl.SetXonXoffOut(const Value: Boolean);
 338 begin
 339   if Value <> FXonXoffOut then
 340   begin
 341     FXonXoffOut := Value;
 342 //    if FComPort <> nil then
 343 //      FComPort.ApplyDCB;
 344   end;
 345 end;
 346
 347 // set DSR sensitivity
 348 procedure TComFlowControl.SetDSRSensitivity(const Value: Boolean);
 349 begin
 350   if Value <> FDSRSensitivity then
 351   begin
 352     FDSRSensitivity := Value;
 353 //    if FComPort <> nil then
 354 //      FComPort.ApplyDCB;
 355   end;
 356 end;
 357
 358 // set transfer continue when Xoff is sent
 359 procedure TComFlowControl.SetTxContinueOnXoff(const Value: Boolean);
 360 begin
 361   if Value <> FTxContinueOnXoff then
 362   begin
 363     FTxContinueOnXoff := Value;
 364 //    if FComPort <> nil then
 365 //      FComPort.ApplyDCB;
 366   end;
 367 end;
 368
 369 // set Xon char
 370 procedure TComFlowControl.SetXonChar(const Value: Char);
 371 begin
 372   if Value <> FXonChar then
 373   begin
 374     FXonChar := Value;
 375 //    if FComPort <> nil then
 376 //      FComPort.ApplyDCB;
 377   end;
 378 end;
 379
 380 // set Xoff char
 381 procedure TComFlowControl.SetXoffChar(const Value: Char);
 382 begin
 383   if Value <> FXoffChar then
 384   begin
 385     FXoffChar := Value;
 386 //    if FComPort <> nil then
 387 //      FComPort.ApplyDCB;
 388   end;
 389 end;
 390
 391 // get common flow control
 392 function TComFlowControl.GetFlowControl: TFlowControl;
 393 begin
 394   if (FControlRTS = rtsHandshake) and (FOutCTSFlow)
 395     and (not FXonXoffIn) and (not FXonXoffOut)
 396   then
 397     Result := fcHardware
 398   else
 399     if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
 400       and (FXonXoffIn) and (FXonXoffOut)
 401     then
 402       Result := fcSoftware
 403     else
 404       if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
 405         and (not FXonXoffIn) and (not FXonXoffOut)
 406       then
 407         Result := fcNone
 408       else
 409         Result := fcCustom;
 410 end;
 411
 412 // set common flow control
 413 procedure TComFlowControl.SetFlowControl(const Value: TFlowControl);
 414 begin
 415   if Value <> fcCustom then
 416   begin
 417     FControlRTS := rtsDisable;
 418     FOutCTSFlow := False;
 419     FXonXoffIn := False;
 420     FXonXoffOut := False;
 421     case Value of
 422       fcHardware:
 423       begin
 424         FControlRTS := rtsHandshake;
 425         FOutCTSFlow := True;
 426       end;
 427       fcSoftware:
 428       begin
 429         FXonXoffIn := True;
 430         FXonXoffOut := True;
 431       end;
 432     end;
 433   end;
 434 //  if FComPort <> nil then
 435 //    FComPort.ApplyDCB;
 436 end;
 437
 438
 439 constructor TComTimeouts.Create;
 440 begin
 441   inherited Create;
 442   FReadInterval := -1;
 443   FWriteTotalM := 100;
 444   FWriteTotalC := 1000;
 445 end;
 446
 447 // copy properties to other class
 448 procedure TComTimeouts.AssignTo(Dest: TPersistent);
 449 begin
 450   if Dest is TComTimeouts then
 451   begin
 452     with TComTimeouts(Dest) do
 453     begin
 454       FReadInterval := Self.ReadInterval;
 455       FReadTotalM   := Self.ReadTotalMultiplier;
 456       FReadTotalC   := Self.ReadTotalConstant;
 457       FWriteTotalM  := Self.WriteTotalMultiplier;
 458       FWriteTotalC  := Self.WriteTotalConstant;
 459     end
 460   end
 461   else
 462     inherited AssignTo(Dest);
 463 end;
 464
 465 // select TCustomComPort to own this class
 466 procedure TComTimeouts.SetComPort(const AComPort: TKOLMHComPort);
 467 begin
 468   FComPort := AComPort;
 469 end;
 470
 471 // set read interval
 472 procedure TComTimeouts.SetReadInterval(const Value: Integer);
 473 begin
 474   if Value <> FReadInterval then
 475   begin
 476     FReadInterval := Value;
 477     // if possible, apply the changes
 478 //    if FComPort <> nil then
 479 //      FComPort.ApplyTimeouts;
 480   end;
 481 end;
 482
 483 // set read total constant
 484 procedure TComTimeouts.SetReadTotalC(const Value: Integer);
 485 begin
 486   if Value <> FReadTotalC then
 487   begin
 488     FReadTotalC := Value;
 489 //    if FComPort <> nil then
 490 //      FComPort.ApplyTimeouts;
 491   end;
 492 end;
 493
 494 // set read total multiplier
 495 procedure TComTimeouts.SetReadTotalM(const Value: Integer);
 496 begin
 497   if Value <> FReadTotalM then
 498   begin
 499     FReadTotalM := Value;
 500 //    if FComPort <> nil then
 501 //      FComPort.ApplyTimeouts;
 502   end;
 503 end;
 504
 505 // set write total constant
 506 procedure TComTimeouts.SetWriteTotalC(const Value: Integer);
 507 begin
 508   if Value <> FWriteTotalC then
 509   begin
 510     FWriteTotalC := Value;
 511 //    if FComPort <> nil then
 512 //      FComPort.ApplyTimeouts;
 513   end;
 514 end;
 515
 516 // set write total multiplier
 517 procedure TComTimeouts.SetWriteTotalM(const Value: Integer);
 518 begin
 519   if Value <> FWriteTotalM then
 520   begin
 521     FWriteTotalM := Value;
 522 //    if FComPort <> nil then
 523 //      FComPort.ApplyTimeouts;
 524   end;
 525 end;
 526
 527
 528 constructor TComParity.Create;
 529 begin
 530   inherited Create;
 531   FBits := prNone;
 532 end;
 533
 534 // copy properties to other class
 535 procedure TComParity.AssignTo(Dest: TPersistent);
 536 begin
 537   if Dest is TComParity then
 538   begin
 539     with TComParity(Dest) do
 540     begin
 541       FBits        := Self.Bits;
 542       FCheck       := Self.Check;
 543       FReplace     := Self.Replace;
 544       FReplaceChar := Self.ReplaceChar;
 545     end
 546   end
 547   else
 548     inherited AssignTo(Dest);
 549 end;
 550
 551 // select TCustomComPort to own this class
 552 procedure TComParity.SetComPort(const AComPort: TKOLMHComPort);
 553 begin
 554   FComPort := AComPort;
 555 end;
 556
 557 // set parity bits
 558 procedure TComParity.SetBits(const Value: TParityBits);
 559 begin
 560   if Value <> FBits then
 561   begin
 562     FBits := Value;
 563 //    if FComPort <> nil then
 564 //      FComPort.ApplyDCB;
 565   end;
 566 end;
 567
 568 // set check parity
 569 procedure TComParity.SetCheck(const Value: Boolean);
 570 begin
 571   if Value <> FCheck then
 572   begin
 573     FCheck := Value;
 574 //    if FComPort <> nil then
 575 //      FComPort.ApplyDCB;
 576   end;
 577 end;
 578
 579 // set replace on parity error
 580 procedure TComParity.SetReplace(const Value: Boolean);
 581 begin
 582   if Value <> FReplace then
 583   begin
 584     FReplace := Value;
 585 //    if FComPort <> nil then
 586 //      FComPort.ApplyDCB;
 587   end;
 588 end;
 589
 590 // set replace char
 591 procedure TComParity.SetReplaceChar(const Value: Char);
 592 begin
 593   if Value <> FReplaceChar then
 594   begin
 595     FReplaceChar := Value;
 596 //    if FComPort <> nil then
 597 //      FComPort.ApplyDCB;
 598   end;
 599 end;
 600
 601 constructor TComBuffer.Create;
 602 begin
 603   inherited Create;
 604   FInputSize := 1024;
 605   FOutputSize := 1024;
 606 end;
 607
 608 // copy properties to other class
 609 procedure TComBuffer.AssignTo(Dest: TPersistent);
 610 begin
 611   if Dest is TComBuffer then
 612   begin
 613     with TComBuffer(Dest) do
 614     begin
 615       FOutputSize  := Self.OutputSize;
 616       FInputSize   := Self.InputSize;
 617     end
 618   end
 619   else
 620     inherited AssignTo(Dest);
 621 end;
 622
 623 // select TCustomComPort to own this class
 624 procedure TComBuffer.SetComPort(const AComPort: TKOLMHComPort);
 625 begin
 626   FComPort := AComPort;
 627 end;
 628
 629 // set input size
 630 procedure TComBuffer.SetInputSize(const Value: Integer);
 631 begin
 632   if Value <> FInputSize then
 633   begin
 634     FInputSize := Value;
 635     if (FInputSize mod 2) = 1 then
 636       Dec(FInputSize);
 637 //    if FComPort <> nil then
 638 //      FComPort.ApplyBuffer;
 639   end;
 640 end;
 641
 642 // set ouput size
 643 procedure TComBuffer.SetOutputSize(const Value: Integer);
 644 begin
 645   if Value <> FOutputSize then
 646   begin
 647     FOutputSize := Value;
 648     if (FOutputSize mod 2) = 1 then
 649       Dec(FOutputSize);
 650 //    if FComPort <> nil then
 651 //      FComPort.ApplyBuffer;
 652   end;
 653 end;
 654
 655
 656 constructor TKOLMHComPort.Create(AOwner: TComponent);
 657 begin
 658   inherited;
 659   FComponentStyle := FComponentStyle - [csInheritable];
 660 //  FLinks := TList.Create;
 661   FBaudRate := br9600;
 662   FCustomBaudRate := 9600;
 663   FPort := 'COM1';
 664   FStopBits := sbOneStopBit;
 665   FDataBits := dbEight;
 666   FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
 667              evCTS, evDSR, evError, evRLSD, evRx80Full];
 668 //  FHandle := INVALID_HANDLE_VALUE;
 669   FStoredProps := [spBasic];
 670   FParity := TComParity.Create;
 671 //  FParity.SetComPort(Self);
 672   FFlowControl := TComFlowControl.Create;
 673 //  FFlowControl.SetComPort(Self);
 674   FTimeouts := TComTimeouts.Create;
 675 //  FTimeouts.SetComPort(Self);
 676   FBuffer := TComBuffer.Create;
 677 //  FBuffer.SetComPort(Self);
 678 //  FInitFont:=TKOLFont.Create(Self);
 679 end;
 680
 681 destructor TKOLMHComPort.Destroy;
 682 begin
 683 //  Close;
 684   FBuffer.Free;
 685   FFlowControl.Free;
 686   FTimeouts.Free;
 687   FParity.Free;
 688 //  FLinks.Free;
 689   inherited;
 690
 691 //  FInitFont.Free;
 692 end;
 693
 694 function TKOLMHComPort.AdditionalUnits;
 695 begin
 696    Result := ', KOLMHComPort';
 697 end;
 698
 699 procedure TKOLMHComPort.SetupFirst(SL: TStringList; const AName,
 700   AParent, Prefix: String);
 701 const
 702   Boolean2Str:array [Boolean] of String=('False','True');
 703   BaudRate2Str:array [TBaudRate] of String=('brCustom', 'br110', 'br300', 'br600', 'br1200', 'br2400', 'br4800', 'br9600', 'br14400',
 704     'br19200', 'br38400', 'br56000', 'br57600', 'br115200', 'br128000', 'br256000');
 705   StopBits2Str:array [TStopBits] of String=('sbOneStopBit', 'sbOne5StopBits', 'sbTwoStopBits');
 706   DataBits2Str:array [TDataBits] of String=('dbFive', 'dbSix', 'dbSeven', 'dbEight');
 707   ParityBits2Str:array [TParityBits] of String=('prNone', 'prOdd', 'prEven', 'prMark', 'prSpace');
 708   ControlDTR2Str:array [TDTRFlowControl] of String=('dtrDisable', 'dtrEnable', 'dtrHandshake');
 709   ControlRTS2Str:array [TRTSFlowControl] of String=('rtsDisable', 'rtsEnable', 'rtsHandshake', 'rtsToggle');
 710   SyncMethod2Str:array [TSyncMethod] of String=('smThreadSync', 'smWindowSync', 'smNone');
 711   ComEvent2Str:array [TComEvent] of String=('evRxChar', 'evTxEmpty', 'evRxFlag', 'evRing', 'evBreak', 'evCTS', 'evDSR', 'evError', 'evRLSD', 'evRx80Full');
 712 var
 713   tmpStr:String;
 714 begin
 715   SL.Add('');
 716   SL.Add(Prefix+AName+':=NewMHComPort('+AParent+');');
 717   SL.Add(Prefix+AName+'.BaudRate:='+BaudRate2Str[BaudRate]+';');
 718   SL.Add(Prefix+AName+'.Port:='''+Port+''';');
 719   SL.Add(Prefix+AName+'.DiscardNull:='+Boolean2Str[DiscardNull]+';');
 720   SL.Add(Prefix+AName+'.CustomBaudRate:='+Int2Str(CustomBaudRate)+';');
 721   SL.Add(Prefix+AName+'.StopBits:='+StopBits2Str[StopBits]+';');
 722   SL.Add(Prefix+AName+'.DataBits:='+DataBits2Str[DataBits]+';');
 723   SL.Add(Prefix+AName+'.EventChar:=#'+Int2Str(Ord(EventChar))+';');
 724   SL.Add(Prefix+AName+'.SyncMethod:='+SyncMethod2Str[SyncMethod]+';');
 725   tmpStr:='   ';
 726   if evRxChar in Events then
 727     tmpStr:=tmpStr+'evRxChar, ';
 728   if evTxEmpty in Events then
 729     tmpStr:=tmpStr+'evTxEmpty, ';
 730   if evRxFlag in Events then
 731     tmpStr:=tmpStr+'evRxFlag, ';
 732   if evRing in Events then
 733     tmpStr:=tmpStr+'evRing, ';
 734   if evBreak in Events then
 735     tmpStr:=tmpStr+'evBreak, ';
 736   if evCTS in Events then
 737     tmpStr:=tmpStr+'evCTS, ';
 738   if evDSR in Events then
 739     tmpStr:=tmpStr+'evDSR, ';
 740   if evError in Events then
 741     tmpStr:=tmpStr+'evError, ';
 742   if evRLSD in Events then
 743     tmpStr:=tmpStr+'evRLSD, ';
 744   if evRx80Full in Events then
 745     tmpStr:=tmpStr+'evRx80Full, ';
 746   tmpStr[Length(tmpStr)-1]:=' ';
 747   tmpStr:=Trim(tmpStr);
 748   SL.Add(Prefix+AName+'.Events:=[ '+tmpStr+' ];');
 749   // All Parity
 750   SL.Add(Prefix+AName+'.Parity.Bits:='+ParityBits2Str[Parity.Bits]+';');
 751   SL.Add(Prefix+AName+'.Parity.Check:='+Boolean2Str[Parity.Check]+';');
 752   SL.Add(Prefix+AName+'.Parity.Replace:='+Boolean2Str[Parity.Replace]+';');
 753   SL.Add(Prefix+AName+'.Parity.ReplaceChar:=#'+Int2Str(Ord(Parity.ReplaceChar))+';');
 754   // All Buffer
 755   SL.Add(Prefix+AName+'.Buffer.InputSize:='+Int2Str(Buffer.InputSize)+';');
 756   SL.Add(Prefix+AName+'.Buffer.OutputSize:='+Int2Str(Buffer.OutputSize)+';');
 757   // All Flow Control
 758   SL.Add(Prefix+AName+'.FlowControl.ControlDTR:='+ControlDTR2Str[FlowControl.ControlDTR]+';');
 759   SL.Add(Prefix+AName+'.FlowControl.ControlRTS:='+ControlRTS2Str[FlowControl.ControlRTS]+';');
 760   SL.Add(Prefix+AName+'.FlowControl.DSRSensitivity:='+Boolean2Str[FlowControl.DSRSensitivity]+';');
 761   SL.Add(Prefix+AName+'.FlowControl.OutCTSFlow:='+Boolean2Str[FlowControl.OutCTSFlow]+';');
 762   SL.Add(Prefix+AName+'.FlowControl.OutDSRFlow:='+Boolean2Str[FlowControl.OutDSRFlow]+';');
 763   SL.Add(Prefix+AName+'.FlowControl.TxContinueOnXoff:='+Boolean2Str[FlowControl.TxContinueOnXoff]+';');
 764   SL.Add(Prefix+AName+'.FlowControl.XoffChar:=#'+Int2Str(Ord(FlowControl.XoffChar))+';');
 765   SL.Add(Prefix+AName+'.FlowControl.XonChar:=#'+Int2Str(Ord(FlowControl.XonChar))+';');
 766   SL.Add(Prefix+AName+'.FlowControl.XonXoffIn:='+Boolean2Str[FlowControl.XonXoffIn]+';');
 767   SL.Add(Prefix+AName+'.FlowControl.XonXoffOut:='+Boolean2Str[FlowControl.XonXoffOut]+';');
 768   // All TimeOuts
 769   SL.Add(Prefix+AName+'.Timeouts.ReadInterval:='+Int2Str(Timeouts.ReadInterval)+';');
 770   SL.Add(Prefix+AName+'.Timeouts.ReadTotalConstant:='+Int2Str(Timeouts.ReadTotalConstant)+';');
 771   SL.Add(Prefix+AName+'.Timeouts.ReadTotalMultiplier:='+Int2Str(Timeouts.ReadTotalMultiplier)+';');
 772   SL.Add(Prefix+AName+'.Timeouts.WriteTotalConstant:='+Int2Str(Timeouts.WriteTotalConstant)+';');
 773   SL.Add(Prefix+AName+'.Timeouts.WriteTotalMultiplier:='+Int2Str(Timeouts.WriteTotalMultiplier)+';');
 774 end;
 775
 776 procedure TKOLMHComPort.AssignEvents(SL: TStringList; const AName: String);
 777 begin
 778   inherited;
 779   DoAssignEvents( SL, AName, [ 'OnRxChar', 'OnRxBuf', 'OnAfterOpen' ,
 780   'OnAfterClose', 'OnBeforeOpen', 'OnBeforeClose', 'OnTxEmpty', 'OnBreak',
 781   'OnRing', 'OnCTSChange', 'OnDSRChange', 'OnRLSDChange', 'OnRxFlag',
 782   'OnError', 'OnRx80Full'], [ @OnRxChar,@OnRxBuf, @OnAfterOpen , @OnAfterClose,
 783   @OnBeforeOpen, @OnBeforeClose, @OnTxEmpty, @OnBreak, @OnRing, @OnCTSChange,
 784   @OnDSRChange, @OnRLSDChange, @OnRxFlag, @OnError, @OnRx80Full] );
 785 end;
 786
 787 // set baud rate
 788 procedure TKOLMHComPort.SetBaudRate(const Value: TBaudRate);
 789 begin
 790   if Value <> FBaudRate then
 791   begin
 792     FBaudRate := Value;
 793     // if possible, apply settings
 794     Change;
 795 //    ApplyDCB;
 796   end;
 797 end;
 798
 799 // set custom baud rate
 800 procedure TKOLMHComPort.SetCustomBaudRate(const Value: Integer);
 801 begin
 802   if Value <> FCustomBaudRate then
 803   begin
 804     FCustomBaudRate := Value;
 805     Change;
 806 //    ApplyDCB;
 807   end;
 808 end;
 809
 810 // set data bits
 811 procedure TKOLMHComPort.SetDataBits(const Value: TDataBits);
 812 begin
 813   if Value <> FDataBits then
 814   begin
 815     FDataBits := Value;
 816     Change;
 817 //    ApplyDCB;
 818   end;
 819 end;
 820
 821 // set discard null charachters
 822 procedure TKOLMHComPort.SetDiscardNull(const Value: Boolean);
 823 begin
 824   if Value <> FDiscardNull then
 825   begin
 826     FDiscardNull := Value;
 827     Change;
 828 //    ApplyDCB;
 829   end;
 830 end;
 831
 832 // set event charachters
 833 procedure TKOLMHComPort.SetEventChar(const Value: Char);
 834 begin
 835   if Value <> FEventChar then
 836   begin
 837     FEventChar := Value;
 838     Change;
 839 //    ApplyDCB;
 840   end;
 841 end;
 842
 843 // translated numeric string to port string
 844 function ComString(Str: string): TPort;
 845 var
 846   Num: Integer;
 847 begin
 848   if UpperCase(Copy(Str, 1, 3)) = 'COM' then
 849     Str := Copy(Str, 4, Length(Str) - 3);
 850   try
 851     Num := Str2Int(Str);
 852   except
 853     Num := 1;
 854   end;
 855   if (Num < 1) or (Num > 16) then
 856     Num := 1;
 857   Result := Format('COM%d', [Num]);
 858 end;
 859
 860 // set port
 861 procedure TKOLMHComPort.SetPort(const Value: TPort);
 862 var
 863   Str: string;
 864 begin
 865   Str := ComString(Value);
 866   if Str <> FPort then
 867   begin
 868     FPort := Str;
 869     Change;
 870 {    if (FConnected) and (not ((csDesigning in ComponentState) or
 871       (csLoading in ComponentState))) then
 872     begin
 873       Close;
 874       Open;
 875     end;}
 876   end;
 877 end;
 878
 879 // set stop bits
 880 procedure TKOLMHComPort.SetStopBits(const Value: TStopBits);
 881 begin
 882   if Value <> FStopBits then
 883   begin
 884     FStopBits := Value;
 885     Change;
 886 //    ApplyDCB;
 887   end;
 888 end;
 889
 890 // set event synchronization method
 891 procedure TKOLMHComPort.SetSyncMethod(const Value: TSyncMethod);
 892 begin
 893   if Value <> FSyncMethod then
 894   begin
 895 {    if (FConnected) and (not ((csDesigning in ComponentState) or
 896       (csLoading in ComponentState)))
 897     then
 898       raise EComPort.CreateNoWinCode(CError_SyncMeth)
 899     else}
 900       FSyncMethod := Value;
 901       Change;
 902   end;
 903 end;
 904
 905 // returns true if RxChar is triggered when data arrives input buffer
 906 {function TKOLMHComPort.GetTriggersOnRxChar: Boolean;
 907 var
 908   I: Integer;
 909   ComLink: TComLink;
 910 begin
 911   Result := True;
 912   // examine links
 913   if FLinks.Count > 0 then
 914     for I := 0 to FLinks.Count - 1 do
 915     begin
 916       ComLink := TComLink(FLinks[I]);
 917       if Assigned(ComLink.OnRxBuf) then
 918         Result := False; // link found, do not call OnRxChar event, call OnRxBuf instead
 919     end;
 920 end;
 921  }
 922 // set flow control
 923 procedure TKOLMHComPort.SetFlowControl(const Value: TComFlowControl);
 924 begin
 925   FFlowControl.Assign(Value);
 926   Change;
 927 //  ApplyDCB;
 928 end;
 929
 930 // set parity
 931 procedure TKOLMHComPort.SetParity(const Value: TComParity);
 932 begin
 933   FParity.Assign(Value);
 934   Change;
 935 //  ApplyDCB;
 936 end;
 937
 938 // set timeouts
 939 procedure TKOLMHComPort.SetTimeouts(const Value: TComTimeouts);
 940 begin
 941   FTimeouts.Assign(Value);
 942   Change;
 943 //  ApplyTimeouts;
 944 end;
 945
 946 // set buffer
 947 procedure TKOLMHComPort.SetBuffer(const Value: TComBuffer);
 948 begin
 949   FBuffer.Assign(Value);
 950   Change;
 951 //  ApplyBuffer;
 952 end;
 953
 954 procedure TKOLMHComPort.SetOnRxChar(const Value:TRxCharEvent);
 955 begin
 956   FOnRxChar:=Value;
 957   Change;
 958 end;
 959
 960 procedure Register;
 961 begin
 962   RegisterComponents('KOL', [TKOLMHComPort]);
 963 end;
 964
 965 end.
 966