unit CAN_Terminal; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, UNiiefa, ToolsCan, RXSwitch, ComCtrls, Buttons, OoMisc, AdPort, Mask, RXSpin, RXCtrls; type TCANTerminal = class(TForm) ProjectBox: TComboBox; GroupBox: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; Label10: TLabel; CanTimer: TTimer; Memo1: TMemo; CANswitch: TRxSwitch; GroupBox1: TGroupBox; CBLockRS: TCheckBox; RxLabel2: TRxLabel; RCom: TRxSpinEdit; RGBaud: TRadioGroup; MyCommPort: TApdComPort; RxLabel6: TRxLabel; TimeWait: TRxSpinEdit; AbortKey: TSpeedButton; PBRs: TProgressBar; Memo2: TMemo; RadioGroup1: TRadioGroup; Button125: TRadioButton; Button250: TRadioButton; RxLabel1: TRxLabel; procedure FormCreate(Sender: TObject); procedure LoadProjectAdres(ProjID: string); procedure ShowProjectAdres(); procedure ShoWinClick(Sender: TObject); procedure CanTimerTimer(Sender: TObject); procedure CANswitchClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure RGBaudClick(Sender: TObject); procedure RComChange(Sender: TObject); procedure CBLockRSClick(Sender: TObject); procedure Memo2Change(Sender: TObject); procedure ProjectBoxChange(Sender: TObject); private { Private declarations } public { Public declarations } end; TBar = record RSadr: TPanel; RXadr: TPanel; TXadr: TPanel; Name: TPanel; Go: TButton; end; TUKSS = record Bar: TBar; RSadr: cardinal; RXadr: longword; TXadr: longword; Use: boolean; Exist: boolean; Name: string; Wind: TModbusForm; end; TBars = record BaseAdr: TPanel; CommAdr: TPanel; Name: TPanel; end; TProject = record Bars: TBars; BaseAdr: longword; PlusAdr: integer; CommAdr: longword; UKSS: array[0..15] of TUKSS; Name: string; DigiButNames: array[0..16] of string; DigiButNameChange: boolean; Protokol: integer; end; Tbox = record adr: longword; qua: cardinal; end; Tboxx = record box : array[1..100] of Tbox; // edit boxlen! qua: cardinal; end; var CANTerminal: TCANTerminal; Project : TProject; PathExe : String; ProjectQua : integer = 0; ProjectNum : integer = 0; Boxx : Tboxx; const boxlen = 100; implementation {$R *.dfm} procedure TCANTerminal.FormCreate(Sender: TObject); var i: integer; inifile : TIniFile; nom,num: string; wid,hei,tab,lef,top,lev : integer; begin InitSlavnaDll(); Project.Bars.Name := TPanel.Create(self); Project.Bars.Name.Parent := GroupBox; Project.Bars.Name.Left :=10; Project.Bars.Name.Top :=15; Project.Bars.Name.Width :=100; Project.Bars.Name.Height := 30; Project.Bars.BaseAdr := TPanel.Create(self); Project.Bars.BaseAdr.Parent := GroupBox; Project.Bars.BaseAdr.Left :=10+100+10; Project.Bars.BaseAdr.Top :=15; Project.Bars.BaseAdr.Width :=100; Project.Bars.BaseAdr.Height := 30; Project.Bars.CommAdr := TPanel.Create(self); Project.Bars.CommAdr.Parent := GroupBox; Project.Bars.CommAdr.Left :=10+100+10+100+10; Project.Bars.CommAdr.Top :=15; Project.Bars.CommAdr.Width :=100; Project.Bars.CommAdr.Height := 30; tab:=5; Label1.Top := Project.Bars.Name.Top + Project.Bars.Name.Height + tab*3; Label2.Top := Label1.Top; Label3.Top := Label1.Top; Label4.Top := Label1.Top; Label5.Top := Label1.Top; Label6.Top := Label1.Top; Label7.Top := Label1.Top; Label8.Top := Label1.Top; Label9.Top := Label1.Top; Label10.Top := Label1.Top; for i:= 0 to 15 do begin hei := 25; top := Label1.Top + Label1.Height + tab + (hei+tab)*(i mod 8); lef := 10 + (i div 8)*(lev); wid := hei; Project.UKSS[i].Bar.RSadr := TPanel.Create(self); Project.UKSS[i].Bar.RSadr.Parent := GroupBox; Project.UKSS[i].Bar.RSadr.Width := wid; Project.UKSS[i].Bar.RSadr.Height := hei; Project.UKSS[i].Bar.RSadr.Left :=lef; Project.UKSS[i].Bar.RSadr.Top :=top; if i=0 then Label1.Left := lef; if i=8 then Label6.Left := lef; lef := lef + wid + tab; wid := 110; Project.UKSS[i].Bar.Name := TPanel.Create(self); Project.UKSS[i].Bar.Name.Parent := GroupBox; Project.UKSS[i].Bar.Name.Width :=wid; Project.UKSS[i].Bar.Name.Height := hei; Project.UKSS[i].Bar.Name.Left :=lef; Project.UKSS[i].Bar.Name.Top :=top; if i=0 then Label2.Left := lef; if i=8 then Label7.Left := lef; lef := lef + wid + tab; wid := 90; Project.UKSS[i].Bar.RXadr := TPanel.Create(self); Project.UKSS[i].Bar.RXadr.Parent := GroupBox; Project.UKSS[i].Bar.RXadr.Width :=wid; Project.UKSS[i].Bar.RXadr.Height := hei; Project.UKSS[i].Bar.RXadr.Left :=lef; Project.UKSS[i].Bar.RXadr.Top :=top; if i=0 then Label3.Left := lef; if i=8 then Label8.Left := lef; lef := lef + wid + tab; wid := 90; Project.UKSS[i].Bar.TXadr := TPanel.Create(self); Project.UKSS[i].Bar.TXadr.Parent := GroupBox; Project.UKSS[i].Bar.TXadr.Width :=wid; Project.UKSS[i].Bar.TXadr.Height := hei; Project.UKSS[i].Bar.TXadr.Left :=lef; Project.UKSS[i].Bar.TXadr.Top :=top; if i=0 then Label4.Left := lef; if i=8 then Label9.Left := lef; lef := lef + wid + tab; wid := hei; Project.UKSS[i].Bar.Go := TButton.Create(self); Project.UKSS[i].Bar.Go.Parent := GroupBox; Project.UKSS[i].Bar.Go.Width :=wid; Project.UKSS[i].Bar.Go.Height := hei; Project.UKSS[i].Bar.Go.Left :=lef; Project.UKSS[i].Bar.Go.Top :=top; Project.UKSS[i].Bar.Go.Caption :='S'; Project.UKSS[i].Bar.Go.Font.Style:=[fsBold]; Project.UKSS[i].Bar.Go.Tag := i; Project.UKSS[i].Bar.Go.OnClick := ShoWinClick; if i=0 then Label5.Left := lef; if i=8 then Label10.Left := lef; if i<8 then lev := lef + wid + tab*2; end; PathExe:=ExtractFileDir(ParamStr(0))+'\'; inifile := TIniFile.Create(PathExe+'Projects.ini'); ProjectQua := Inifile.ReadInteger('Projects','ProjectQua',0); ProjectNum := Inifile.ReadInteger('Projects','ProjectNum',0); for i:=1 to ProjectQua do begin Num := 'Project'+inttostr(i); Nom := Inifile.ReadString('Projects',Num,Num); ProjectBox.Items.add(Nom); end; inifile.Free; Project.Name := ProjectBox.Items[ProjectNum]; ProjectBox.ItemIndex := ProjectNum; ProjectBoxChange(Sender); end; procedure TCANTerminal.ShowProjectAdres(); var i: integer; begin Project.Bars.Name.Caption := Project.Name; Project.Bars.BaseAdr.Caption := '0x'+inttohex(Project.BaseAdr,8); if Project.CommAdr = 0 then Project.Bars.CommAdr.Caption := '' else Project.Bars.CommAdr.Caption := '0x'+inttohex(Project.CommAdr,8); for i:=0 to 15 do begin Project.UKSS[i].Bar.RXadr.Tag:=0; Project.UKSS[i].Bar.TXadr.Tag:=0; if Project.UKSS[i].Use then begin Project.UKSS[i].Bar.RSadr.Caption := inttostr(Project.UKSS[i].RSadr); Project.UKSS[i].Bar.RXadr.Caption := '0x' + inttohex(Project.UKSS[i].RXadr,8); Project.UKSS[i].Bar.TXadr.Caption := '0x' + inttohex(Project.UKSS[i].TXadr,8); Project.UKSS[i].Bar.Name.Caption := Project.UKSS[i].Name; Project.UKSS[i].Bar.Go.Caption := 'S'; Project.UKSS[i].Bar.Go.Enabled:=true; Project.UKSS[i].Bar.Name.Color:=clWindow; Project.UKSS[i].Bar.RSadr.Color:=clWindow; Project.UKSS[i].Bar.RXadr.Color := clWindow; Project.UKSS[i].Bar.TXadr.Color := clWindow; end else begin Project.UKSS[i].Bar.RSadr.Caption := ''; Project.UKSS[i].Bar.RXadr.Caption := ''; Project.UKSS[i].Bar.TXadr.Caption := ''; Project.UKSS[i].Bar.Name.Caption := ''; Project.UKSS[i].Bar.Go.Caption := ''; Project.UKSS[i].Bar.Go.Enabled:=false; Project.UKSS[i].Bar.Name.Color:=clBtnFace; Project.UKSS[i].Bar.RSadr.Color:=clBtnFace; Project.UKSS[i].Bar.RXadr.Color := clBtnFace; Project.UKSS[i].Bar.TXadr.Color := clBtnFace; end; end; end; procedure TCANTerminal.LoadProjectAdres(ProjID: string); var i,adr: integer; inifile : TIniFile; nom,nym: string; num: longword; left: integer; begin inifile := TIniFile.Create(PathExe+'Projects.ini'); Project.Protokol := Inifile.ReadInteger(ProjID,'Protokol',0); if Project.Protokol = 3 then begin Project.BaseAdr := 0; Project.PlusAdr := 1 shl 28; left:=24; end else begin Project.BaseAdr := Inifile.ReadInteger(ProjID,'BaseAdr',0); Project.PlusAdr := Inifile.ReadInteger(ProjID,'PlusAdr',16); left:=0; end; Project.CommAdr := Inifile.ReadInteger(ProjID,'CommAdr',0); adr:=-1; for i:=0 to 15 do begin nom := 'Use_'+inttostr(i); Project.UKSS[i].Use := inifile.ReadBool(ProjID,nom,false); if Project.UKSS[i].Use then begin nom := 'CANadr_'+inttostr(i); adr := inifile.ReadInteger(ProjID,nom,adr+1); nom := 'RSadr_'+inttostr(i); Project.UKSS[i].RSadr := inifile.ReadInteger(ProjID,nom,i); nom := 'TXadr_'+inttostr(i); num := Project.BaseAdr+Project.PlusAdr+(adr shl left); Project.UKSS[i].TXadr := inifile.ReadInteger(ProjID,nom,num); nom := 'RXadr_'+inttostr(i); num := Project.BaseAdr+(adr shl left); Project.UKSS[i].RXadr := inifile.ReadInteger(ProjID,nom,num); nom := 'Name_'+inttostr(i); nym := 'UKSS_'+inttostr(i); Project.UKSS[i].Name := inifile.ReadString(ProjID,nom,nym); end; end; inifile.Free; ShowProjectAdres(); end; procedure TCANTerminal.ShoWinClick(Sender: TObject); var Tagg : integer; begin Tagg:= (Sender as TButton).Tag; if not Project.UKSS[Tagg].Exist then begin Project.UKSS[Tagg].Wind := TModbusForm.Create(nil); Project.UKSS[Tagg].Wind.Caption := Project.Name+': '+Project.UKSS[Tagg].Name; Project.UKSS[Tagg].Wind.Numer:= Tagg; Project.UKSS[Tagg].Wind.RSadr:= Project.UKSS[Tagg].RSadr; Project.UKSS[Tagg].Wind.RXadr:= Project.UKSS[Tagg].RXadr; Project.UKSS[Tagg].Wind.TXadr:= Project.UKSS[Tagg].TXadr; Project.UKSS[Tagg].Wind.Protokol:= Project.Protokol; Project.UKSS[Tagg].Exist := true; end; Project.UKSS[Tagg].Wind.show; end; procedure TCANTerminal.CanTimerTimer(Sender: TObject); var i,j,pak, paks : integer; newstring: string; adr: longword; Mess: Tmessag; begin paks :=ReadMessageCanID(CanTimer.Interval); if paks > 0 then begin for pak := 0 to paks-1 do begin if Project.Protokol=3 then adr := ArrCanMessage[pak].m_dwID and $1F000000 else adr := ArrCanMessage[pak].m_dwID; if boxx.qua = 0 then begin boxx.qua := 1; boxx.box[1].qua := 1; boxx.box[1].adr := adr; end else begin i:=0; repeat i:=i+1 until (boxx.box[i].adr = adr) or (i > boxx.qua); if i <= boxx.qua then begin boxx.box[i].qua := boxx.box[i].qua + 1; if boxx.box[i].qua > 1000 then begin boxx.qua := 1; boxx.box[1].qua := 1; boxx.box[1].adr := adr; end else begin if i > 1 then begin if boxx.box[i].qua > boxx.box[i-1].qua then begin boxx.box[i].adr := boxx.box[i-1].adr; boxx.box[i-1].adr := adr; boxx.box[i-1].qua := boxx.box[i].qua; boxx.box[i].qua := boxx.box[i].qua-1; end end end end else begin if i > boxlen then begin boxx.qua := 1; boxx.box[1].qua := 1; boxx.box[1].adr := adr; end else begin boxx.qua := i; boxx.box[i].qua := 1; boxx.box[i].adr := adr; end end end; for i:=0 to 15 do if Project.UKSS[i].Use then begin if Project.UKSS[i].RXadr = adr then begin Project.UKSS[i].Bar.RXadr.Color := $FFD0A0; //clMoneyGreen; Project.UKSS[i].Bar.RXadr.Tag := 5000 div CANTimer.Interval; end; if Project.UKSS[i].TXadr = adr then begin Project.UKSS[i].Bar.TXadr.Color := $A0FFC0; //clMoneyGreen; Project.UKSS[i].Bar.TXadr.Tag := 5000 div CANTimer.Interval; end; if (Project.UKSS[i].RXadr = adr) or (Project.UKSS[i].TXadr = adr) then begin if project.Protokol = 3 then begin mess.Leng := ArrCanMessage[pak].m_bDLC shr 1; mess.Addr := ArrCanMessage[pak].m_dwID and $0000007F; mess.Mask := $FF; mess.Data[0] := ArrCanMessage[pak].m_bData[1] shl 8; mess.Data[0] := ArrCanMessage[pak].m_bData[2] or mess.Data[0]; mess.Data[1] := ArrCanMessage[pak].m_bData[3] shl 8; mess.Data[1] := ArrCanMessage[pak].m_bData[4] or mess.Data[1]; mess.Data[2] := ArrCanMessage[pak].m_bData[5] shl 8; mess.Data[2] := ArrCanMessage[pak].m_bData[6] or mess.Data[2]; mess.Data[3] := ArrCanMessage[pak].m_bData[7] shl 8; mess.Data[3] := ArrCanMessage[pak].m_bData[8] or mess.Data[3]; end else begin mess.Mask := ArrCanMessage[pak].m_bData[5] shr 5; mess.Addr :=(ArrCanMessage[pak].m_bData[5] and $1F) shl 8; mess.Addr := ArrCanMessage[pak].m_bData[6] or mess.Addr; mess.Leng := 3; mess.Data[0] := ArrCanMessage[pak].m_bData[7] shl 8; mess.Data[0] := ArrCanMessage[pak].m_bData[8] or mess.Data[0]; mess.Data[1] := ArrCanMessage[pak].m_bData[1] shl 8; mess.Data[1] := ArrCanMessage[pak].m_bData[2] or mess.Data[1]; mess.Data[2] := ArrCanMessage[pak].m_bData[3] shl 8; mess.Data[2] := ArrCanMessage[pak].m_bData[4] or mess.Data[2]; end; if(Project.UKSS[i].TXadr = adr) then mess.Surs := 0; if(Project.UKSS[i].RXadr = adr) then mess.Surs := 1; if Project.UKSS[i].Exist then Project.UKSS[i].Wind.ReceiveCanData(mess); end end end; newstring:=''; for i:= 1 to boxx.qua do newstring:= newstring + '0x'+ inttohex(boxx.box[i].adr,8) + '(' + inttostr(boxx.box[i].qua) + ') '; Memo1.Clear; Memo1.Lines[0] := newstring; end; if CANswitch.StateOn then for i:=0 to 15 do if Project.UKSS[i].Use then begin if Project.UKSS[i].Bar.RXadr.Tag = 0 then Project.UKSS[i].Bar.RXadr.Color := clWindow else begin Project.UKSS[i].Bar.RXadr.Tag := Project.UKSS[i].Bar.RXadr.Tag - 1; if Project.UKSS[i].Bar.RXadr.Tag < 4000 div CANTimer.Interval then Project.UKSS[i].Bar.RXadr.Color := $F0E0D0; end; if Project.UKSS[i].Bar.TXadr.Tag = 0 then Project.UKSS[i].Bar.TXadr.Color := clWindow else begin Project.UKSS[i].Bar.TXadr.Tag := Project.UKSS[i].Bar.TXadr.Tag - 1; if Project.UKSS[i].Bar.TXadr.Tag < 4000 div CANTimer.Interval then Project.UKSS[i].Bar.TXadr.Color := $D0F0E0; end end; end; procedure TCANTerminal.CANswitchClick(Sender: TObject); var i: integer; begin if CANswitch.StateOn then begin if Button125.Checked then OpenSlavna(1,8); if Button250.Checked then OpenSlavna(2,8); CanTimer.Enabled:=true; end else begin CloseSlavna(); CanTimer.Enabled:=false; boxx.qua := 0; for i:=0 to 15 do begin Project.UKSS[i].Bar.RXadr.Color := clBtnFace; Project.UKSS[i].Bar.TXadr.Color := clBtnFace; end; end; end; procedure TCANTerminal.FormClose(Sender: TObject; var Action: TCloseAction); var i: integer; inifile : TIniFile; nom: string; begin if Project.DigiButNameChange then begin inifile := TIniFile.Create(PathExe+'Projects.ini'); for i:=0 to 16 do begin nom := 'DigiBut_'+inttostr(i); inifile.WriteString(Project.Name,nom,Project.DigiButNames[i]); end; inifile.Free; end; CloseSlavna(); FreeSlavnaDll(); end; procedure TCANTerminal.RGBaudClick(Sender: TObject); begin if RGBaud.ItemIndex=0 then MyCommPort.Baud:=57600; if RGBaud.ItemIndex=1 then MyCommPort.Baud:=115200; end; procedure TCANTerminal.RComChange(Sender: TObject); begin MyCommPort.Open:=False; MyCommPort.ComNumber:= Round(RCom.Value); end; procedure TCANTerminal.CBLockRSClick(Sender: TObject); begin MyCommPort.Open := CBLockRS.Checked; end; procedure TCANTerminal.Memo2Change(Sender: TObject); begin if Memo1.Lines.Count > 100 then Memo1.Clear; end; procedure TCANTerminal.ProjectBoxChange(Sender: TObject); var i : integer; inifile : TIniFile; nom, num: string; begin for i:=0 to 15 do if Project.UKSS[i].Exist then begin Project.UKSS[i].Wind.Close; Project.UKSS[i].Exist:=false; end; Project.Name := ProjectBox.Items[ProjectBox.ItemIndex]; if ProjectBox.ItemIndex >0 then LoadProjectAdres(Project.Name); inifile := TIniFile.Create(PathExe+'Projects.ini'); nom:='ProjectNum'; num:=inttostr(ProjectBox.ItemIndex); inifile.WriteString('Projects',nom,num); for i:=0 to 16 do begin num := 'DigiBut_'+inttostr(i); Project.DigiButNames[i] := inifile.ReadString(Project.Name,num,'-'); end; Project.DigiButNameChange := false; inifile.Free; boxx.qua:=0; for i:= 1 to 100 do begin boxx.box[i].adr:=0; boxx.box[i].qua:=0; end; end; end.