📄 frmtag.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 + -