unit1.pas.~949~

自动化控制visio

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Visio_TLB, OleCtnrs, StrUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    VisioApp: VisioApplication;
    visioDoc: Document;
    //visioWnd: Window;
    visioShapes: Shapes;
    visioShape, visioshape1: Shape;
    visioPage: Page;
    procedure GetSubShapes(ASubsysName: string);
    procedure DeleteParents(vsoShape: Shape; PreShape: Shape);
  public
    { Public declarations }
    procedure GetCode(ToSheet: Shape; FromSheetName: string = '');
  end;

  TGraphRec = packed record
    left: Double;
    top: Double;
    height: Double;
    width: Double;
    text: string;
    linkerheadnode: string;
    linkertailnode: string;
  end;

var
  Form1: TForm1;

implementation

uses
  OleCtrls;

{$R *.dfm}
var
    vsoWindow: Window;
    vsoSelection: Selection;
{*
  根据传入的参数str判断新建或打开绘图文件
  str: str = ''  新建
       str = filename  打开
*}
procedure OpenDocument(App: VisioApplication; str: WideString);
begin
  if str <> '' then
    App.Documents.Open(str)
  else
    App.Documents.Add('');
end;

{*
  在页上放置图形
  visPage:要画图形的页
  ObjectToDrop:要画的图形
  pinX, pinY: 放的位置
*}
function visPgDrop(visPage: Page; const ObjectToDrop: IUnknown; pinX, pinY: Double): Shape;
var
  visApp: VisioApplication;
begin
  visApp := visPage.Application;
//  Result := visPage.Drop(ObjectToDrop, pinX, pinY);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  mastersDoc: Document;
  I: Integer;
//  ACommandbars: CommandBars;
begin
  try
    VisioApp := CoVisioApplication.Create;   //启动visio
    VisioApp.Visible := True;
    VisioApp.Settings.ShowChooseDrawingTypePane := False;
    visioDoc := VisioApp.Documents.Add('');
    OpenDocument(VisioApp, ExtractFilePath(Application.ExeName) + 'aaa.vsd');
//    mastersDoc := visioDoc.Application.Documents.OpenEx(ExtractFilePath(Application.ExeName) + 'vdesign.vss', visOpenDocked);
    {
    if OpenDialog1.Execute then
      OpenDocument(VisioApp, OpenDialog1.FileName)
    else
      OpenDocument(VisioApp, '');
     }
            //显示visio

//    for I := 1 to mastersDoc.Masters.Count do
//    begin
//      Memo1.Lines.Add(mastersDoc.Masters.ItemU[I].NameU + mastersDoc.Masters.ItemU[I].Name);
//    end;
    Button2.Enabled := True;
    Button3.Enabled := True;
    Button4.Enabled := True;
    Button6.Enabled := True;


//    Memo1.Lines.Clear;
//    ACommandbars := CommandBars(VisioApp.CommandBars);

  except
      VisioApp.Quit;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button2.Enabled := False;
  Button3.Enabled := False;
  Button4.Enabled := False;
  Button6.Enabled := False;
  VisioApp.Quit;
end;

//procedure DeleteParents(vsoShape: Shape; PreShape: Shape);
//var
//  I, J: Integer;
//  LineShape: Shape;
//  shapeConns: Connects;
//  shapeToCell: Cell;
//begin
//  vsoSelection.Select(vsoShape, visSelect);
//  if vsoShape.FromConnects <> nil then
//  begin
//    shapeConns := vsoShape.FromConnects;      //连接线的集合
//    for J := 1 to shapeConns.Count do
//    begin
//      shapeToCell := shapeConns[J].FromCell;   //线连接的点
//      if shapeToCell.Name = 'BeginX' then     //自己连出去的线
//      begin
//        LineShape := shapeToCell.Shape;
//        //连接线两端1是自己，2是连接的图形
//        Memo1.Lines.Add(vsoShape.Text);
//        if LineShape.Connects[2].ToSheet.Text <> PreShape.Text then
//          DeleteParents(LineShape.Connects[2].ToSheet, vsoShape);
//      end;
////      if shapeToCell.Name = 'EndX' then      //连接到自己的线
////      begin
////        LineShape := shapeToCell.Shape;
////        DeleteParents(LineShape.Connects[1].ToSheet, vsoShape);
////      end;
//    end;
//  end;
////  vsoShape.Delete;
//end;

//procedure GetSubShapes(ASubsysName: string);
//var
//  I: Integer;
//  vsoShape, LineShape: Shape;
//  shapeConns: Connects;
//  J: Integer;
//  shapeToCell: Cell;
//  vsoApp: VisioApplication;
//  vsoPage: Page;
//  vsoShapes: Shapes;
//  vsoDoc: Document;
//  PosI: Boolean;
//
//begin
////  if CoVisioApplication = nil then
////  begin
////    ShowError('找不到Microsoft Office Visio程序！');
////    Exit;
////  end;
//
//  try
//    vsoApp := CoVisioApplication.Create;
//    vsoApp.Visible := False;
//    vsoApp.Settings.ShowChooseDrawingTypePane := False;
//    vsoApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'aaa.vsd');
//    vsoDoc := vsoApp.Documents[1];
//    vsoApp.ActiveWindow.Zoom := 1;
//    vsoApp.ActiveWindow.ZoomLock := False;
//    vsoPage := vsoApp.ActivePage;
//    vsoShapes := vsoPage.Shapes;
//    vsoWindow := vsoApp.ActiveWindow;
//    vsoSelection := vsoWindow.Selection;
////    vsoWindow.Select(vsoShape, 1);
//    for I := 1 to vsoShapes.Count do
//    begin
//      vsoShape := vsoShapes[I];
//      PosI := AnsiStartsText('保留', vsoshape.Text);
//      if PosI then
//      begin
//        if vsoShape.FromConnects <> nil then
//        begin
//          shapeConns := vsoShape.FromConnects;
//          for J := 1 to shapeConns.Count do
//          begin
////            ConnShape := shapeConns[J].FromSheet;
//            shapeToCell := shapeConns[J].FromCell;
//            if shapeToCell.Name = 'BeginX' then
//            begin
//              LineShape := shapeToCell.Shape;
//              vsoSelection.Select(vsoShape, visSelect);
//
//              DeleteParents(LineShape.Connects[2].ToSheet, vsoShape);
//            end;
//          end;
//        end;
//      end;
//    end;
//    vsoWindow.Selection.Copy(visCopyPasteNormal);
////    vsoWindow.Copy;
////    vsoDoc.Close;
//    vsoApp.Documents.Add('');
//
////    vsoDoc := vsoApp.ActiveDocument;
//    vsoPage.Paste(visCopyPasteNormal);
//
//    vsoDoc.SaveAsEx(ExtractFilePath(Application.ExeName) + 'aaa1.vsd', 0);
//  finally
//    vsoApp.Quit;
//  end;
//end;

procedure TForm1.Button3Click(Sender: TObject);
var
  idx: Integer;
begin
//  visioPage := VisioApp.Documents[1].Pages[1];
//  with visioPage do
//  begin
//    Memo1.Lines.Clear;
//    for idx := 1 to Shapes.Count do
//    begin
//      visioShape := Shapes[idx];
//      if visioShape.Name = '页面内引用.'+ IntToStr(idx) then
//      begin
//        Memo1.Lines.Add(visioShape.Name);
//      end;
//    end;
//  end;
  GetSubShapes('');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  I, J, K, docI, pageI, shapeI: Integer;
  shapeConns, LineshapeConns: Connects;
  shapeConnsJ: Connect;
  ConnShape, LineShape,ConnedShape: Shape;
  shapeCell, shapeToCell: Cell;
  x, y: Double;
  startPos: Integer;
  str: WideString;
begin
  with Memo1.Lines do
  begin
    Clear;
    for docI := 1 to VisioApp.Documents.Count do
    begin
      visioDoc := VisioApp.Documents[docI];
      Add(visioDoc.Name);

      for pageI := 1 to visioDoc.Pages.Count do
      begin
        visioPage :=  visioDoc.Pages[pageI];
        Add('----Page.Name:' + visioPage.Name);

        for shapeI := 1 to visioPage.Shapes.Count do
        begin


          visioShape := visioPage.Shapes[shapeI];
          startPos := pos('.', visioShape.Name);
          if (startPos > 0) then
            str := LeftStr(visioShape.Name, startPos-1)
          else str := visioShape.Name;

          if str = '总经理' then
          begin
            Add('--------Shape.Name:' + visioShape.Name);
            Add('--------Shape.Text:' + visioShape.Text);

            visioShape.XYFromPage(x, y, x, y);
            //shapeCell := visioShape.get_CellsSRC(visXFormPinX, 1, 1);
             Add('--------X:' + FloatToStr(x));