📄 scom.pas
字号:
unit scom;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls,Prodave, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Panel2: TPanel;
Panel3: TPanel;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
PageControl1: TPageControl;
TabSheet2: TTabSheet;
Label10: TLabel;
Label11: TLabel;
Edit5: TEdit;
Edit6: TEdit;
Memo1: TMemo;
Button3: TButton;
TabSheet3: TTabSheet;
Button6: TButton;
Panel7: TPanel;
RadioGroup1: TRadioGroup;
Edit7: TEdit;
Button4: TButton;
RadioGroup2: TRadioGroup;
Button5: TButton;
Button7: TButton;
Memo2: TMemo;
Label9: TLabel;
Label13: TLabel;
Edit10: TEdit;
Edit11: TEdit;
CheckBox1: TCheckBox;
Label12: TLabel;
Label16: TLabel;
Label14: TLabel;
Label17: TLabel;
CheckBox2: TCheckBox;
Button8: TButton;
CheckBox3: TCheckBox;
Splitter1: TSplitter;
Panel8: TPanel;
Panel9: TPanel;
Panel10: TPanel;
Panel11: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RadioGroup1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
ScreenHeight:integer=1024;
ScreenWidth:integer=768;
var
Form1: TForm1;
plc_adr_table : array [0..15] of byte;
res: longint;
linkname:array[0..255] of char;
ErrMess:array[0..255] of char;
adr_table: adr_table_type ;
linkstatus:boolean;
data1:array[0..255] of byte;
implementation
uses datalog, Unit4;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
adr_table.adr := strtoint(edit1.Text); {address}
adr_table.segmentid := strtoint(edit2.Text); {segment id}
adr_table.slotno := strtoint(edit3.Text); {slot no}
adr_table.rackno := strtoint(edit4.Text); {rack no}
adr_table.end0:=0;
strcopy(linkname,'S7ONLINE');
res := Load_tool(1,addr(linkname),addr(adr_table));
label1.Caption:=format('errormessagecode=%.4x',[res]);
if(Prodave.Error_Message(res, ErrMess)=0)
then if res<>0
then
begin
label2.Caption:=ErrMess ;
statusbar1.Panels[0].Text:='连接错误';
end
else
begin
label2.Caption:='ok' ;
linkstatus:=true;
statusbar1.Panels[0].Text:='已连接';
end
else
label2.Caption:='error.data error';
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i:integer ;
begin
res := Unload_Tool;
label1.Caption:=format('errormessagecode=%.4x',[res]);
i:=Prodave.Error_Message(res, ErrMess);
if(i=0)
then if res<>0
then
label2.Caption:=ErrMess +inttostr(res)
else
begin
label2.Caption:='ok' ;
statusbar1.Panels[0].Text:='连接关闭';
linkstatus:=false;
end
else
begin
label2.Caption:='error.data error'+inttostr(i);
statusbar1.Panels[0].Text:='关闭error';
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
tt:string;
aa,sss:integer;
begin
sss:=0;
SetLength (tt, 100);
if linkstatus=false then
begin
MessageBox(Handle, '通讯未打开', '错误', MB_OK + MB_ICONINFORMATION + MB_TOPMOST) ;
exit;
end;
if ((radiogroup1.ItemIndex <0) or (radiogroup1.ItemIndex> 5))then
begin
messagebox(null,'error','未选择内存类型',MB_OK ) ;
exit;
end ;
if ((radiogroup2.ItemIndex <0 )or (radiogroup2.ItemIndex> 3))then
begin
messagebox(null,'error','未选择工作模式',MB_OK ) ;
exit;
end;
//数据读取
case radiogroup1.ItemIndex of
0:// 输入
begin
tt:='输入 byte' ;
res:=e_Field_Read(strtoint(edit6.Text), strtoint(edit5.Text), data1) ;
end ;
1: //输出
begin
tt:='输出 byte ';
res:=a_Field_Read(strtoint(edit6.Text), strtoint(edit5.Text), data1) ;
end;
2: //M区
begin
tt:='M区 byte';
res:=m_Field_Read(strtoint(edit6.Text), strtoint(edit5.Text), data1) ;
end ;
3: // DB块
begin
aa:= strtoint(edit5.Text) ;
tt:='DB块 word' ;
res:=db_Read(strtoint(edit7.Text),strtoint(edit6.Text), aa,data1) ;
end;
4: //定时器
begin
aa:= strtoint(edit5.Text) ;
tt:='定时器 word';
res:=t_Field_Read(strtoint(edit6.Text), aa, data1) ;
end;
5: //计数器
begin
tt:='计数器 word';
res:=z_Field_Read(strtoint(edit6.Text), strtoint(edit5.Text), data1) ;
end;
else
messagebox(null,'error','错误代号一',MB_OK ) ;
end;
//报警显示
if res<>0 then
begin
label1.Caption:=format('errormessagecode=%.4x',[res]);
Prodave.Error_Message(res, ErrMess);
label2.Caption:=ErrMess;
end ;
//内容显示 ；
case radiogroup2.ItemIndex of
0:// 十进制
begin
memo1.Text:=memo1.Text+'十进制显示'+tt+#13#10;
if checkbox1.Checked=false then
while( (sss< strtoint(edit5.Text))and (sss < 200) ) do
begin
// hextobin(format('%.2d',[data1[sss]]), binstr,4);
memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss)+'..'+ format('%.2d',[data1[sss]])+#13#10;
sss:=sss+1;
end
else
while( (sss< strtoint(edit5.Text)*2)and (sss < 100) ) do
begin
memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss div 2)+'..'+ format('%.2d',[data1[sss]]);
sss:=sss+1;
memo1.Text:= memo1.Text+format('%.2d',[data1[sss]])+#13#10;
sss:=sss+1;
end ;
if checkbox3.Checked=true then
SendMessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
end;
1: // 十六进制
begin
memo1.Text:=memo1.Text+'十六进制显示 '+tt+#13#10;
if checkbox1.Checked=false then
while( (sss< (strtoint(edit5.Text))) and (sss < 200) ) do
begin
memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss)+'..'+ format('%.2x',[data1[sss]])+#13#10;
sss:=sss+1;
end
else
while( (sss< strtoint(edit5.Text)*2)and (sss < 100) ) do
begin
// memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss)+'..'+ format('%4x',[(pinteger(@data1[sss*2]))^])+#13#10;
memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss div 2)+'..'+ format('%.2x',[data1[sss]]);
sss:=sss+1;
memo1.Text:= memo1.Text+format('%.2x',[data1[sss]])+#13#10;
sss:=sss+1;
end;
if checkbox3.Checked=true then
SendMessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
end;
2:// 二进制
begin
memo1.Text:=memo1.Text+'二进制显示 '+tt+#13#10;
if checkbox1.Checked=false then
while( (sss< (strtoint(edit5.Text))) and (sss < 200) ) do
begin
memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss)+'..'+ format('%.2x',[data1[sss]])+#13#10;
sss:=sss+1;
end
else
while( (sss< strtoint(edit5.Text)*2)and (sss < 100) ) do
begin
memo1.Text:=memo1.Text+inttostr(strtoint(edit6.Text)+sss div 2)+'..'+ format('%.2x',[data1[sss]]);
sss:=sss+1;
memo1.Text:= memo1.Text+format('%.2x',[data1[sss]])+#13#10;
sss:=sss+1;
end;
if checkbox3.Checked=true then
SendMessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
end;
else
messagebox(null,'error','错误代号二',MB_OK ) ;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
x,y:longint;
begin
linkstatus:=false;
form1.Scaled:=true;
x:= GetSystemMetrics(SM_CXSCREEN);
Y:= GetSystemMetrics(SM_CYSCREEN);
if (x<>ScreenHeight)or (y<>ScreenWidth) then
begin
form1.Height:=form1.Height*x div ScreenHeight;
form1.Height:=form1.Width*y div ScreenWidth;
scaleby(x,screenHeight);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
memo1.Clear;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
memo2.Clear;
end;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
LineNum,LineLength:longint;
CharsBeforeLine,LineLength1:longint;
begin
LineNum := SendMessage(Memo1.Handle,EM_LINEFROMCHAR, Memo1.SelStart,0);
LineLength1:=memo1.Lines.Count;
CharsBeforeLine:=SendMessage(Memo1.Handle,EM_LINEINDEX,LineNum,0);
LineLength:=SendMessage(Memo1.handle,EM_LINELENGTH,CharsBeforeLine,0);
Label12.Caption:='Line: '+Format('%.4d', [LineNum + 1])+Format('--%.4d', [LineLength1 + 1]); //'x= 12' //指定宽度IntToStr(LineNum + 1);
Label16.Caption:='Position: '+Format('%.4d', [(Memo1.SelStart - CharsBeforeLine)+1])+Format('--%.4d', [LineLength + 1]); //IntToStr((Memo1.SelStart - CharsBeforeLine)+1);
end;
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LineNum,LineLength:longint;
CharsBeforeLine,LineLength1:longint;
begin
LineNum := SendMessage(Memo1.Handle,EM_LINEFROMCHAR, Memo1.SelStart,0);
LineLength1:=memo1.Lines.Count;
CharsBeforeLine:=SendMessage(Memo1.Handle,EM_LINEINDEX,LineNum,0);
LineLength:=SendMessage(Memo1.handle,EM_LINELENGTH,CharsBeforeLine,0);
Label12.Caption:='Line: '+Format('%.4d', [LineNum + 1])+Format('--%.4d', [LineLength1 + 1]); //'x= 12' //指定宽度IntToStr(LineNum + 1);
Label16.Caption:='Position: '+Format('%.4d', [(Memo1.SelStart - CharsBeforeLine)+1])+Format('--%.4d', [LineLength + 1]); //IntToStr((Memo1.SelStart - CharsBeforeLine)+1);
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if( radiogroup1.ItemIndex>2) and (radiogroup1.ItemIndex<6) then
checkbox1.Checked:=true else checkbox1.Checked:=false;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
//if linkstatus=false then Application.MessageBox('请设置通讯参数再次连接后重试', '错误未通讯', MB_OK +
// MB_ICONINFORMATION
// +
// MB_TOPMOST)
// else
form2.Show;
Form1.Visible:=False;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -