unit1.pas.~949~

自动化控制visio

end;

function GetName(str: string): string ;
var
  startPos : Integer;
begin
  startPos := pos('.', str);
          if (startPos > 0) then
            Result := LeftStr(str, startPos-1)
          else result := str;
end;

function GetXI(str: string): Integer;
var
  startPos : Integer;
begin
  startPos := pos('.', str);
          if (startPos > 0) then
            Result := StrToInt(MidStr(str, startPos+1, Length(str)));
end;

procedure GetGluePos(Xindex: Integer; height, width: Double;
               var x: Double; var y: Double);
begin
   case Xindex of
    1: begin
        x := x - width / 2;
        y := y;
       end;
    2: begin
        x := x + width / 2;
        y := y;
       end;
    3: begin
        x := x;
        y := y + height / 2;
       end;
    4: begin
        x := x;
        y := y - height / 2;
       end;
   end;
end;

procedure GetLineEndPos(height, width: Double; var x: Double; var y: Double);
begin
  x := x + width;
  y := y + height;
end;

procedure TForm1.GetCode(ToSheet: Shape; FromSheetName: string = '');
var
  I, J, Xindex: Integer;
  lineOnshapeConns, shapeOnLineConns: Connects;
  visFromSheet, visToSheet: Shape;
  graph: TGraphRec;
  filename: TextFile;
  x, y, x1, y1: Double;
  endCell: Cell;
  str: string;
begin
  AssignFile(filename, 'graph.txt');
  try
    Reset(filename);
  lineOnshapeConns := ToSheet.FromConnects;  //获取FromConnects集合 实际是连接线的集合
  for J := 1 to lineOnshapeConns.Count do
  begin
    visFromSheet := lineOnshapeConns[J].FromSheet;   //从FromConnects集合中获取连接线
    if visFromSheet.Name <> FromSheetName then
    begin
      shapeOnLineConns := visFromSheet.Connects;   //获取连接线的Connects集合 实际是连接的图形的集合
      for I := 1 to shapeOnLineConns.Count do
      begin
        visToSheet := shapeOnLineConns[I].ToSheet;    //获取连接线连接的图形
        if (visToSheet.NameU <> ToSheet.NameU) and (GetName(visToSheet.NameU) = 'Process') then
        begin
          Memo1.Lines.Add(ToSheet.Text + '  ' +
                            visFromSheet.Name + '  ' +
                             visFromSheet.Text + '  then  ' +
                              visToSheet.Text);
          //Seek(filename, FileSize(filename));



          x := ToSheet.CellsU['PinX'].Result['mm'];  //实际取得的是中间点的坐标
          y := ToSheet.CellsU['PinY'].Result['mm'];
          //ToSheet.XYFromPage(0, 0, x, y);
          graph.height := ToSheet.CellsU['Height'].Result['mm']; //进程的宽和高
          graph.width := ToSheet.CellsU['Width'].Result['mm'];
          graph.left := x - graph.width / 2;  //还需要坐标变换
          graph.top := y + graph.height / 2;
          ToSheet.XYFromPage(x, y, x1, y1);
          graph.text := ToSheet.Text;
          str := lineOnshapeConns[J].ToCell.Name;
          Xindex := GetXI(str);
          GetGluePos(Xindex, graph.height, graph.width, x, y);//取得连接点的位置
//          x := lineOnshapeConns[J].ToCell.Cells['PinX'].Result['mm'];
//          y := lineOnshapeConns[J].ToCell.CellsU['PinX'].Result['mm']; //连接点
//          x1 := visFromSheet.CellsU['PinX'].Result['mm'];
//          y1 := visFromSheet.CellsU['PinY'].Result['mm'];
          graph.height := visFromSheet.CellsU['Height'].Result['mm'];//连接线的宽和高
          graph.width := visFromSheet.CellsU['Width'].Result['mm'];
          GetLineEndPos(graph.height, graph.width, x, y);
          visfromsheet.XYFromPage(x, y, x1, y1);
          //str := visFromsheet.Name;
//          x := visFromSheet.CellsU['EndX'].Result['mm'];
//          y := visFromSheet.CellsU['EndY'].Result['mm'];
          GetCode(visToSheet, visFromSheet.Name);   //递归调用
        end;
        if visToSheet = nil then Continue;
      end;
    end;
  end;
  finally
    CloseFile(filename);
  end;
end;

procedure TForm1.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 := True;
    vsoApp.Settings.ShowChooseDrawingTypePane := False;
    vsoApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'b.vsd');
//    vsoApp.Documents.Open(ExtractFilePath(Application.ExeName) + 'a.vsd');
    vsoDoc := vsoApp.Documents[1];
    vsoApp.ActiveWindow.Zoom := 1;
    vsoApp.ActiveWindow.ZoomLock := False;
    vsoPage := vsoDoc.Pages[1];
    vsoShapes := vsoPage.Shapes;
    vsoWindow := vsoApp.ActiveWindow;
    vsoSelection := vsoWindow.Selection;
//    vsoWindow.Select(vsoShape, 1);
    for I := vsoShapes.Count downto 1 do
    begin
      vsoShape := vsoShapes[I];
      PosI := AnsiStartsText('保留', vsoshape.Text);
      if PosI then
      begin
        vsoSelection.Select(vsoShape, visSelect);
        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(LineShape, visSelect);
              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;
        Break;
      end;
    end;

//    vsoSelection.Group.Copy(visCopyPasteNormal);
//    vsoSelection.Copy(visCopyPasteNormal);
    vsoSelection.Cut(visCopyPasteNormal);
    vsoWindow.SelectAll;
    vsoWindow.Delete;
    vsoPage.Paste(visCopyPasteNormal);
//    vsoWindow.Copy;
//    vsoDoc.Close;


//    vsoDoc := vsoApp.ActiveDocument;
//    vsoPage.Paste(visCopyPasteNormal);
//    vsoDoc := vsoApp.Documents[2];
    vsoDoc.SaveAsEx(ExtractFilePath(Application.ExeName) + 'aaa1.vsd', 0);
  finally
    vsoApp.Quit;
  end;
end;

{
  根据流程图获取流程
}
procedure TForm1.Button6Click(Sender: TObject);
var
  I: Integer;
begin
  visioDoc := VisioApp.ActiveDocument;
  visioPage := visioDoc.Application.ActivePage;
  visioShapes := visioPage.Shapes;
  for I := 1 to visioShapes.Count do
  begin
    visioShape := visioShapes[I];
    if visioShape.Name = '进程' then
    begin
      memo1.Lines.Clear;
      Memo1.Lines.Add('开始');
      Break;
    end;
  end;
  GetCode(visioShape, visioShape.Name);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  vsoUIObject: VisioUIObject;
  vsoMenuSets: VisioMenuSets;
  vsoMenuSet: VisioMenuSet;
  vsoMenus: VisioMenus;
  vsoMenu: VisioMenu;
  vsoMenuItems: VisioMenuItems;
  vsoMenuItem: VisioMenuItem;
begin
  vsoUIObject := VisioApp.BuiltInMenus;
  vsoMenuSets := vsoUIObject.MenuSets;
  vsoMenuSet := vsoMenuSets.ItemAtID[visUIObjSetDrawing];
  vsoMenus := vsoMenuSet.Menus;
  vsoMenu := vsoMenus.AddAt(7);
  vsoMenu.Caption := 'MyNewMenu';
  vsoMenuItems := vsoMenu.MenuItems;
  vsoMenuItem := vsoMenuItems.Add;
  vsoMenuItem.Caption := '&MyNewMenuItem';
  visioDoc := VisioApp.ActiveDocument;
  visioDoc.SetCustomMenus(vsoUIObject);
end;

procedure TForm1.DeleteParents(vsoShape, 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);
         vsoSelection.Select(LineShape, visSelect);
//        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 TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled := False;
//  Button3.Enabled := False;
  Button4.Enabled := False;
  Button6.Enabled := False;
  Left := 0;
  Top := 0;
  Height := Screen.Height;
  Width := Screen.Width;
  Memo1.Height := Height - 150;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(VisioApp) then
  VisioApp.Quit;
end;

end.