udbwrite.pas

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

unit uDBWrite;

interface

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

var
  FrmDBWrite: TFrmDBWrite;
  Str:string; 
implementation

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

     end;
end;
procedure TFrmDBWrite.DBWriteEND(Sender: TObject);

begin
    EditCountTim.Text:=CalacTim;
    ButtonDbWrite.Enabled:=true;
    DbWriteTimer.Enabled:=false;
    DbWriteBar.Percent:=100;
end;

Function TFrmDBWrite.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: for i := 1 to (RzStrGrid.RowCount) do begin
                 RzStrGrid.Cells[0,i]:='DB'+ EditDataNO.Text  + '.'+Str
                             +IntToStr(StrToInt(EditDBNOFirst.text)+ i-1);
                 PwriteBuf[i]:=StrToInt(RzStrGrid.Cells[2,i]);
             end;
          1:for i := 1 to (RzStrGrid.RowCount) do begin
                 RzStrGrid.Cells[0,i]:='DB'+ EditDataNO.Text  + '.'+Str
                             +IntToStr(StrToInt(EditDBNOFirst.text)+ 2*(i-1));
                 TmpWord:=word(StrToInt(RzStrGrid.Cells[2,i]));
                 PwriteBuf[2*i-1]:=Hi(TmpWord);
                 PwriteBuf[2*i]:=Lo(TmpWord);
            end;
          2:for i := 1 to (RzStrGrid.RowCount) do begin
                 RzStrGrid.Cells[0,i]:='DB'+ EditDataNO.Text  + '.'+Str
                             +IntToStr(StrToInt(EditDBNOFirst.text)+ 4*(i-1));
                 TmpDWord:=Dword(StrToInt(RzStrGrid.Cells[2,i]));
                 TmpWord:=Word((TmpDWord shr 16) and $0000FFFF);
                 PwriteBuf[4*i-3]:=Hi(TmpWord);
                 PwriteBuf[4*i-2]:=Lo(TmpWord);
                 TmpWord:=word(TmpDWord and $0000FFFF);
                 PwriteBuf[4*i-1]:=Hi(TmpWord);
                 PwriteBuf[4*i]:=Lo(TmpWord);
             end;
          3: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 TFrmDBWrite.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.Text:='字节 Byte';
      ComboBox1.ItemIndex:=0;
      DatType:=2*(Combobox1.ItemIndex +1);
      Str:='DBB';
     UpdateStrGrid(3) ;
    UpdateStrGrid(0) ;
end;

procedure TFrmDBWrite.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     Action:=caFree;
end;

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

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

procedure TFrmDBWrite.EditDataNOChange(Sender: TObject);
var
   ItemNO:Integer;
begin
   ItemNo:=ComboBox1.ItemIndex;
   UpdateStrGrid(3);
   UpdateStrGrid(ItemNo);
end;

procedure TFrmDBWrite.ComboBox1Change(Sender: TObject);
var
   ItemNO:Integer;
begin
    ItemNo:=ComboBox1.ItemIndex;
    DatType:=2*(Combobox1.ItemIndex +1);
    case ItemNO of
        0:Str:='DBB';
        1:Str:='DBW';
        2:Str:='DBD';
    end;
    UpdateStrGrid(3);
    UpdateStrGrid(ItemNo);
end;

procedure TFrmDBWrite.ButtonDbWriteClick(Sender: TObject);
 var
    WriteThread:TDBWriteThread;
    ItemNO:Integer;
begin
    ItemNo:=ComboBox1.ItemIndex;
    DBNO:=StrToInt(EditDataNO.Text);
    DBStart:=StrToInt(EditDBNOFirst.Text);
    Amount:=StrToInt(EditDBCount.Text);

    DbWriteTimer.Enabled:=true;
    DbWriteBar.Percent:=0;
    ButtonDbWrite.Enabled:=false;
    UpdateStrGrid(ItemNo);
//------------------------------------------
    WriteThread:=TDBWriteThread.Create(false);
    WriteThread.OnTerminate:= DBWriteEND;
end;
procedure TFrmDBWrite.DbWriteTimerTimer(Sender: TObject);
begin
      DbWriteBar.Percent:= DbWriteBar.Percent + 1;
end;

end.