⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 formrun.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
字号:
unit formrun;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Driver, Global, Menus;

type
  Tfrmrun = class(TForm)
    CmdExit: TButton;
    GroupSample1: TGroupBox;
    PictureBit0: Timage;
    PictureBit1: TImage;
    PictureBit2: TImage;
    PictureBit3: TImage;
    PictureBit4: TImage;
    PictureBit5: TImage;
    PictureBit6: TImage;
    PictureBit7: TImage;
    CmdBit0: TButton;
    CmdBit1: TButton;
    CmdBit2: TButton;
    CmdBit3: TButton;
    CmdBit4: TButton;
    CmdBit5: TButton;
    CmdBit6: TButton;
    CmdBit7: TButton;
    labBit0: TLabel;
    labBit1: TLabel;
    labBit2: TLabel;
    labBit3: TLabel;
    labBit4: TLabel;
    labBit5: TLabel;
    labBit6: TLabel;
    labBit7: TLabel;
    PictureBit8: TImage;
    PictureBit9: TImage;
    PictureBit10: TImage;
    PictureBit11: TImage;
    PictureBit12: TImage;
    PictureBit13: TImage;
    PictureBit14: TImage;
    PictureBit15: TImage;
    labBit8: TLabel;
    labBit9: TLabel;
    labBit10: TLabel;
    labBit11: TLabel;
    labBit12: TLabel;
    labBit13: TLabel;
    labBit14: TLabel;
    cmdBit8: TButton;
    cmdBit9: TButton;
    cmdBit10: TButton;
    cmdBit11: TButton;
    cmdBit12: TButton;
    cmdBit13: TButton;
    cmdBit14: TButton;
    cmdBit15: TButton;
    labBit15: TLabel;
    PictureBit16: TImage;
    PictureBit17: TImage;
    PictureBit18: TImage;
    PictureBit19: TImage;
    PictureBit20: TImage;
    PictureBit21: TImage;
    PictureBit22: TImage;
    PictureBit23: TImage;
    labBit16: TLabel;
    labBit17: TLabel;
    labBit18: TLabel;
    labBit19: TLabel;
    labBit20: TLabel;
    labBit21: TLabel;
    labBit22: TLabel;
    cmdBit16: TButton;
    cmdBit17: TButton;
    cmdBit18: TButton;
    cmdBit19: TButton;
    cmdBit20: TButton;
    cmdBit21: TButton;
    cmdBit22: TButton;
    cmdBit23: TButton;
    labBit23: TLabel;
    PictureBit24: TImage;
    PictureBit25: TImage;
    PictureBit26: TImage;
    PictureBit27: TImage;
    PictureBit28: TImage;
    PictureBit29: TImage;
    PictureBit30: TImage;
    PictureBit31: TImage;
    labBit24: TLabel;
    labBit25: TLabel;
    labBit26: TLabel;
    labBit27: TLabel;
    labBit28: TLabel;
    labBit29: TLabel;
    labBit30: TLabel;
    cmdBit24: TButton;
    cmdBit25: TButton;
    cmdBit26: TButton;
    cmdBit27: TButton;
    cmdBit28: TButton;
    cmdBit29: TButton;
    cmdBit30: TButton;
    cmdBit31: TButton;
    labBit31: TLabel;
    GroupBox1: TGroupBox;
    cmdWrietByte: TButton;
    cmdWriteWord: TButton;
    cmdWriteDword: TButton;
    cmdReadByte: TButton;
    cmdReadWord: TButton;
    cmdReadDword: TButton;
    GroupBox2: TGroupBox;
    txtByte: TEdit;
    Label25: TLabel;
    GroupBox3: TGroupBox;
    txtWord: TEdit;
    Label26: TLabel;
    GroupBox4: TGroupBox;
    txtDword: TEdit;
    Label27: TLabel;
    procedure CmdExitClick(Sender: TObject);
    procedure CmdBitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PictureClick(Sender: TObject);
    procedure cmdWrietByteClick(Sender: TObject);
    procedure cmdWriteWordClick(Sender: TObject);
    procedure cmdWriteDwordClick(Sender: TObject);
    procedure cmdReadByteClick(Sender: TObject);
    procedure cmdReadWordClick(Sender: TObject);
    procedure cmdReadDwordClick(Sender: TObject);

  private
    { Private declarations }
    DoValue, DiValue : Longword;
    procedure UpdateLED(Bit : Integer ;  Mode : Boolean);
  public
    { Public declarations }
  end;

var
  frmrun: Tfrmrun;

implementation

uses formstar;

const
     LedON  = True;
     LedOFF = False;
var
   Response       : Integer;
{$R *.DFM}

Function DoBit(bit : Integer) : Longword;
var
  temp, i : Integer;
begin
  temp := 1;
  If bit >= 1 Then
    For i := 1 To bit do
      temp := temp * 2;
  DoBit := temp;
end;

procedure Tfrmrun.cmdReadDwordClick(Sender: TObject);
var
     DiStr : string[10];
begin
     DiValue := 0;
     lpReadPortDword.port := gwPort;
     lpReadPortDword.WordData := @DiValue;
     ErrCde := DRV_ReadPortDword(DeviceHandle, lpReadPortDword);
     If (ErrCde <> 0) Then
     begin
          DRV_GetErrorMessage(ErrCde, pszErrMsg);
          Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
          Exit;
     end;
     txtDword.Text := Format('%x', [DiValue]);

end;

procedure Tfrmrun.UpdateLED(Bit : Integer;  Mode : Boolean);
begin
     if Mode then
        DoValue := DoValue + DoBit(Bit)
     else
        DoValue := DoValue - DoBit(Bit);
end;

procedure Tfrmrun.CmdExitClick(Sender: TObject);
begin
     frmRun.Close;
     Formstar.frmstart.Show;
end;

procedure Tfrmrun.CmdBitClick(Sender: TObject);
var
   tempBit : Integer;
begin
     tempBit := (Sender as TButton).Tag;
     UpdateLED(tempBit, LedON);
     (Sender as TButton).Visible := False;
     case tempBit of
          0 : PictureBit0.Visible := True;
          1 : PictureBit1.Visible := True;
          2 : PictureBit2.Visible := True;
          3 : PictureBit3.Visible := True;
          4 : PictureBit4.Visible := True;
          5 : PictureBit5.Visible := True;
          6 : PictureBit6.Visible := True;
          7 : PictureBit7.Visible := True;
          8 : PictureBit8.Visible := True;
          9 : PictureBit9.Visible := True;
          10 : PictureBit10.Visible := True;
          11 : PictureBit11.Visible := True;
          12 : PictureBit12.Visible := True;
          13 : PictureBit13.Visible := True;
          14 : PictureBit14.Visible := True;
          15 : PictureBit15.Visible := True;
          16 : PictureBit16.Visible := True;
          17 : PictureBit17.Visible := True;
          18 : PictureBit18.Visible := True;
          19 : PictureBit19.Visible := True;
          20 : PictureBit20.Visible := True;
          21 : PictureBit21.Visible := True;
          22 : PictureBit22.Visible := True;
          23 : PictureBit23.Visible := True;
          24 : PictureBit24.Visible := True;
          25 : PictureBit25.Visible := True;
          26 : PictureBit26.Visible := True;
          27 : PictureBit27.Visible := True;
          28 : PictureBit28.Visible := True;
          29 : PictureBit29.Visible := True;
          30 : PictureBit30.Visible := True;
          31 : PictureBit31.Visible := True;
     end;
end;

procedure Tfrmrun.PictureClick(Sender: TObject);
var
   tempBit : Integer;
begin
     tempBit := (Sender as TImage).Tag;
     UpdateLED(tempBit, LedOFF);
     (Sender as TImage).Visible := False;
     case tempBit of
          0 : CmdBit0.Visible := True;
          1 : CmdBit1.Visible := True;
          2 : CmdBit2.Visible := True;
          3 : CmdBit3.Visible := True;
          4 : CmdBit4.Visible := True;
          5 : CmdBit5.Visible := True;
          6 : CmdBit6.Visible := True;
          7 : CmdBit7.Visible := True;
          8 : CmdBit8.Visible := True;
          9 : CmdBit9.Visible := True;
          10 : CmdBit10.Visible := True;
          11 : CmdBit11.Visible := True;
          12 : CmdBit12.Visible := True;
          13 : CmdBit13.Visible := True;
          14 : CmdBit14.Visible := True;
          15 : CmdBit15.Visible := True;
          16 : CmdBit16.Visible := True;
          17 : CmdBit17.Visible := True;
          18 : CmdBit18.Visible := True;
          19 : CmdBit19.Visible := True;
          20 : CmdBit20.Visible := True;
          21 : CmdBit21.Visible := True;
          22 : CmdBit22.Visible := True;
          23 : CmdBit23.Visible := True;
          24 : CmdBit24.Visible := True;
          25 : CmdBit25.Visible := True;
          26 : CmdBit26.Visible := True;
          27 : CmdBit27.Visible := True;
          28 : CmdBit28.Visible := True;
          29 : CmdBit29.Visible := True;
          30 : CmdBit30.Visible := True;
          31 : CmdBit31.Visible := True;
     end;
end;

procedure Tfrmrun.FormCreate(Sender: TObject);
begin
     DoValue := 0;
end;

procedure Tfrmrun.cmdWrietByteClick(Sender: TObject);
begin
     lpWritePortByte.port := gwPort;
     if (DoValue > 255) then
          lpWritePortByte.ByteData := 255
     else
          lpWritePortByte.ByteData := DoValue;

     ErrCde := DRV_WritePortByte(DeviceHandle, lpWritePortByte);
     If (ErrCde <> 0) Then
     begin
          DRV_GetErrorMessage(ErrCde, pszErrMsg);
          Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
          Exit;
     end;
end;

procedure Tfrmrun.cmdWriteWordClick(Sender: TObject);
begin
     lpWritePortWord.port := gwPort;
     if (DoValue > $FFFF) then
          lpWritePortWord.WordData := -1  {-1 in memory is 65535}
     else
          lpWritePortWord.WordData := DoValue;

     ErrCde := DRV_WritePortWord(DeviceHandle, lpWritePortWord);
     If (ErrCde <> 0) Then
     begin
          DRV_GetErrorMessage(ErrCde, pszErrMsg);
          Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
          Exit;
     end;
end;

procedure Tfrmrun.cmdWriteDwordClick(Sender: TObject);
begin
     lpWritePortDword.port := gwPort;
     lpWritePortDword.WordData := DoValue;

     ErrCde := DRV_WritePortDword(DeviceHandle, lpWritePortDword);
     If (ErrCde <> 0) Then
     begin
          DRV_GetErrorMessage(ErrCde, pszErrMsg);
          Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
          Exit;
     end;
end;

procedure Tfrmrun.cmdReadByteClick(Sender: TObject);
var
     DiStr : string[5];
begin
     DiValue := 0;
     lpReadPortByte.port := gwPort;
     lpReadPortByte.ByteData := @DiValue;
     ErrCde := DRV_ReadPortByte(DeviceHandle, lpReadPortByte);
     If (ErrCde <> 0) Then
     begin
          DRV_GetErrorMessage(ErrCde, pszErrMsg);
          Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
          Exit;
     end;
    txtByte.Text := Format('%x',[DiValue]);
end;

procedure Tfrmrun.cmdReadWordClick(Sender: TObject);
var
     DiStr : string[5];
begin
     DiValue := 0;
     lpReadPortWord.port := gwPort;
     lpReadPortWord.WordData := @DiValue;
     ErrCde := DRV_ReadPortWord(DeviceHandle, lpReadPortWord);
     If (ErrCde <> 0) Then
     begin
          DRV_GetErrorMessage(ErrCde, pszErrMsg);
          Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
          Exit;
     end;

    txtWord.Text := Format('%x',[DiValue]);
end;
end.





⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -