frm_main.pas

MODBUS-TCP控件

{===============================================================================

The contents of this file are subject to the Mozilla Public License Version 1.1
(the "License"); you may not use this file except in compliance with the
License. You may obtain a copy of the License at http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above. If you wish to
allow use of your version of this file only under the terms of the GPL and not
to allow others to use your version of this file under the MPL, indicate your
decision by deleting the provisions above and replace them with the notice and
other provisions required by the GPL. If you do not delete the provisions
above, a recipient may use your version of this file under either the MPL or
the GPL.

$Id: frm_Main.pas,v 1.1 2004/01/05 08:45:47 plpolak Exp $

===============================================================================}

unit frm_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, IdModBusServer, Grids, ExtCtrls,
  StdCtrls, Buttons;

type
  TfrmMain = class(TForm)
    msrPLC: TIdModBusServer;
    pnlInput: TPanel;
    btnStart: TBitBtn;
    Label1: TLabel;
    edtFirstReg: TEdit;
    edtLastReg: TEdit;
    Label2: TLabel;
    pnlMain: TPanel;
    sgdRegisters: TStringGrid;
    mmoErrorLog: TMemo;
    Splitter1: TSplitter;
    procedure msrPLCReadRegisters(const Sender: TIdPeerThread; const RegNr,
      Count: Integer; var Data: TModRegisterData);
    procedure msrPLCWriteRegisters(const Sender: TIdPeerThread;
      const RegNr, Count: Integer; const Data: TModRegisterData);
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FFirstReg: Integer;
    FLastReg: Integer;
    procedure ClearRegisters;
    procedure FillRegisters;
    procedure SetRegisterValue(const RegNo: Integer; const Value: Word);
    function GetRegisterValue(const RegNo: Integer): Word;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function IntToBinary(const Value: Int64; const ALength: Integer): String;
var
  iWork: Int64;
begin
  Result := '';
  iWork := Value;
  while (iWork > 0) do
  begin
    Result := IntToStr(iWork mod 2) + Result;
    iWork := iWork div 2;
  end;
  while (Length(Result) < ALength) do
    Result := '0' + Result;
end; { IntToBinary }


procedure TfrmMain.msrPLCReadRegisters(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; var Data: TModRegisterData);
var
  i: Integer;
begin
  for i := 0 to (Count - 1) do
    Data[i] := GetRegisterValue(RegNr + i);
end; { msrPLCReadRegisters }


procedure TfrmMain.msrPLCWriteRegisters(const Sender: TIdPeerThread;
  const RegNr, Count: Integer; const Data: TModRegisterData);
var
  i: Integer;
begin
  for i := 0 to (Count - 1) do
    SetRegisterValue(RegNr + i, Data[i]);
end; { msrPLCWriteRegisters }


procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  if msrPLC.Active then
  begin
    msrPLC.Active := False;
    edtFirstReg.Enabled := True;
    edtLastReg.Enabled := True;
    btnStart.Caption := '&Start';
    ClearRegisters;
  end
  else
  begin
    FFirstReg := StrToInt(edtFirstReg.Text);
    FLastReg := StrToInt(edtLastReg.Text);
    btnStart.Caption := '&Stop';
    msrPLC.Active := True;
    FillRegisters; 
  end;
end; { btnStartClick }


procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FFirstReg := 0;
  FLastReg := 0;
{ Set grid headers titles }
  sgdRegisters.Cells[0, 0] := 'RegNo';
  sgdRegisters.Cells[1, 0] := 'Decimal';
  sgdRegisters.Cells[2, 0] := 'Hex.';
  sgdRegisters.Cells[3, 0] := 'Binary';
{ Set the column width }
  sgdRegisters.ColWidths[3] := 120;
end; { FormCreate }


procedure TfrmMain.ClearRegisters;
var
  i: Integer;
begin
  sgdRegisters.RowCount := 2;
  for i := 0 to (sgdRegisters.ColCount - 1) do
    sgdRegisters.Cells[i, 1] := '';
end; { ClearRegisters }


procedure TfrmMain.FillRegisters;
var
  i: Integer;
begin
  ClearRegisters;
  if (FLastReg >= FFirstReg) then
  begin
    sgdRegisters.RowCount := (FLastReg - FFirstReg) + 2;
    for i := FFirstReg to FLastReg do
    begin
      sgdRegisters.Cells[0, i - FFirstReg + 1] := IntToStr(i);
      SetRegisterValue(i, 0);
    end;
  end;
end; { FillRegisters }


procedure TfrmMain.SetRegisterValue(const RegNo: Integer; const Value: Word);
begin
  if (RegNo >= FFirstReg) and (RegNo <= FLastReg) then
  begin
    sgdRegisters.Cells[1, RegNo - FFirstReg + 1] := IntToStr(Value);
    sgdRegisters.Cells[2, RegNo - FFirstReg + 1] := IntToHex(Value, 4);
    sgdRegisters.Cells[3, RegNo - FFirstReg + 1] := IntToBinary(Value, 16);
  end;
end; { SetRegisterValue }


function TfrmMain.GetRegisterValue(const RegNo: Integer): Word;
begin
  if (RegNo >= FFirstReg) and (RegNo <= FLastReg) then
    Result := StrToInt(sgdRegisters.Cells[1, RegNo - FFirstReg + 1])
  else
    Result := 0;
end; { GetRegisterValue }


end.