unit MainFrm; // #ToDo1 -oMvR: 2-9-2017: device change notification -> refresh COM port list // #ToDo1 -oMvR: 2-9-2017: visualize fan power // #ToDo1 -oMvR: 10-9-2017: save settings interface uses System.Classes, System.SysUtils, Vcl.Controls, Vcl.ExtCtrls, Vcl.Forms, Vcl.StdCtrls, CPort, Simulator.Registry, Vcl.Buttons; type TMainForm = class(TForm, ISimulatorFans) PortComboBox: TComboBox; HardwareGroupBox: TGroupBox; PortLabel: TLabel; PortStatusLabel: TLabel; ConnectTimer: TTimer; FansLabel: TLabel; SimulatorGroupBox: TGroupBox; ResponseTimer: TTimer; FanCountLabel: TLabel; CalibrationButton: TButton; SimulatorComboBox: TComboBox; SimulatorPanel: TPanel; SimulatorSelectionPanel: TPanel; SimulatorLockButton: TSpeedButton; ConnectWaitTimer: TTimer; procedure FormCreate(Sender: TObject); procedure PortComboBoxClick(Sender: TObject); procedure ConnectTimerTimer(Sender: TObject); procedure ResponseTimerTimer(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure CalibrationButtonClick(Sender: TObject); procedure SimulatorComboBoxClick(Sender: TObject); procedure SimulatorLockButtonClick(Sender: TObject); procedure ConnectWaitTimerTimer(Sender: TObject); private FComPort: TComPort; FReceived: string; FOnResponse: TProc; FOnTimeout: TProc; FReady: Boolean; FFanValues: array of Byte; FSimulator: ISimulator; procedure LoadSimulators; procedure RefreshPorts; procedure InitDevice(const AInfo: string); procedure TryConnect; procedure SendCommand(const ACommand: string; AOnResponse: TProc; AOnTimeout: TProc = nil); procedure StartCommand; procedure EndCommand; procedure OnReceiveChar(Sender: TObject; Count: Integer); procedure OnAfterClose(Sender: TObject); function ValidFanIndex(AFan: Byte): Boolean; inline; procedure SelectSimulator; property ComPort: TComPort read FComPort; property Ready: Boolean read FReady; property Simulator: ISimulator read FSimulator; public { ISimulatorFans } function GetFanCount: Integer; function GetReady: Boolean; function GetIsRunning: Boolean; function GetValue(const AFan: Byte): Byte; function GetMaxValue: Byte; procedure SetValue(const AFan, AValue: Byte); procedure SetAll(const AValue: Byte); procedure SetFull; end; implementation uses System.Math, System.StrUtils, Vcl.Dialogs, ESCCalibrationFrm; {$R *.dfm} { TMainForm } procedure TMainForm.FormCreate(Sender: TObject); begin LoadSimulators; RefreshPorts; end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin if Ready then begin FReady := False; SendCommand('>SetFans:0', procedure(Response: string) begin Close; end); Action := caNone; end; end; procedure TMainForm.PortComboBoxClick(Sender: TObject); begin TryConnect; end; procedure TMainForm.SimulatorComboBoxClick(Sender: TObject); begin SelectSimulator; end; procedure TMainForm.SimulatorLockButtonClick(Sender: TObject); begin SimulatorComboBox.Enabled := not SimulatorLockButton.Down; end; procedure TMainForm.CalibrationButtonClick(Sender: TObject); begin if Assigned(Simulator) then Simulator.Stop; TESCCalibrationForm.Execute(Self); if Assigned(Simulator) then Simulator.Start; end; procedure TMainForm.LoadSimulators; var simulator: TRegisteredSimulator; begin SimulatorComboBox.Items.BeginUpdate; try SimulatorComboBox.Items.Clear; for simulator in GetRegisteredSimulators do SimulatorComboBox.Items.AddObject(simulator.Name, simulator); SimulatorComboBox.ItemIndex := 0; finally SimulatorComboBox.Items.EndUpdate; end; SelectSimulator; end; procedure TMainForm.RefreshPorts; var currentPort: string; begin currentPort := ''; if PortComboBox.ItemIndex > -1 then currentPort := PortComboBox.Items[PortComboBox.ItemIndex]; EnumComPorts(PortComboBox.Items); if Length(currentPort) > 0 then PortComboBox.ItemIndex := PortComboBox.Items.IndexOf(currentPort); TryConnect; end; procedure TMainForm.InitDevice(const AInfo: string); var info: TStringList; value: string; fanCount: Integer; begin info := TStringList.Create; try for value in SplitString(AInfo, ',') do info.Add(value); if TryStrToInt(info.Values['Fans'], fanCount) then begin SetLength(FFanValues, fanCount); FanCountLabel.Caption := IntToStr(fanCount); end else SetLength(FFanValues, 0); CalibrationButton.Enabled := info.Values['Mode'] = 'Servo'; finally FreeAndNil(info) end; end; procedure TMainForm.SendCommand(const ACommand: string; AOnResponse: TProc; AOnTimeout: TProc); begin if (not Assigned(ComPort)) or (not ComPort.Connected) then exit; StartCommand; FOnResponse := AOnResponse; FOnTimeout := AOnTimeout; try ComPort.WriteStr(ACommand + #10); except on E:Exception do PortStatusLabel.Caption := 'Failed to send command'; end; end; function TMainForm.GetFanCount: Integer; begin Result := Length(FFanValues); end; function TMainForm.GetReady: Boolean; begin Result := FReady; end; function TMainForm.GetIsRunning: Boolean; begin Result := Ready and (GetMaxValue > 0); end; function TMainForm.GetValue(const AFan: Byte): Byte; begin if ValidFanIndex(AFan) then Result := FFanValues[AFan] else Result := 0; end; function TMainForm.GetMaxValue: Byte; var value: Byte; begin Result := 0; for value in FFanValues do if value > Result then Result := value; end; procedure TMainForm.SetValue(const AFan, AValue: Byte); var values: TStringBuilder; value: Byte; begin if not Ready then exit; if ValidFanIndex(AFan) and (FFanValues[AFan] <> AValue) then begin FFanValues[AFan] := AValue; values := TStringBuilder.Create; try for value in FFanValues do begin if values.Length > 0 then values.Append(','); values.Append(value); end; SendCommand('>SetFans:' + values.ToString, nil); finally FreeAndNil(values); end; end; end; procedure TMainForm.SetAll(const AValue: Byte); var fanIndex: Integer; changed: Boolean; begin if not Ready then exit; changed := False; for fanIndex := 0 to High(FFanValues) do begin if FFanValues[fanIndex] <> AValue then begin FFanValues[fanIndex] := AValue; changed := True; end; end; if changed then SendCommand('>SetFans:A,' + IntToStr(AValue), nil); end; procedure TMainForm.SetFull; var fanIndex: Integer; begin if not Ready then exit; for fanIndex := 0 to High(FFanValues) do FFanValues[fanIndex] := 255; SendCommand('>SetFans:M', nil); end; procedure TMainForm.TryConnect; var newPort: string; begin if PortComboBox.ItemIndex = -1 then exit; ConnectTimer.Enabled := False; FReady := False; CalibrationButton.Enabled := False; PortStatusLabel.Caption := 'Attempting to connect'; PortStatusLabel.Update; if not Assigned(FComPort) then begin FComPort := TComPort.Create(Self); FComPort.BaudRate := br19200; FComPort.OnRxChar := OnReceiveChar; FComPort.OnAfterClose := OnAfterClose; end; newPort := PortComboBox.Items[PortComboBox.ItemIndex]; if ComPort.Connected and (newPort <> ComPort.Port) then ComPort.Close; ComPort.Port := newPort; try ComPort.Open; { The Arduino resets when a serial connection is made, wait for a bit before sending the first Info command } ConnectWaitTimer.Enabled := True; except on E:Exception do begin PortStatusLabel.Caption := 'Failed to connect'; ConnectTimer.Enabled := True; end; end; end; procedure TMainForm.ConnectWaitTimerTimer(Sender: TObject); begin ConnectWaitTimer.Enabled := False; SendCommand(#10'>Info', procedure(Response: string) begin if AnsiStartsText(' 0 then begin // Since the protocol is quite synchronous, this is good enough for now SetLength(FReceived, terminatorPos - 1); if Assigned(FOnResponse) then FOnResponse(FReceived); EndCommand; end; end; procedure TMainForm.OnAfterClose(Sender: TObject); begin PortStatusLabel.Caption := 'Not connected'; ConnectTimer.Enabled := True; end; function TMainForm.ValidFanIndex(AFan: Byte): Boolean; begin Result := AFan < Length(FFanValues); end; procedure TMainForm.SelectSimulator; var registeredSimulator: TRegisteredSimulator; begin if Assigned(FSimulator) then begin FSimulator.Stop; FSimulator := nil; end; if SimulatorComboBox.ItemIndex = -1 then exit; registeredSimulator := (SimulatorComboBox.Items.Objects[SimulatorComboBox.ItemIndex] as TRegisteredSimulator); FSimulator := registeredSimulator.ConstructorFunc(Self); Simulator.SetUIParent(SimulatorPanel); Simulator.Start; end; procedure TMainForm.ConnectTimerTimer(Sender: TObject); begin TryConnect; end; procedure TMainForm.ResponseTimerTimer(Sender: TObject); begin if Assigned(FOnTimeout) then FOnTimeout; EndCommand; end; procedure TMainForm.StartCommand; begin FReceived := ''; ResponseTimer.Enabled := True; end; procedure TMainForm.EndCommand; begin FReceived := ''; FOnResponse := nil; FOnTimeout := nil; ResponseTimer.Enabled := False; end; end.