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

📄 viewsub.pas

📁 以可视的方式画IVR语音导航的流程,并把流程做为源文件保存起来
💻 PAS
字号:
unit viewsub;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, CheckLst,Db,ADODb,CLTools, ComCtrls, Grids, 
  ExtCtrls,jpeg, fcdbtreeview, DBGrids, fcTreeView, Gauges;

type

  TFrm_ViewSub = class(TForm)
    OpenDialog: TOpenDialog;
    ADOFun: TADOQuery;
    DataSource1: TDataSource;
    ADOTable1: TADOTable;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Panel1: TPanel;
    BitBtn3: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ADOQuery1: TADOQuery;
    TreeView: TfcTreeView;
    Splitter1: TSplitter;
    Label1: TLabel;
    StatusBar1: TStatusBar;
    ADOUpDate: TADOQuery;
    ADOTmp: TADOQuery;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ADOQuery1AfterScroll(DataSet: TDataSet);
    procedure TreeViewChange(TreeView: TfcCustomTreeView;
      Node: TfcTreeNode);
    procedure TreeViewToggleCheckbox(TreeView: TfcCustomTreeView;
      Node: TfcTreeNode);
    procedure MakeProc(InMaxValue, PanelIndex: Integer);
    procedure IncProc(IncValue: Integer = 1);
    procedure DeleProc();
  private
    { Private declarations }
    JPEGImage:TJPEGImage ;
    Proc:TGauge;    
    procedure AllCheck(Node: TfcTreeNode);
    procedure InitSub(ProjectName : String);
    procedure AllImport(Node: TfcTreeNode);
    procedure AllImportEx();
    function DoUpDate(Node: TfcTreeNode):Integer;


  public
    { Public declarations }
    InNode: Array of TfcTreeNode;
    tmpinputfile: string;


  end;

var
  Frm_ViewSub: TFrm_ViewSub;

implementation

uses main_, uExpSubFlow;

{$R *.DFM}

procedure TFrm_ViewSub.BitBtn3Click(Sender: TObject);
var
   s1: string;
begin
 if  OpenDialog.Execute() then
    begin
      if  not FileExists(OpenDialog.FileName) then
         begin
            ShowMessage(OpenDialog.FileName + ' 不存在!');
            Exit;
         end
      else begin
        s1 := ExtractFilePath(OpenDialog.FileName) + 'RayInput.000';
        tmpinputfile := s1;
        CopyFile(PChar(OpenDialog.FileName),PChar(s1),false);
        InitSub(s1);
      end;  
    end;

end;

procedure TFrm_ViewSub.InitSub(ProjectName : String);
var
CreateDate :TDateTime;
ModifyDate :TDateTime;
Writer :String;
ProjectOwner : String;
TopNode: TfcTreeNode;
begin
    ADOTable1.Close();
    ADOTable1.ConnectionString := main.MakeConnectionString(ProjectName);
    ADOTable1.TableName := 'detail';

  try
     ADOTable1.Open();
  except
      ShowMessage('不能打开文件'+ProjectName);
      Exit;
  end;
     with ADOTable1 do
     begin
        CreateDate := FieldByName('CreateDate').AsDateTime;
        ModifyDate := FieldByName('ModifyDate').AsDateTime;
        Writer := FieldByName('Writer').AsString;
        ProjectOwner := FieldByName('Owner').AsString;
        Close();
        if ProjectOwner <> main.DetailOwner then
        begin
            clMsgBox('你要打开的项目需要“' + ProjectOwner + '”内核,' + #13 + #10 +
                '当前Visual IVR Studio的内核是“' + Main.DetailOwner + '”' + #13 + #10 +
                '【系统拒绝打开】');
            Exit;
        end;
        Close();
      end;

   with ADOFun do
    begin
      Close();
      ConnectionString :=main.MakeConnectionString(ProjectName);
    end;

  TreeView.Items.Clear();
  with ADOQuery1 do
    begin
      Close();
      ConnectionString :=main.MakeConnectionString(ProjectName);
      SQL.Clear();
      SQL.Add('SELECT * FROM FunctionList order by  parentid ,id, functionid');
      Open();
      SetLength(InNode,RecordCount+1);
      while not Eof do
        begin
           if FieldByName('ParentID').AsInteger = 0 then
                 TopNode := TreeView.Items.AddChild(nil,FieldByName('Function').AsString)
           else
                 TopNode := TreeView.Items.AddChild(InNode[FieldByName('ParentID').AsInteger],FieldByName('Function').AsString);

              InNode[FieldByName('FunctionID').AsInteger] := TopNode;
              TopNode.CheckboxType := tvctCheckbox;
              TopNode.Checked := false;
              TopNode.StringData := IntToStr(RecNo);
              TopNode.StringData2 := FieldByName('FunctionID').AsString;
              Next();
        end;
    end;

   TreeView.Selected := TreeView.Items[0];
   TreeView.SetFocus(); 
end;

procedure TFrm_ViewSub.BitBtn2Click(Sender: TObject);
begin
 Close();
end;

procedure TFrm_ViewSub.BitBtn1Click(Sender: TObject);
var
  i: integer;
begin
   if TreeView.Items.Count = 0 then
   begin
      exit;
   end;

   {
   if main.NowID mod 10 <> 0 then
   begin
      main.NowID := main.NowID + 10 - main.NowID mod 10;
   end;
   }

   i := DoUpDate(TreeView.Items.GetFirstNode);
   main.Tag := 1;
   Screen.Cursor := crHourGlass;

   AllImportEx();
   //AllImport(TreeView.Items.GetFirstNode);

   Main.UpSubLink();
   main.Tag := 0;
   ADOFun.Close();
   Screen.Cursor := crDefault;

   ShowMessage('导入完毕!');
end;

procedure TFrm_ViewSub.FormCreate(Sender: TObject);
begin
JPEGImage:=TJPEGImage.Create;
ScrollBox1.Color := main.MainBox.Color ;
Label1.Caption := '';
end;

procedure TFrm_ViewSub.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
JPEGImage.free();
end;

procedure TFrm_ViewSub.ADOQuery1AfterScroll(DataSet: TDataSet);
var
PhotoField :TBlobField ;
stPhoto: TStream;
begin
PhotoField := ADOQuery1.FieldByName('FunImage') as TBlobField ;
stPhoto := ADOQuery1.CreateBlobStream(PhotoField, bmRead);
JPEGImage.LoadFromStream(stPhoto);
Image1.Picture.Assign(JPEGImage);
stPhoto.free;
ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width ;
ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;
Label1.Caption :='说明: '+ Trim(ADOQuery1.FieldByName('FunMemo').AsString) +' ' +'更新日期:'+ADOQuery1.FieldByName('Update').AsString;

end;

procedure TFrm_ViewSub.TreeViewChange(TreeView: TfcCustomTreeView;
  Node: TfcTreeNode);
begin
   ADOQuery1.RecNo :=  StrToInt(Node.StringData);
end;

procedure TFrm_ViewSub.TreeViewToggleCheckbox(TreeView: TfcCustomTreeView;
  Node: TfcTreeNode);
begin
   // AllCheck(Node);
end;


procedure TFrm_ViewSub.AllCheck(Node: TfcTreeNode);
var
  tmpNode : TfcTreeNode;
begin
   tmpNode :=  Node.GetFirstChild();

    while tmpNode <> nil do
      begin
          if tmpNode.HasChildren then
              AllCheck(tmpNode);
          tmpNode.Checked := Node.Checked ;

          tmpNode := Node.GetNextChild(tmpNode);
      end;

 end;


procedure TFrm_ViewSub.AllImport(Node: TfcTreeNode);
var
 tmpNode : TfcTreeNode;

begin
  tmpNode := TreeView.Items.GetFirstNode;

  while tmpNode <> nil do
  begin
     if tmpNode.Checked then  //是否被选中
        begin
          ADOQuery1.Filtered := false ;
          ADOQuery1.Filter := ' FunctionID = '+ tmpNode.StringData2 ;
          ADOQuery1.Filtered := true ;
          main.ImportSubProcess(ADOQuery1,true);
          main.MyAddBox(tmpNode.Text,false,true);

          ADOFun.Close();
          ADOFun.SQL.Clear();
          ADOFun.SQL.Add('select * from view_function  where FunctionID = ' + tmpNode.StringData2 + ' order by id ' );
          ADOFun.Open();

          MakeProc(ADOFun.RecordCount,1);
          main.ImportSubProcess(ADOFun,false);
          DeleProc();
        end;
        
     tmpNode := tmpNode.GetNext();
  end;

end;


//生成StatusBar的进度条
procedure TFrm_ViewSub.MakeProc(InMaxValue, PanelIndex: Integer);
var
    i: Integer;
begin
    Proc := TGauge.Create(StatusBar1);
    with Proc do
    begin
        Parent := StatusBar1;
        Color := StatusBar1.Color;
        BackColor := StatusBar1.Color;
        ForeColor := clNavy;
        MaxValue := InMaxValue;
        BorderStyle := bsNone;
        Kind := gkHorizontalBar;
        Top := 4;
        Height := StatusBar1.Height - 6;
        Left := 4;
        for i := 0 to PanelIndex - 1 do
            Left := Left + StatusBar1.Panels[i].Width;
        Width := StatusBar1.Panels[PanelIndex].Width - 6;
    end;
end;

//StatusBar的进度条进度增加
procedure TFrm_ViewSub.IncProc(IncValue: Integer = 1);
begin
    Proc.Progress := Proc.Progress + IncValue;
end;

//删除StatusBar的进度条
procedure TFrm_ViewSub.DeleProc;
begin
    if Proc = nil then
        Exit;

    Proc.Free();
    Proc := nil;
end;

function TFrm_ViewSub.DoUpDate(Node: TfcTreeNode):Integer;
var
   FunID: integer;
   IsOK: integer;
   ExpSubFlow: TExpSubFlow;
   tmpNode: TfcTreeNode;
begin

  tmpNode := TreeView.Items.GetFirstNode;
  IsOK := 0;

  while tmpNode <> nil do
  begin
     if tmpNode.Checked then  //是否被选中
        begin
          FunID := StrToInt(tmpNode.StringData2);
          IsOK := 1;
          break; 
        end;
     tmpNode := tmpNode.GetNext();
  end;

  if (IsOK = 0) then
  begin
     Result := 0;
     exit;
  end;

  ExpSubFlow := TExpSubFlow.Create(nil);
  ExpSubFlow.Database := ADOTable1.ConnectionString;
  ExpSubFlow.ExportSubFlow(main.NowID,FunID);
  ExpSubFlow.Free(); 
  Result := 1;
end;

procedure TFrm_ViewSub.AllImportEx();
var
   s1: string;
   funid: integer;
begin
   main.ImportProject(ADOTable1.ConnectionString);
end;


end.

⌨️ 快捷键说明

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