ufieldwrite.pas

西门子Prodave6.0 的Delphi 版本, 需要安装 Prodave60软件,支持以太网通讯

unit uFieldWrite;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMenu, ExtCtrls, StdCtrls, RzPanel, ComCtrls, RzListVw,
  RzPrgres, Menus, Grids, RzGrids,PubFuns,Prodave60,UGlobdata;
  type
  TFieldWriteThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  Public 
  end;
type
  TFrmFieldWrite = class(TForm)
    FieldWriteStatusBar: TRzStatusBar;
    FieldWriteBar: TRzProgressBar;
    RzGroupBox1: TRzGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    EditDataNO: TEdit;
    EditDBNOFirst: TEdit;
    EditDBCount: TEdit;
    ButtonFieldWrite: TButton;
    EditCountTim: TEdit;
    FieldwriteTimer: TTimer;
    XPMenu1: TXPMenu;
    ComboBox1: TComboBox;
    RzStrGrid: TRzStringGrid;
    XPMenu2: TXPMenu;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FieldwriteTimerTimer(Sender: TObject);
    procedure ButtonFieldWriteClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure FieldWriteEND(Sender: TObject);
    Procedure FieldWriteerror(var message: TMessage); message CM_COMMSG;
    Function  UpdateStrGrid(Const Typ:Integer):boolean;
  end;

var
  FrmFieldWrite: TFrmFieldWrite;
  Str:string;
implementation

{$R *.dfm}
Procedure TFrmFieldWrite.FieldWriteerror(var message: TMessage);
var
   Msg:TMessage;
   Wp,i:integer;
begin
     Msg:=message;
     Wp:=msg.WParam;
     if (Wp=FieldWriteERR) then begin
       FieldWriteBar.Percent:=0;
       FieldWriteTimer.Enabled:=false;
       Messagebox(AppHWD.Handle,Pchar(GetErrorMessage_ex6(msg.LParam)),
                   Pchar('错误代码 :0x'+ IntToHex(msg.LParam,4)),
                   MB_OK);
      end;
      if Wp=FieldWriteOK then  begin
        for i := 1 to (RzStrGrid.RowCount)  do
              RzStrGrid.Cells[1,i]:=RzStrGrid.Cells[2,i];
      end;
end;
procedure TFieldWriteThread.Execute;
var
  ConFlag:word;
  FieldTime:Dword;
begin
    Freeonterminate:=true; 
          ReadBUFLen:=0;  
          pStartCalcTime;
    try
          Sleep(0);
          ConFlag:=field_write_ex6(FieldType,DBNO,DBStart,Amount,SetBufLen,@PwriteBuf);
          FieldTime:=pStopCalcTime;
          CalacTim:=Format('%d.%d',[FieldTime div 1000,FieldTime mod 1000]);
          if ConFlag<>0 then
              PostMessage(AppHWD.Handle, CM_COMMSG, FieldWriteERR, ConFlag)
          else
              PostMessage(AppHWD.Handle, CM_COMMSG, FieldWriteOK, ConFlag);
     finally

     end;
end;
procedure TFrmFieldWrite.FieldWriteEND(Sender: TObject);

begin
    EditCountTim.Text:=CalacTim;
    ButtonFieldWrite.Enabled:=true;
    FieldWriteTimer.Enabled:=false;
    FieldWriteBar.Percent:=100;
end;

Function TFrmFieldWrite.UpdateStrGrid(Const Typ:Integer):boolean;
//0:byte;1:word;2:dword
Var
  i:integer;
  TmpWord:word;
  TmpDword:Dword;
begin
     RzStrGrid.RowCount:=StrToInt(EditDBCount.Text)+1;
     case  Typ of
          0..3: for i := 1 to (RzStrGrid.RowCount) do begin
                 RzStrGrid.Cells[0,i]:=Str+IntToStr(StrToInt(EditDBNOFirst.text)+ i-1);
                 PwriteBuf[i]:=StrToInt(RzStrGrid.Cells[2,i]);
                end;
          4..5:for i := 1 to (RzStrGrid.RowCount) do begin
                 RzStrGrid.Cells[0,i]:=Str+IntToStr(StrToInt(EditDBNOFirst.text)+ i-1);
                 TmpWord:=word(StrToInt(RzStrGrid.Cells[2,i]));
                 PwriteBuf[2*i-1]:=Hi(TmpWord);
                 PwriteBuf[2*i]:=Lo(TmpWord);
            end;
          6:for i := 1 to (RzStrGrid.RowCount) do begin
              if RzStrGrid.Cells[2,i]='' then
                              RzStrGrid.Cells[2,i]:='0';
               RzStrGrid.Cells[1,i]:='0';
            end;
     end;
     result:=true;
end;
procedure TFrmFieldWrite.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
   Action:=caFree;
end;

procedure TFrmFieldWrite.FormCreate(Sender: TObject);
var
    i:integer;
begin
       for i:=1 to 1024 do
                        PwriteBuf[i]:=0;
      RzStrGrid.Cells[0,0]:='内存地址';
      RzStrGrid.Cells[1,0]:='实际值';
      RzStrGrid.Cells[2,0]:='更改值';
      ComboBox1.ItemIndex:=0;
      DatType:=ComboBox1.ItemIndex;
      FieldType:='A';
      Str:='QB';
      UpdateStrGrid(6);
      UpdateStrGrid(DatType);
end;

procedure TFrmFieldWrite.N1Click(Sender: TObject);
begin
    RzStrGrid.RowCount:=  RzStrGrid.RowCount +1;
    RzStrGrid.Cells[0,RzStrGrid.RowCount-1]:=Str+IntToStr(StrToInt(EditDBNOFirst.text)
                                              + RzStrGrid.RowCount-2);
end;

procedure TFrmFieldWrite.N2Click(Sender: TObject);
begin
    if  RzStrGrid.RowCount>2 then
       RzStrGrid.RowCount:= RzStrGrid.RowCount-1;

end;

procedure TFrmFieldWrite.FieldwriteTimerTimer(Sender: TObject);
begin
    FieldWriteBar.Percent:= FieldWriteBar.Percent + 1;
end;

procedure TFrmFieldWrite.ButtonFieldWriteClick(Sender: TObject);
 var
    FieldThread:TFieldWriteThread;
    ItemNO:Integer;
begin
    DBNO:=StrToInt(EditDataNO.Text);
    DBStart:=StrToInt(EditDBNOFirst.Text);
    Amount:=StrToInt(EditDBCount.Text);
    FieldWriteTimer.Enabled:=true;
    FieldWriteBar.Percent:=0;
    ButtonFieldWrite.Enabled:=false;
    UpdateStrGrid(DatType);
    //------------------------------------------
    FieldThread:=TFieldWriteThread.Create(false);
    FieldThread.OnTerminate:= FieldWriteEND;
end;

procedure TFrmFieldWrite.ComboBox1Change(Sender: TObject);
begin
    DatType:=ComBoBox1.ItemIndex;
    case DatType of
        0: begin
             FieldType:='A';
             Str:='QB';
             EditDataNO.text:='0';
             EditDataNO.Enabled:=false;
           end;
        1:begin
             FieldType:='D';
             Str:='DB'+ EditDataNO.Text  + '.'+ 'DBB';
             EditDataNO.Enabled:=true;
          end;
        2:begin
             FieldType:='E';
             STR:='IB';
             EditDataNO.text:='0';
             EditDataNO.Enabled:=false;
          end;
        3:begin
             FieldType:='M';
             Str:='MB';
             EditDataNO.text:='0';
             EditDataNO.Enabled:=false;
          end;
        4:begin
             FieldType:='T';
             Str:='T';
             EditDataNO.text:='0';
             EditDataNO.Enabled:=false;
          end;
        5:begin
             FieldType:='Z';
             Str:='C';
             EditDataNO.text:='0';
             EditDataNO.Enabled:=false;
          end;
    end;
    UpdateStrGrid(6);
    UpdateStrGrid(DatType);
end;

end.