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

📄 setting.pas

📁 Monitor.dfm Meter.dpr pasMain.pas
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Setting;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Spin, ExtCtrls, ImgList, Buttons, DBCtrls;

type
  TfrmSetup = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    Button2: TButton;
    GroupBox10: TGroupBox;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox3: TGroupBox;
    Image1: TImage;
    Timer1: TTimer;
    ImageList1: TImageList;
    LocalPanel: TPanel;
    Button4: TButton;
    GroupBox11: TGroupBox;
    RemotePanel: TPanel;
    btnReadC: TButton;
    btnStopC: TButton;
    TSegListView: TListView;
    Button7: TButton;
    Button8: TButton;
    Image3: TImage;
    tNAMElab: TLabel;
    IDListView: TListView;
    Image4: TImage;
    nNAMElab: TLabel;
    SetID_Btn: TButton;
    GetID_Btn: TButton;
    TabSheet5: TTabSheet;
    Button10: TButton;
    ClrID_Btn: TButton;
    cNAMElab: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Image5: TImage;
    StatusLab: TLabel;
    PortCB: TDBComboBox;
    RateCB: TDBComboBox;
    DataCB: TDBComboBox;
    ParityCB: TDBComboBox;
    StopCB: TDBComboBox;
    Button12: TButton;
    PrgBar: TProgressBar;
    GroupBox5: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label6: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    ReadCB: TComboBox;
    CnstCB: TComboBox;
    FreCB: TComboBox;
    TestCB: TComboBox;
    Conu_E: TEdit;
    Skip_E: TEdit;
    Label13: TLabel;
    FreTime_E: TEdit;
    Image6: TImage;
    sNameLab: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    btnStopS: TButton;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Num_E: TEdit;
    AronCB: TComboBox;
    TarCB: TComboBox;
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure btnReadCClick(Sender: TObject);
    procedure btnStopCClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ClrID_BtnClick(Sender: TObject);
    procedure SetID_BtnClick(Sender: TObject);
    procedure GetID_BtnClick(Sender: TObject);
    procedure IDListViewCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure IDListViewColumnClick(Sender: TObject; Column: TListColumn);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure btnStopSClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmSetup: TfrmSetup;

implementation

{$R *.DFM}

uses Global, Info, pasMain, DM, Promot, err,readdata;

procedure TfrmSetup.Timer1Timer(Sender: TObject);
begin
    LocalPanel.Caption := CurTime;
end;


procedure TfrmSetup.Button2Click(Sender: TObject);
begin
        frmMain.TimerOut.Enabled := False;
        TimeoutF := True;
        ActiveCommand := FALSE;
        Timer1.Enabled := FALSE;
        Close;
end;


procedure TfrmSetup.FormCreate(Sender: TObject);
begin
    Left := ( frmMain.Width - Width ) div 2;
    Top := ( frmMain.Height - Height ) div 2;
end;

procedure TfrmSetup.Button12Click(Sender: TObject);
begin

    frmSetup.Cursor := crHourGlass;

    if DM1.ProtocalDB.RecordCount > 0 then
        DM1.ProtocalDB.Edit
    else
        DM1.ProtocalDB.Append;

    DM1.ProtocalDB.FieldByName('COM').AsString := PortCB.Text;
    DM1.ProtocalDB.FieldByName('RATE').AsString := RateCB.Text;
    DM1.ProtocalDB.FieldByName('DATABIT').AsString := DataCB.Text;
    DM1.ProtocalDB.FieldByName('PARITYBIT').AsString := ParityCB.Text;
    DM1.ProtocalDB.FieldByName('STOPBIT').AsString := StopCB.Text;
    DM1.ProtocalDB.Post;
    DM1.ProtocalDB.FlushBuffers;
    DM1.ProtocalDB.refresh;
    
    if SetupCommunication(Sender) then
    begin
        StatusLab.Caption := '通信端口: [' + PortCB.Text + '] 设置成功!';
    end
    else
    begin
        WarnAbout.Hide;
        WarnAbout.Promot.Caption := '通信端口: ' + PortCB.Text + ' 已经被占用!';
        WarnAbout.ShowModal;
    end;

    frmSetup.Cursor := crDefault;
end;


procedure TfrmSetup.PageControl1Change(Sender: TObject);
begin

    StatusLab.Caption := '';

    case PageControl1.ActivePageIndex of
    0:  begin
            Timer1.Enabled := False;
            PortCB.Text := DM1.ProtocalDB.FieldByName('COM').AsString;
            RateCB.Text := DM1.ProtocalDB.FieldByName('RATE').AsString ;
        end;
    1:  begin
            Timer1.Enabled := True;
        end;
    2:  begin
            Timer1.Enabled := False;

            if TSegListView.Items.Count > 0 then
            begin
                TSegListView.SetFocus;
                TSegListView.Items[0].Selected := True;
                TSegListView.Items[0].Focused := True;
            end;
        end;
    3:  begin
            Timer1.Enabled := False;
            if IDListView.Items.Count > 0 then
            begin
                IDListView.SetFocus;
                IDListView.Items[0].Selected := True;
                IDListView.Items[0].Focused := True;
            end;
        end;
    4:  begin
            Timer1.Enabled := False;
        end;
    end;


end;

procedure TfrmSetup.btnReadCClick(Sender: TObject);
var
    rStr,password: String;
begin

    ActiveCommand := TRUE;

    btnReadC.Enabled := False;
    BreakRead := False;

    StatusLab.Caption := '正在读取集中器时钟...';

    while   BreakRead = False do
    begin
        if not ActiveCommand then break;
        Application.ProcessMessages;
        if not ActiveCommand then break;
        if PutTXD('L' + Chr(13), 14, rStr, 2000) and (Copy(rStr, 13, 1) = Chr(13)) and (Copy(rStr, 1, 4) <> _Lock)then
            RemotePanel.Caption := '20' + Copy(rStr, 1, 2) + '-' +
                                   Copy(rStr, 3, 2) + '-' + Copy(rStr, 5, 2) + ' ' +
                                   Copy(rStr, 7, 2) + ':' + Copy(rStr, 9, 2) + ':' + Copy(rStr, 11, 2);
        if Copy(rStr, 1, 4) = _Lock then
        begin
                password:= InputBox('请输入集中器口令', '口令为6个字符','666666');
                if PutTXD('PWR'+password+chr(13), 8, rStr, 2000) and (Copy(rStr, 1, 6) = _Unlock) then continue;
        end;

    end;
    activecommand:=false;
    StatusLab.Caption := '停止读取集中器时钟!';
end;


procedure TfrmSetup.btnStopCClick(Sender: TObject);
begin
    btnReadC.Enabled := True;
    BreakRead := True;
    activecommand:=false;
end;

procedure TfrmSetup.Button4Click(Sender: TObject);
var
    I: integer;
    sBuf, rStr, rTime,password: string;
begin
    StatusLab.Caption := '';
    activecommand:=true;
    for I := 1  to 3 do
    begin
        rTime := CurTime;
        sBuf := 'C'+
                Copy(rTime, 3, 2) + Copy(rTime, 6, 2) + Copy(rTime, 9, 2) +
                Copy(rTime, 12, 2) + Copy(rTime, 15, 2) + Copy(rTime, 18, 2) +
                Chr(13);
        if PutTXD(sBuf, 4, rStr, 1000) and (Copy(rStr, 1, 4) = _OK) then break;
        if Copy(rStr, 1, 4) = _Lock then
        begin
                password:= InputBox('请输入集中器口令', '口令为6个字符','666666');
                if PutTXD('PWR'+password+chr(13), 8, rStr, 2000) and (Copy(rStr, 1, 6) = _Unlock) then continue;
        end;
    end;
    activecommand:=false;

    if I <= 3 then
        StatusLab.Caption := '设置集中器时钟成功'
    else
        StatusLab.Caption := '未建立数据链路或未通过集中器口令检测'


end;


procedure TfrmSetup.Button7Click(Sender: TObject);
var
    I: Integer;
    sBuf, rStr,password: string;
begin

    if TSegListView.Items.Count <= 0 then
    begin
        WarnAbout.Hide;
        WarnAbout.Promot.Caption := '数据库中无抄表时段!';
        WarnAbout.ShowModal;
        exit;
    end;

    frmPromot.Hide;
    frmPromot.Promot.Caption := '是否装载抄表时段?';
    if frmPromot.ShowModal <> mrOK then exit;

    TSegListView.SetFocus;

    activecommand:=true;
    I := 0;
    while TSegListView.Items[I].SubItems.Strings[0] <> '' do
    begin
        TSegListView.Items[I].Selected := True;
        TSegListView.Items[I].Focused :=True;

        sBuf := TSegListView.Items[I].SubItems.Strings[0];

        StatusLab.Caption := 'UpLoading No.[' + IntToStr(I + 1) + '] Time:' + sBuf;

        sBuf := _SetTseg + Copy(sBuf, 1, 2) + Copy(sBuf, 4, 2) + Copy(sBuf, 7, 2) + Copy(sBuf, 10, 2) + _CR;

        if (PutTXD(sBuf, _OKlen, rStr,4000) = False) or (rStr <> _OK) then
        begin
            StatusLab.Caption := '未建立数据链路或未通过口令检测!';
            if Copy(rStr, 1, 4) = _Lock then
                begin
                        password:= InputBox('请输入集中器口令', '口令为6个字符','666666');
                        if PutTXD('PWR'+password+chr(13), 8, rStr, 2000) and (Copy(rStr, 1, 6) = _Unlock) then continue;

                        activecommand:=false;
                        exit;
                end;
        end;

        I := I + 1;
    end;

    StatusLab.Caption := '设置抄表时段成功!';
    activecommand:=false;
end;

procedure TfrmSetup.Button10Click(Sender: TObject);
var
    I: integer;
    rStr,password: string;
begin
    frmPromot.Hide;
    frmPromot.Promot.Caption := '是否清除抄表时段?';
    if frmPromot.ShowModal <> mrOK then exit;
    activecommand:=true;
    for I := 0 to _MaxTsegNum - 1 do
    begin
        with TSegListView do
        begin
            Items[I].SubItems.Strings[1] := '';
            Items[I].SubItems.Strings[2] := '';
        end;
    end;
    for I := 1  to 3 do
    begin
        if (PutTXD(_ClrTseg, _OKlen, rStr,4000) = True) and (Copy(rStr, 1, 2) = 'OK') then
        begin
            StatusLab.Caption := '清除抄表时段成功!';
            activecommand:=false;
            exit;
        end;
        if Copy(rStr, 1, 4) = _Lock then
        begin
                password:= InputBox('请输入集中器口令', '口令为6个字符','666666');
                if PutTXD('PWR'+password+chr(13), 8, rStr, 2000) and (Copy(rStr, 1, 6) = _Unlock) then continue;
        end;
    end;

    StatusLab.Caption := '未建立数据链路或未通过口令检测!';
    activecommand:=false;
end;

procedure TfrmSetup.Button8Click(Sender: TObject);
var
    I, Num: Integer;
    rStr,password: string;
begin
    //Clear time segment
    activecommand:=true;
    for I := 0 to _MaxTsegNum - 1 do
    begin
        with TSegListView do
        begin
            Items[I].SubItems.Strings[1] := '';
            Items[I].SubItems.Strings[2] := '';
        end;
    end;

    StatusLab.Caption := '';

    TSegListView.SetFocus;

    if (PutTXD(_GetTseg, 9, rStr, 3000) = False) or (Copy(rStr, 1, 1) <> 'N') or (Copy(rStr, 8, 2) <> _CRLF) then
    begin
        if Copy(rStr, 1, 4) = _Lock then
        begin
                password:= InputBox('请输入集中器口令', '口令为6个字符','666666');
                if PutTXD('PWR'+password+chr(13), 8, rStr, 2000) and (Copy(rStr, 1, 6) = _Unlock) then
                StatusLab.Caption := '通过口令检测,请重新操作!'
                else
                StatusLab.Caption := '未通过口令检测!';
        end;
        activecommand:=false;
        exit;
    end;

    //if Num > _MaxTsegNum, error
    Num := StrToInt(Copy(rStr, 2, 6));
    if Num > _MaxTsegNum then
    begin
        StatusLab.Caption := '抄表时段数量超长!';
        activecommand:=false;
        exit;
    end;

    for I := 0 to Num -1 do
    begin
        if ( GetRXD(_TsegLen, rStr) = FALSE ) or ( Copy(rStr, 9, 2) <> _CRLF ) then
        begin
            StatusLab.Caption := '下载错误!';
            activecommand:=false;
            exit;
        end;

        TSegListView.Items[I].SubItems.Strings[2] := Copy(rStr, 1, 2) + ':' + Copy(rStr, 3, 2) + '-' + Copy(rStr,5,2) + ':' + Copy(rStr,7,2);
        if TSegListView.Items[I].SubItems.Strings[2] <> TSegListView.Items[I].SubItems.Strings[0] then
        TSegListView.Items[I].SubItems.Strings[1] := '>>';

        TSegListView.Items[I].Selected := True;
        TSegListView.Items[I].Focused := True;
    end;

    StatusLab.Caption := '读取抄表时段成功!';
    activecommand:=false;
end;


procedure TfrmSetup.FormShow(Sender: TObject);
var
    I:Integer;
    ListItem: TListItem;
begin

    cNAMElab.Caption := '台区名称: ' + dNameStr;
    tNAMElab.Caption := '台区名称: ' + dNameStr;
    nNAMElab.Caption := '台区名称: ' + dNameStr;
    sNAMElab.Caption := '台区名称: ' + dNameStr;

    tseglistview.Items.Clear;
    for I := 1 to _MaxTsegNum do
    begin
        with TSegListView do
        begin
            ListItem := Items.add;
            ListItem.Caption := IntToStr(I);
            ListItem.SubItems.Add('');
            ListItem.SubItems.Add('');
            ListItem.SubItems.Add('');
        end;
    end;

    //Load time segment
    DM1.WTMdb.Filter := 'DNO = ' + '''' + DNOstr + '''';
    I := 1;
    while not DM1.WTMdb.Eof do
    with TSegListView do
    begin
        Items[I - 1].SubItems.Strings[0] := DM1.WTMdb.FieldByname('TIMESEG').AsString;
        DM1.WTMdb.Next;
        I := I + 1;

⌨️ 快捷键说明

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