main.pas

DelphiOPCClien delphi 编写的opc客户端 源程序代码

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdActns, ActnList, ActnMan, ToolWin, ActnCtrls,
  ActnMenus, ImgList, ComCtrls, XPStyleActnCtrls;

type
  TFrmMain = class(TForm)
    ActionManager1: TActionManager;
    ActionConnect: TAction;
    ActionGroup: TAction;
    ActionTag: TAction;
    ActionDisConn: TAction;
    FileExit1: TFileExit;
    ActionAbout: TAction;
    ImageList1: TImageList;
    ActionMainMenuBar2: TActionMainMenuBar;
    ActionToolBar1: TActionToolBar;
    ListView1: TListView;
    StatusBar1: TStatusBar;
    PopupMenu1: TPopupMenu;
    mnuActive: TMenuItem;
    mnuDeActive: TMenuItem;
    N3: TMenuItem;
    mnuWrite: TMenuItem;
    procedure ActionConnectExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ActionTagExecute(Sender: TObject);
    procedure ActionDisConnExecute(Sender: TObject);
    procedure ActionAboutExecute(Sender: TObject);
    procedure ActionGroupExecute(Sender: TObject);
    procedure FreeTagList;
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ListView1ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure mnuActiveClick(Sender: TObject);
    procedure mnuDeActiveClick(Sender: TObject);
    procedure SetActiveItem(bActive: Boolean);
    procedure mnuWriteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  public
    procedure AddToTagList(HServer, HGroup: THandle; GroupName, ItemID: string);
  end;

var
  FrmMain: TFrmMain;

  procedure OnDataChange(hConnect, hGroup, hItem: THANDLE;
    ItemValue: POleVariant; ItemTime: FILETIME; Quality: DWORD); stdcall;

implementation

{$R *.dfm}
uses
  HFOPCClient, Data, frmConnect, frmGroup, frmTag, frmAbout;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  ActionDisConnExecute(nil);
  Uninit;
end;

procedure TFrmMain.ActionConnectExecute(Sender: TObject);
var
  frm: TFrmConnServer;
begin
  frm := TFrmConnServer.Create(nil);
  try
    if (frm.ShowModal = mrOK) and (frm.strServer <> '') then
    begin
      ServerData.ServerName := frm.strServer;
      ServerData.HServer := Connect(PChar(frm.strMachine), PChar(frm.strServer));

      if ServerData.HServer = INVALID_HANDLE_VALUE then
        ShowMessage('连接OPC服务器失败!');

      SetDataChangeProc(ServerData.HServer, @OnDataChange);

      ActionConnect.Enabled := False;
      ActionDisConn.Enabled := True;
      ActionGroup.Enabled := True;
      ActionTag.Enabled := False;
    end;
  finally
    frm.Free;
  end;
end;

procedure TFrmMain.ActionDisConnExecute(Sender: TObject);
begin
  if ServerData.HServer <> INVALID_HANDLE_VALUE then
  begin
    ServerData.RemoveAllGroup;
    FreeTagList;
    Disconnect(ServerData.HServer);
  end;

  ActionConnect.Enabled := True;
  ActionDisConn.Enabled := False;
  ActionGroup.Enabled := False;
  ActionTag.Enabled := False;
end;

procedure TFrmMain.ActionGroupExecute(Sender: TObject);
var
  frm: TfrmGroupMgr;
begin
  frm := TfrmGroupMgr.Create(nil);
  try
    frm.ShowModal;
    if ServerData.Groups.Count > 0 then
      ActionTag.Enabled := True
    else
      ActionTag.Enabled := False;
  finally
    frm.Free;
  end;
end;

procedure TFrmMain.ActionTagExecute(Sender: TObject);
var
  frm: TfrmTagMgr;
begin
  frm := TfrmTagMgr.Create(nil);
  try
    frm.ShowModal;
  finally
    frm.Free;
  end;
end;

procedure TFrmMain.ActionAboutExecute(Sender: TObject);
begin
  with TAboutBox.Create(nil) do
  begin
    ShowModal;
    Free;
  end;
end;

procedure TFrmMain.AddToTagList(HServer, HGroup: THandle; GroupName, ItemID: string);
var
  hItem: THandle;
  ListItem: TListItem;
  ptrGroupItem: PGroupItem;
  vt: TVarType;
  right: DWORD;
begin
  hItem := AddItem(HServer, HGroup, PChar(ItemID));

  if hItem = INVALID_HANDLE_VALUE then
  begin
    ShowMessage('添加标签失败！');
    Exit;
  end;

  New(ptrGroupItem);
  ptrGroupItem^.GroupHandle := HGroup;
  ptrGroupItem^.ItemHandle := hItem;

  if ValidateItem(HServer, HGroup, PChar(ItemID), vt, right) then
  begin
    ptrGroupItem^.vt := vt;
    ptrGroupItem^.right := right;
  end;

  ListItem := ListView1.Items.Add;
  ListItem.Caption := ItemID;
  ListItem.SubItems.Add(VarTypeAsText(vt));
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add(GetRightStr(right));
  ListItem.SubItems.Add(GroupName);
  ListItem.Data := ptrGroupItem;
end;

procedure TFrmMain.FreeTagList;
var
  I: Integer;
  ptrGroupItem: PGroupItem;
begin
  for I := 0 to ListView1.Items.Count - 1 do
  begin
    ptrGroupItem := PGroupItem(ListView1.Items[I].Data);
    RemoveItem(ServerData.HServer, ptrGroupItem^.GroupHandle, ptrGroupItem^.ItemHandle);
    Dispose(ptrGroupItem);
  end;
  ListView1.Clear;
end;

procedure OnDataChange(hConnect, hGroup, hItem: THANDLE;
  ItemValue: POleVariant; ItemTime: FILETIME; Quality: DWORD); stdcall;
var
  I: Integer;
  ListItem: TListItem;
  ptrGroupItem: PGroupItem;
begin
  for I := 0 to FrmMain.ListView1.Items.Count - 1 do
  begin
    ListItem := FrmMain.ListView1.Items[I];
    ptrGroupItem := PGroupItem(ListItem.Data);
    if (ptrGroupItem^.GroupHandle = hGroup) and
      (ptrGroupItem^.ItemHandle = hItem) then
    begin
      try
        ListItem.SubItems[1] := ItemValue^;
        ListItem.SubItems[2] := GetQualityStr(Quality);
        ListItem.SubItems[3] := GetTimeStr(ItemTime);
      except
      end;
    end;
  end;
end;

procedure TFrmMain.PopupMenu1Popup(Sender: TObject);
var
  ListItem: TListItem;
  ptrGroupItem: PGroupItem;
begin
  ListItem := ListView1.Selected;
  if ListItem = nil then Exit;
  ptrGroupItem := PGroupItem(ListItem.Data);

  if ptrGroupItem.right and OPC_WRITEABLE = OPC_WRITEABLE then
    mnuWrite.Visible := True
  else
    mnuWrite.Visible := False;
end;

procedure TFrmMain.ListView1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
  if ListView1.Selected = nil then
    Handled := True;
end;

procedure TFrmMain.SetActiveItem(bActive: Boolean);
var
  ListItem: TListItem;
  ptrGroupItem: PGroupItem;
begin
  ListItem := ListView1.Selected;
  if ListItem = nil then Exit;
  ptrGroupItem := PGroupItem(ListItem.Data);
  ActiveItem(ServerData.HServer, ptrGroupItem^.GroupHandle,
    ptrGroupItem^.ItemHandle, bActive);
end;

procedure TFrmMain.mnuActiveClick(Sender: TObject);
begin
  SetActiveItem(True);
end;

procedure TFrmMain.mnuDeActiveClick(Sender: TObject);
begin
  SetActiveItem(False);
end;

procedure TFrmMain.mnuWriteClick(Sender: TObject);
var
  ValueStr: string;
  value: Variant;
  ListItem: TListItem;
  ptrGroupItem: PGroupItem;
begin
  ListItem := ListView1.Selected;
  if ListItem = nil then Exit;
  ptrGroupItem := PGroupItem(ListItem.Data);

  ValueStr := InputBox('请输入一个值', '', '0');
  value := ValueStr;
  try
    value := VarAsType(value, ptrGroupItem^.vt);
  except
  end;

  WriteItem(ServerData.HServer, ptrGroupItem^.GroupHandle,
    ptrGroupItem^.ItemHandle, @Value);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  if not Init then
    MessageBox(0, '无法初始化OPC客户端!', '错误', 0);
end;

end.