udbread.pas

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

unit UDbRead;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, RzListVw, StdCtrls, ExtCtrls, RzPanel, XPMenu,uGlobdata,
  PubFuns,Prodave60, ImgList, RzPrgres;
  type
  TDBReadThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  Public 
  end;
type
  TFrmDBRead = class(TForm)
    RzGroupBox1: TRzGroupBox;
    Label1: TLabel;
    EditDataNO: TEdit;
    EditDBNOFirst: TEdit;
    Label2: TLabel;
    EditDBCount: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox1: TComboBox;
    XPMenu1: TXPMenu;
    ButtonDbRead: TButton;
    Label5: TLabel;
    EditCountTim: TEdit;
    Label6: TLabel;
    ImageList1: TImageList;
    DbReadStatusBar: TRzStatusBar;
    DBReadBar: TRzProgressBar;
    DbReadTimer: TTimer;
    RzListView1: TRzListView;
    procedure ButtonDbReadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure DbReadTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }

  public
    { Public declarations }
    procedure DBReadEND(Sender: TObject);
    Procedure DBReaderror(var message: TMessage); message CM_COMMSG;
  end;
var
    FrmDBRead: TFrmDBRead;
    DatByte:Byte;
implementation
{$R *.dfm}

Procedure TfrmDBread.DBReaderror(var message: TMessage);
var
   Msg:TMessage;
   Wp:integer;
begin
     Msg:=message;
     Wp:=msg.WParam;
     if (Wp=DBReadERR) then begin
       DBreadbar.Percent:=0;
       DBreadTimer.Enabled:=false;
       Messagebox(AppHWD.Handle,Pchar(GetErrorMessage_ex6(msg.LParam)),
                   Pchar('错误代码 :0x'+ IntToHex(msg.LParam,4)),
                   MB_OK);
      end;
end;
Procedure TfrmDBread.DBReadEND(Sender: TObject);
var
 Item:TlistItem;
 Str:String;
 i,DispNO:integer;
 BufferW:word;
 BufferDW:Dword;
begin
    EditCountTim.Text:=CalacTim;
    ButtonDbRead.Enabled:=true;
    DbReadTimer.Enabled:=false;
    DbReadBar.Percent:=100;
  try
    RzListView1.Items.BeginUpdate;
    RzListView1.Items.Clear;
    case DatType of
       2:begin
            Str:='DBB';
            DispNO:=ReadBufLen;
            for i := 1 to DispNO do begin
                Item:=RzListView1.Items.Add;
                Item.Caption:='DB'+ EditDataNO.Text +'.'+ 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;
         end;
       4:begin
              Str:='DBW';
             DispNO:=ReadBufLen div 2;
             for i := 1 to DispNO do begin
                BufferW:=(Word(Buffer[2*i-1]) shl 8) or Buffer[2*i];
                Item:=RzListView1.Items.Add;
                Item.Caption:='DB'+ EditDataNO.Text +'.'+ Str+ IntTostr(StrToInt(EditDBNOFirst.Text)+2*(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;
       6:begin
              Str:='DBD';
              DispNO:=ReadBufLen div 4;
             for i := 1 to DispNO do begin
                BufferDW:=DWord(Buffer[4*(i-1)+1]) shl 24 or DWord(Buffer[4*(i-1)+2]) shl 16 OR
                          DWord(Buffer[4*(i-1)+3]) shl 8 OR DWord(Buffer[4*(i-1)+4]);
                Item:=RzListView1.Items.Add;
                Item.Caption:='DB'+ EditDataNO.Text +'.'+ Str+ IntTostr(StrToInt(EditDBNOFirst.Text)+4*(i-1)) ;
                Item.SubItems.Add('$'+IntToHex(BufferDW,8));
                Item.SubItems.Add(IntToStr(BufferDW));
                Item.SubItems.Add(DWordToboolStr(BufferDW));
                Item.SubItems.Add(Char(BufferDW));
             end;
         end;
    end;
  finally
    RzListView1.Items.EndUpdate;
  end;
end;

procedure TDBReadThread.Execute;
var
  i,j: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:=db_read_ex6(DBNO,DatType,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, DBReadERR, ConFlag);
          end;
     finally
          
     end;
end;
//--------------------------------------------------------------
procedure TFrmDBRead.ButtonDbReadClick(Sender: TObject);
 var
    ReadThread:TDBReadThread;
begin
    DBNO:=StrToInt(EditDataNO.Text);
    DBStart:=StrToInt(EditDBNOFirst.Text);
    Amount:=StrToInt(EditDBCount.Text);

    DbReadTimer.Enabled:=true;
    DbReadBar.Percent:=0;
    ButtonDbRead.Enabled:=false;
//------------------------------------------
    ReadThread:=TDBReadThread.Create(false);
    ReadThread.OnTerminate:= DBReadEND;
end;

procedure TFrmDBRead.FormCreate(Sender: TObject);
begin
    Combobox1.ItemIndex:=0;
    DatType:=2*(Combobox1.ItemIndex +1);
end;

procedure TFrmDBRead.ComboBox1Change(Sender: TObject);
Var
   Index:integer;
begin
    Index:=ComBoBox1.ItemIndex;
    DatType:=2*(Index +1);
end;

procedure TFrmDBRead.DbReadTimerTimer(Sender: TObject);
begin
     DbReadBar.Percent:= DbReadBar.Percent + 1;
end;

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

end.