modlinkdemomain.pas

ModLink VCL component 组件以及代码。版本是shareware edition of ModLink 2.10

  begin
    ID := ModbusClient1.WriteSingleRegister(RegAddr, RegValue);
    LogInit(ID, 'Write Single Register (code $06)');
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.WriteMultipleRegistersButtonClick(Sender: TObject);
var
  S: string;
  StartReg: Word;
  RegValues: TRegValues;
  RegIndex, I: Integer;
  ID: Cardinal;
begin
  with RegisterListView.Items[0] do
  begin
    S := SubItems[0];
    System.Delete(S, 1, Length('Register '));
    StartReg := Word(StrToInt(S));
  end;

  SetLength(RegValues, RegisterListView.Items.Count);

  try
    RegIndex := 0;
    for I := 0 to RegisterListView.Items.Count - 1 do
    begin
      S := RegisterListView.Items[I].Caption;
      RegValues[RegIndex] := Word(StrToInt(S));
      Inc(RegIndex);
    end;

    if RegisterBroadcastCheckBox.Checked then
    begin
      ID := ModbusConnection1.WriteMultipleRegisters(StartReg, RegValues);
      LogInit(ID, 'Write Multiple Registers (code $10)');
      LogBroadcast;
    end
    else
    begin
      ID := ModbusClient1.WriteMultipleRegisters(StartReg, RegValues);
      LogInit(ID, 'Write Multiple Registers (code $10)');
    end;
  finally
    Finalize(RegValues);
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.RegisterListViewKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  with Sender as TListView do
    if (Key = VK_RETURN) and (not IsEditing) and (Selected <> nil) then
    begin
      Selected.EditCaption;
      Key := 0;
    end;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.RegisterListViewDblClick(Sender: TObject);
var
  P: TPoint;
  Item: TListItem;
begin
  P := Mouse.CursorPos;
  with Sender as TListView do
  begin
    P := ScreenToClient(P);
    Item := GetItemAt(P.X, P.Y);
    if Assigned(Item) then Item.EditCaption;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusClient1HoldingRegistersRead(
  Sender: TModbusClient; const Info: TTransactionInfo; StartReg,
  RegCount: Word; const RegValues: TRegValues);
var
  I: Integer;
begin
  LogDone(Info.ID, 'Read Holding Registers (code $03)');
  LogStatus(Info);
  if Info.Reply = srNormalReply then
  begin
    LogProcessedRegs(RegCount, True);
    for I := 0 to RegCount - 1 do
      LogSingleRegister(StartReg + I, RegValues[I], True);
  end;
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusClient1InputRegistersRead(
  Sender: TModbusClient; const Info: TTransactionInfo; StartReg,
  RegCount: Word; const RegValues: TRegValues);
var
  I: Integer;
begin
  LogDone(Info.ID, 'Read Input Registers (code $04)');
  LogStatus(Info);
  if Info.Reply = srNormalReply then
  begin
    LogProcessedRegs(RegCount, False);
    for I := 0 to RegCount - 1 do
      LogSingleRegister(StartReg + I, RegValues[I], False);
  end;
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusClient1SingleRegisterWrite(
  Sender: TModbusClient; const Info: TTransactionInfo; RegAddr,
  RegValue: Word);
begin
  LogDone(Info.ID, 'Write Single Register (code $06)');
  LogStatus(Info);
  if Info.Reply = srNormalReply then
  begin
    LogProcessedRegs(1, True);
    LogSingleRegister(RegAddr, RegValue, True);
  end;
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusClient1MultipleRegistersWrite(
  Sender: TModbusClient; const Info: TTransactionInfo; StartReg,
  RegCount: Word; const RegValues: TRegValues);
var
  I: Integer;
begin
  LogDone(Info.ID, 'Write Multiple Registers (code $10)');
  LogStatus(Info);
  if Info.Reply = srNormalReply then
  begin
    LogProcessedRegs(RegCount, True);
    for I := 0 to RegCount - 1 do
      LogSingleRegister(StartReg + I, RegValues[I], True);
  end;
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.MaskWriteSingleRegisterButtonClick(Sender: TObject);
var
  RegAddr, AndMask, OrMask: Word;
  ID: Cardinal;
begin
  ValidateRegisterMaskWriteGroupBox;
  RegAddr := Word(StrToInt(MaskWriteRegAddrEdit.Text));
  AndMask := Word(StrToInt(AndMaskEdit.Text));
  OrMask := Word(StrToInt(OrMaskEdit.Text));
  ID := ModbusClient1.MaskWriteSingleRegister(RegAddr, AndMask, OrMask);
  LogInit(ID, 'Mask Write Register (code $16)');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusClient1SingleRegisterMaskWrite(
  Sender: TModbusClient; const Info: TTransactionInfo; RegAddr, AndMask,
  OrMask: Word);
begin
  LogDone(Info.ID, 'Mask Write Register (code $16)');
  LogStatus(Info);
  if Info.Reply = srNormalReply then
  begin
    LogProcessedRegs(1, True);
    LogString(Format('Register: %d | AND mask: %d | OR mask: %d',
      [RegAddr, AndMask, OrMask]));
  end;
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.DiagnosticsButtonClick(Sender: TObject);
var
  Action: TDiagnosticAction;
  ID: Cardinal;
begin
  Action := TDiagnosticAction(DiagnosticActionRadioGroup.ItemIndex);
  ID := ModbusClient1.Diagnostics(Action);
  LogInit(ID, 'Diagnostics (code $08)');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusClient1Diagnostics(Sender: TModbusClient;
  const Info: TTransactionInfo; Action: TDiagnosticAction; Result: Word);
begin
  LogDone(Info.ID, 'Diagnostics (code $08)');
  LogStatus(Info);
  if Info.Reply = srNormalReply then
  begin
    case Action of
      daReturnQueryData:
        LogString('"Return Query Data" action was performed by the server. It appears to be responding.');
      daRestartCommsOption:
        LogString('"Restart Comms Option" action was performed by the server.');
      daRestartCommsOptionAndClearEventLog:
        LogString('"Restart Comms Option And Clear Event Log" action was performed by the server.');
      daReturnDiagnosticRegister:
        LogString(Format('"Return Diagnostic Register" action returned the value %d.', [Result]));
      daForceListenOnlyMode:
        LogString('"Force Listen Only Mode" action was performed by the server. It should never go here.');
      daClearCountersAndDiagnosticRegister:
        LogString('"Clear Counters And Diagnostic Register" action was performed by the server.');
      daReturnBusMessageCount:
        LogString(Format('"Return Bus Message Count" action returned the value %d.', [Result]));
      daReturnBusCommErrorCount:
        LogString(Format('"Return Bus Comm Error Count" action returned the value %d.', [Result]));
      daReturnBusExceptionErrorCount:
        LogString(Format('"Return Bus Exception Error Count" action returned the value %d.', [Result]));
      daReturnServerMessageCount:
        LogString(Format('"Return Server Message Count" action returned the value %d.', [Result]));
      daReturnServerNoReplyCount:
        LogString(Format('"Return Server No Reply Count" action returned the value %d.', [Result]));
      daReturnServerNegativeAcknowledgeCount:
        LogString(Format('"Return Server Negative Acknowledge Count" action returned the value %d.', [Result]));
      daReturnServerBusyCount:
        LogString(Format('"Return Server Busy Count" action returned the value %d.', [Result]));
      daReturnBusCharacterOverrunCount:
        LogString(Format('"Return Bus Character Overrun Count" action returned the value %d.', [Result]));
      daClearOverrunCounterAndFlag:
        LogString('"Clear Overrun Counter And Flag" action was performed by the server.');
    end;
  end;
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ToolsClearTransactionLogItemClick(Sender: TObject);
begin
  ClearTransactionLog;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.WriteStartBitEditExit(Sender: TObject);
begin
  UpdateDiscreteListView;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.WriteBitCountEditExit(Sender: TObject);
begin
  UpdateDiscreteListView;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.WriteStartRegEditExit(Sender: TObject);
begin
  UpdateRegisterListView;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.WriteRegCountEditExit(
  Sender: TObject);
begin
  UpdateRegisterListView;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.RegisterListViewEdited(Sender: TObject;
  Item: TListItem; var S: String);
begin
  try
    S := IntToStr(Word(StrToInt(S)));
  except
    on E: EConvertError do
    begin
      S := Item.Caption;
      E.Message := Format('You''ve entered an invalid value for ''%s''', [Item.SubItems[0]]);
      raise;
    end;
  else
    raise;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusConnection1BeforeOpen(
  Sender: TObject);
begin
  LogString(Format('Opening Modbus connection on %s...', [ModbusConnection1.Port]));
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusConnection1AfterOpen(
  Sender: TObject);
begin
  LogString('Modbus connection has been successfully opened.'#13#10);
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusConnection1BeforeClose(
  Sender: TObject);
begin
  if not (csDestroying in ComponentState) then
    LogString('Closing Modbus connection...');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ModbusConnection1AfterClose(
  Sender: TObject);
begin
  if not (csDestroying in ComponentState) then
    LogString('Modbus Connection has been closed.'#13#10);
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.Timer1Timer(Sender: TObject);
var
  PendingCount: Integer;
begin
  if ModbusConnection1.ConnectionMode = cmClient then
  begin
    PendingCount := ModbusConnection1.CountPendingTransactions;
    with StatusBar1.Panels[2] do
      if PendingCount > 1 then
        Text := Format('There are %d pending transactions.', [PendingCount])
      else if PendingCount = 1 then
        Text := 'There is 1 pending transaction.'
      else
        Text := 'Transaction queue is empty.';
  end
  else
    StatusBar1.Panels[2].Text := '';
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ToolsDiscardPendingTransactionsItemClick(
  Sender: TObject);
begin
  ModbusConnection1.DiscardPendingTransactions;
  LogString('');
  LogString('*** All pending transactions have been discarded.');
  LogString('');
end;

//--------------------------------------------------------------------------------------------------

procedure TModLinkDemoMainForm.ToolsServerOptionsItemClick(Sender: TObject);
const
  SCaptionFmt = 'Modbus Server Options';
  SPrompt = 'Enter the address of a local server ' +
    '(acceptable values are 1 through 247):';
var
  S: string;
  NewAddress: Byt