ufieldread.pas

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

unit uFieldRead;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, RzPanel, ComCtrls, RzListVw, RzPrgres,
  PubFuns,Prodave60,uGlobdata, XPMenu;
 type
  TFieldReadThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  Public 
  end;
type
  TFrmFieldRead = class(TForm)
    RzListView1: TRzListView;
    RzGroupBox1: TRzGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EditDataNO: TEdit;
    EditDBNOFirst: TEdit;
    EditDBCount: TEdit;
    ComboBox1: TComboBox;
    ButtonFieldRead: TButton;
    FieldReadStatusBar: TRzStatusBar;
    FieldreadBar: TRzProgressBar;
    FieldTimer: TTimer;
    Label5: TLabel;
    EditCountTim: TEdit;
    Label6: TLabel;
    XPMenu1: TXPMenu;
    procedure ButtonFieldReadClick(Sender: TObject);
    procedure FieldTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure FieldReadEND(Sender: TObject);
    Procedure FieldReaderror(var message: TMessage); message CM_COMMSG;
  end;

var
  FrmFieldRead: TFrmFieldRead;

implementation

{$R *.dfm}

procedure TFrmFieldRead.FieldReadEND(Sender: TObject);
var
   i,DispNO:integer;
   Item:TlistItem;
   STR:String;
   BufferW:Word;
begin
   EditCountTim.Text:=CalacTim;
   FieldTimer.Enabled:=false;
   FieldReadBar.Percent:=100;
   ButtonFieldRead.Enabled:=true;
   
    DispNO:=ReadBufLen;
    RzListView1.Items.BeginUpdate;
    RzListView1.Items.Clear;
    Case  ComboBox1.ItemIndex of
         0:  STR:='QB';
         1:  STR:='DB'+ EditDataNO.Text +'.'+ 'DBB';
         2:  STR:='IB';
         3:  STR:='MB';
         4:  STR:='T';
         5:  STR:='C';
    end;
    Case  ComboBox1.ItemIndex of
         0..3:for i := 1 to DispNO do begin
                  Item:=RzListView1.Items.Add;
                  Item.Caption:=Str +IntTostr(StrToInt(EditDBNOFirst.text)+i-1) ;
                  Item.SubItems.Add('$'+IntToHex(Buffer[i],2));
                  Item.SubItems.Add(IntToStr(Buffer[i]));
                  Item.SubItems.Add(ByteToboolStr(Buffer[i]));
                  Item.SubItems.Add(Char(Buffer[i]));
              end;
         4..5:for i := 1 to (DispNO div 2) do begin
                  BufferW:=(Word(Buffer[2*i-1]) shl 8) or Buffer[2*i];
                  Item:=RzListView1.Items.Add;
                  Item.Caption:=Str +IntTostr(StrToInt(EditDBNOFirst.text)+i-1) ;
                  Item.SubItems.Add('$'+IntToHex(BufferW,4));
                  Item.SubItems.Add(IntToStr(BufferW));
                  Item.SubItems.Add(WordToboolStr(BufferW));
                  Item.SubItems.Add(Char(BufferW));
              end;
    end;

  RzListView1.Items.EndUpdate;
end;
Procedure TFrmFieldRead.FieldReaderror(var message: TMessage);
var
   Msg:TMessage;
   Wp:integer;
begin
     Msg:=message;
     Wp:=msg.WParam;
     if (Wp=FieldReadERR) then begin
       FieldreadBar.Percent:=0;
       FieldTimer.Enabled:=false;
       Messagebox(Handle,Pchar(GetErrorMessage_ex6(msg.LParam)),
             Pchar('错误代码 :0x'+ IntToHex(msg.LParam,4)),MB_OK);
     end;
end;
procedure TFieldReadThread.Execute;
var
  i:integer;
  ConFlag:word;
  S:string;
  ReadTime:Dword;
begin
    Freeonterminate:=true;
    for i:=1 to Amount do
          Buffer[i]:=0;
          ReadBUFLen:=0;
          Readtime:=0;
          pStartCalcTime;
    try
          Sleep(0);
          ConFlag:=field_read_ex6(FieldType,DBNO,DBStart,Amount,SetBufLen,@Buffer,@ReadBufLen);
          ReadTime:=pStopCalcTime;
          CalacTim:=Format('%d.%d',[ReadTime div 1000,ReadTime mod 1000]);
          if ConFlag<>0 then begin
              PostMessage(Apphwd.Handle, CM_COMMSG, FieldReadERR, ConFlag);
          end;
     finally
          
     end;
end;

procedure TFrmFieldRead.ButtonFieldReadClick(Sender: TObject);
 var
    FieldReadThread:TFieldReadThread;
begin
    DBNO:=StrToInt(EditDataNO.Text);
    DBStart:=StrToInt(EditDBNOFirst.Text);
    Amount:=StrToInt(EditDBCount.Text);

    FieldTimer.Enabled:=true;
    FieldReadBar.Percent:=0;
    ButtonFieldRead.Enabled:=false;
    FieldReadThread:=TFieldReadThread.Create(false);
    FieldReadThread.OnTerminate:= FieldReadEND;
end;

procedure TFrmFieldRead.FieldTimerTimer(Sender: TObject);
begin
    FieldReadBar.Percent:= FieldReadBar.Percent + 1;
end;

procedure TFrmFieldRead.FormCreate(Sender: TObject);
begin
    ComboBox1.ItemIndex:=0;
    FieldType:='A';
end;

procedure TFrmFieldRead.ComboBox1Change(Sender: TObject);
var
   Index:integer;
begin
    Index:=ComBoBox1.ItemIndex;
    case Index of
        0:FieldType:='A';
        1:FieldType:='D';
        2:FieldType:='E';
        3:FieldType:='M';
        4:FieldType:='T';
        5:FieldType:='Z';
    end;
end;

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

end.