trigger.~pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

unit Trigger;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, TriggerUtil, ImgList, ComCtrls, ToolWin,
  ExtCtrls, Buttons;

type

  TFrm_Trigger = class(TForm)
    ToolBar: TToolBar;
    btn_Open: TToolButton;
    btn_Save: TToolButton;
    ToolButton2: TToolButton;
    ImgListMain: TImageList;
    btn_Add: TToolButton;
    btn_Delete: TToolButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Ed_TriggerName: TEdit;
    Label1: TLabel;
    ed_TriggerData: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    ed_RespondeData: TEdit;
    ed_RespondeDelay: TEdit;
    Label5: TLabel;
    cb_Active: TCheckBox;
    Label6: TLabel;
    ed_Conv: TEdit;
    SpeedButton1: TSpeedButton;
    Label7: TLabel;
    ed_TriggerLen: TEdit;
    tv_Trigger: TTreeView;
    ImageList_TV: TImageList;
    SaveDlg: TSaveDialog;
    OpenDlg: TOpenDialog;
    btn_SaveEdit: TButton;
    btn_CancelEdit: TButton;
    Panel3: TPanel;
    Button1: TButton;
    Button2: TButton;
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure tv_TriggerChanging(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
    procedure tv_TriggerChange(Sender: TObject; Node: TTreeNode);
    procedure btn_OpenClick(Sender: TObject);
    procedure btn_SaveClick(Sender: TObject);
    procedure btn_AddClick(Sender: TObject);
    procedure btn_DeleteClick(Sender: TObject);
    procedure btn_SaveEditClick(Sender: TObject);
    procedure btn_CancelEditClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure tv_TriggerDblClick(Sender: TObject);
  private
    { Private declarations }
    FTrigger: TTrigger;
    FFileName: string;
    procedure SetTrigger(value: TTrigger);
    procedure LoadFromTrigger;
    procedure SaveTriggerInfo(Node: TTreeNode = nil);
  published
    property Trigger: TTrigger read FTrigger write SetTrigger;
  end;

procedure Show_Trigger(oldTrigger: TTrigger; var TriggerFileName: string);

implementation

{$R *.dfm}

procedure Show_Trigger(oldTrigger: TTrigger; var TriggerFileName: string);
begin
  with TFrm_Trigger.Create(Application) do
  begin
    try
      Trigger := oldTrigger;
      FFileName := TriggerFileName;
      LoadFromTrigger;
      if ShowModal = mrOK then
      begin
        oldTrigger.Assign(Trigger);
        TriggerFileName := FFileName;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TFrm_Trigger.SetTrigger(value: TTrigger);
begin
  FTrigger.Assign(value);
end;

procedure TFrm_Trigger.FormCreate(Sender: TObject);
begin
  FTrigger := TTrigger.Create(TTriggerItem);
end;

procedure TFrm_Trigger.FormDestroy(Sender: TObject);
begin
  FTrigger.Free;
end;

procedure TFrm_Trigger.LoadFromTrigger;
var i: Integer;
  Item: TTriggerItem;
  Node: TTreeNode;
begin
  for i := 0 to Trigger.Count - 1 do
  begin
    Item := Trigger[i];
    Node := tv_Trigger.Items.AddChild(nil, Item.TriggerName);
    Node.Data := Item;
    Node.ImageIndex := Integer(Item.Actived);
    Node.SelectedIndex := Node.ImageIndex;
    if i = 0 then Node.Selected := True;
  end;
end;

procedure TFrm_Trigger.SpeedButton1Click(Sender: TObject);
begin
  ed_Conv.Text := StrToHex(ed_Conv.Text);
  ed_Conv.SelectAll;
  ed_Conv.CopyToClipboard;
end;

procedure TFrm_Trigger.tv_TriggerChanging(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
  SaveTriggerInfo;
  AllowChange := True;
end;

procedure TFrm_Trigger.tv_TriggerChange(Sender: TObject; Node: TTreeNode);
var Item: TTriggerItem;
begin
  Item := TTriggerItem(Node.Data);
  if Item = nil then Exit;
  Ed_TriggerName.Text := Item.TriggerName;
  ed_TriggerData.Text := StrToHex(Item.TriggerHead);
  ed_TriggerLen.Text := IntToStr(Item.TriggerLen);
  ed_RespondeData.Text := StrToHex(Item.RespondeData);
  ed_RespondeDelay.Text := IntToStr(Item.RespondeDelay);
  cb_Active.Checked := Item.Actived;
end;

procedure TFrm_Trigger.SaveTriggerInfo(Node: TTreeNode = nil);
var Item: TTriggerItem;
  TriggerHead, RespondeData: string;
  TriggerLen, RespondeDelay: Integer;
begin
  if Node = nil then Node := TV_Trigger.Selected;
  if Node = nil then Exit;
  Item := TTriggerItem(Node.Data);
  TriggerHead := HexToStr(ed_TriggerData.Text);
  RespondeData := HexToStr(ed_RespondeData.Text);
  TriggerLen := StrToInt(ed_TriggerLen.Text);
  RespondeDelay := StrToInt(ed_RespondeDelay.Text);

  if TriggerHead = '' then
    raise Exception.Create('触发数据头不能为空');
  if TriggerLen <= 0 then
    raise Exception.Create('触发数据长度不能为0');

  Item.TriggerName := Ed_TriggerName.Text;
  Item.TriggerHead := TriggerHead;
  Item.TriggerLen := TriggerLen;
  Item.RespondeData := RespondeData;
  Item.RespondeDelay := RespondeDelay;
  Item.Actived := cb_Active.Checked;
  Node.Text := Item.TriggerName;
  Node.SelectedIndex := Integer(Item.Actived);
  Node.ImageIndex := Integer(Item.Actived);
end;

procedure TFrm_Trigger.btn_OpenClick(Sender: TObject);
begin
  if OpenDlg.Execute then
  begin
    Trigger.LoadFromFile(OpenDlg.FileName);
    FFileName := OpenDlg.FileName;
    LoadFromTrigger;
  end;
end;

procedure TFrm_Trigger.btn_SaveClick(Sender: TObject);
begin
  if FFileName = '' then
  begin
    if SaveDlg.Execute then
    begin
      if FileExists(SaveDlg.FileName) then
        if MessageBox(Handle, '文件已经存在，覆盖吗？', '警告', MB_ICONWARNING + MB_YESNO + MB_APPLMODAL) = IDNo then
          Exit;
      FFileName := SaveDlg.FileName;
    end;
  end;
  SaveTriggerInfo;
  Trigger.SaveToFile(FFileName);
end;

procedure TFrm_Trigger.btn_AddClick(Sender: TObject);
var Item: TTriggerItem;
  Node: TTreeNode;
begin
  SaveTriggerInfo;
  Item := Trigger.Add as TTriggerItem;
  Node := tv_Trigger.Items.AddChild(nil, Item.TriggerName);
  Node.Data := Item;
  Node.ImageIndex := Integer(Item.Actived);
  Node.SelectedIndex := Node.ImageIndex;
  Node.Selected := True;
end;

procedure TFrm_Trigger.btn_DeleteClick(Sender: TObject);
var Item: TTriggerItem;
  Node: TTreeNode;
begin
  Node := Tv_Trigger.Selected;
  if Node = nil then Exit;
  Item := TTriggerItem(Node.Data);
  Tv_Trigger.Items.Delete(Node);
  Trigger.Delete(Item.ID);
end;

procedure TFrm_Trigger.btn_SaveEditClick(Sender: TObject);
begin
  SaveTriggerInfo;
end;

procedure TFrm_Trigger.btn_CancelEditClick(Sender: TObject);
begin
  if Tv_Trigger.Selected = nil then Exit;
  tv_TriggerChange(self, Tv_Trigger.Selected);
end;

procedure TFrm_Trigger.Button1Click(Sender: TObject);
begin
  SaveTriggerInfo;
  Trigger.SaveToFile(FFileName);
  ModalResult := mrOK;
end;

procedure TFrm_Trigger.tv_TriggerDblClick(Sender: TObject);
var Node: TTreeNode;
  Item: TTriggerItem;
begin
  Node := Tv_Trigger.Selected;
  if Node = nil then Exit;
  Item := TTriggerItem(Node.Data);
  Item.Actived := not Item.Actived;
  Node.ImageIndex := Integer(Item.Actived);
  Node.SelectedIndex := Node.ImageIndex;
  cb_Active.Checked := Item.Actived;
end;

end.