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

📄 frmtag.pas

📁 DelphiOPCClien delphi 编写的opc客户端 源程序代码
💻 PAS
字号:
unit frmTag;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  PItem = ^TItem;
  TItem = record
    Name: string;
    FullName: string;
  end;

type
  TfrmTagMgr = class(TForm)
    Label1: TLabel;
    lblServer: TLabel;
    tvTags: TTreeView;
    btnAddTag: TButton;
    Button2: TButton;
    Label3: TLabel;
    cmbGroup: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tvTagsExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure tvTagsDblClick(Sender: TObject);
    procedure btnAddTagClick(Sender: TObject);
  private
    AllocTags: TList;
    CurNode: TTreeNode;
    procedure PopulateAddedGroup;
    procedure PopulateTags;
    procedure BrowseTags;
    procedure FillTags(BrowseType: WORD);
  public
    { Public declarations }
  end;

var
  frmTagMgr: TfrmTagMgr;

implementation

{$R *.dfm}

uses
  HFOPCClient, Data, main;

procedure TfrmTagMgr.FillTags(BrowseType: WORD);
var
  Count: Integer;
  I: Integer;
  ItemName: array[0..255] of char;
  ItemFullName: array[0..255] of char;
  ptrItem: PItem;
  tempNode: TTreeNode;
begin
  Count := BrowseItems(ServerData.HServer, BrowseType);
  if Count > 0 then
  begin
    for I := 0 to Count - 1 do
    begin
      if GetItemName(ServerData.HServer, I, ItemName, 255) and
        GetItemFullName(ServerData.HServer, I, ItemFullName, 255) then
      begin
        New(ptrItem);
        ptrItem^.Name := ItemName;
        ptrItem^.FullName := ItemFullName;
        tempNode := tvTags.Items.AddChildObject(CurNode, ItemName, ptrItem);
        AllocTags.Add(ptrItem);
        if BrowseType = OPC_BRANCH then
          tempNode.HasChildren := True;
      end;
    end;
  end;
end;

procedure TfrmTagMgr.BrowseTags;
var
  tempStrList: TStringList;
  I: Integer;
  tempNode: TTreeNode;
begin
  tempStrList := TStringList.Create;
  if CurNode <> nil then
  begin
    tempNode := CurNode;
    repeat
      tempStrList.Add(tempNode.Text);
      tempNode := tempNode.Parent;
    until tempNode = nil;
    for I := tempStrList.Count - 1 downto 0 do
    begin
      ChangeBrowsePosition(ServerData.HServer, OPC_BROWSE_DOWN, PChar(tempStrList[I]));
    end;
  end;

  FillTags(OPC_BRANCH);
  FillTags(OPC_LEAF);

  while true do
  begin
    if not ChangeBrowsePosition(ServerData.HServer, OPC_BROWSE_UP, '') then
      break;
  end;
end;

procedure TfrmTagMgr.PopulateTags;
var
  NameSpace: WORD;
begin
  if GetNameSpace(ServerData.HServer, NameSpace) then
  begin
    if NameSpace = OPC_NS_FLAT then
      FillTags(OPC_FLAT)
    else if NameSpace = OPC_NS_HIERARCHIAL then
      BrowseTags;
  end;
end;

procedure TfrmTagMgr.FormCreate(Sender: TObject);
begin
  lblServer.Caption := ServerData.ServerName;
  AllocTags := TList.Create;
  CurNode := nil;
  PopulateAddedGroup;
  PopulateTags;
end;

procedure TfrmTagMgr.PopulateAddedGroup;
var
  I: Integer;
begin
  cmbGroup.Clear;
  for I := 0 to ServerData.Groups.Count - 1 do
  begin
    cmbGroup.Items.Add(ServerData.Groups.Strings[I]);
  end;
  cmbGroup.ItemIndex := 0;
end;

procedure TfrmTagMgr.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to AllocTags.Count - 1 do
    Dispose(AllocTags[I]);
  AllocTags.Free;
end;

procedure TfrmTagMgr.tvTagsExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
begin
  CurNode := Node;
  if CurNode.getFirstChild <> nil then
    Exit;
  PopulateTags;
end;

procedure TfrmTagMgr.tvTagsDblClick(Sender: TObject);
begin
  btnAddTagClick(nil);
end;

procedure TfrmTagMgr.btnAddTagClick(Sender: TObject);
var
  SelNode: TTreeNode;
  Index: Integer;
begin
  SelNode := tvTags.Selected;
  if SelNode <> nil then
  begin
    if cmbGroup.Text = '' then
      ShowMessage('请为此服务器至少增加一个组!');

    Index := ServerData.Groups.IndexOf(cmbGroup.Text);
    if Index = -1 then
      Exit;

    FrmMain.AddToTagList(ServerData.HServer, THandle(ServerData.Groups.Objects[Index]),
      cmbGroup.Text, PItem(SelNode.Data)^.FullName);
  end;
end;

end.

⌨️ 快捷键说明

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