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

📄 main_.pas

📁 以可视的方式画IVR语音导航的流程,并把流程做为源文件保存起来
💻 PAS
📖 第 1 页 / 共 5 页
字号:
            Y := StrToInt(s)
        else
            Exit;
        tmpIVR.TureLeft := X;
        tmpIVR.TureTop := Y;
    except
        Exit;
    end;
end;

//主画板的鼠标down事件
procedure Tmain.MainBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    i: Integer;
    tmpIVR: TIVRPoint;
    MousePoint:TPoint;
begin
    //取消所有选择
    ForceIVR(nil);
    if Button = mbLeft then
    begin
       if not N1001.Checked  then
         begin
          exit ;
         end;


        //如果已经选择一源IVR节点,则开始画线
        if SelectIVREvent.IVRPoint <> nil then
        begin
            i := SelectIVR.Selec();
            if i >= 0 then
            begin
                ConnectIVR(
                    SelectIVREvent.IVRPoint,
                    ActiveTree.Items.Item[i].Data,
                    SelectIVREvent.EventIndex);
            end;
            DeSelectIVRPointEvent();
        end;
        //如果已选择一IVR菜单,则开始放东东
        if SelectIVRMenu.Caption <> '' then
        begin
            tmpIVR := AddIVRPoint(
                SelectIVRMenu.Caption,
                SelectIVRMenu.iType,
                SelectIVRMenu.iContent,
                SelectIVRMenu.ID,0);
            tmpIVR.Left := X - tmpIVR.Width div 2;
            tmpIVR.Top := Y - tmpIVR.Height div 2;
            Inc(NowID);
            DeSelectIVRPointMenu();
        end;
    end else begin                              //右键, 则取消选择
        DeSelectIVRPointEvent();
        DeSelectIVRPointMenu();
       if IsCopy then
       begin
        GetCursorPos(MousePoint);
        PopupPast.Popup(MousePoint.x,MousePoint.y);
       end;
    end;
end;

//选择一个IVR节点的事件
procedure Tmain.SelectIVRPointEvent(IVRPoint: TIVRPoint; Event: Integer);
begin
    if SelectIVREvent.IVRPoint <> nil then   //已经选择过一个point
    begin
        SelectIVREvent.IVRPoint.BorderColor := clBlack;
    end;
    SelectIVREvent.IVRPoint := IVRPoint;
    SelectIVREvent.EventIndex := Event;
    SelectIVREvent.ID := IVRPoint.IVRMemo.ID;
    IVRPoint.BorderColor := IVREventColor;
    StatusBar1.Panels[1].Text := IVRPoint.Caption + '/事件' + IntToStr(Event) + '被选择';
    ActiveBox.Cursor := crLINE;
   //2002.9.20
    IVRPoint.SelectedEvent := Event;
    IVRPoint.Invalidate();
end;

//取消一个IVR节点的事件的选择
procedure Tmain.DeSelectIVRPointEvent;
begin
  if  SelectIVREvent.IVRPoint <> nil then
     begin
        SelectIVREvent.IVRPoint.BorderColor := clBlack ;
        SelectIVREvent.IVRPoint.Invalidate(); 
     end;

    SelectIVREvent.ID := -1;
    SelectIVREvent.EventIndex := 0;
    SelectIVREvent.IVRPoint := nil;
    StatusBar1.Panels[1].Text := '没有任何被选择';
    ActiveBox.Cursor := crMOVE;

end;

//选择一个指定的IVR节点,准备放下
procedure Tmain.SelectIVRPointMenu(aCaption: String; iType, iContent, ID: Integer);
begin
    SelectIVRMenu.Caption := aCaption;
    SelectIVRMenu.iType := iType;
    SelectIVRMenu.iContent := iContent;
    SelectIVRMenu.ID := ID;
    StatusBar1.Panels[1].Text := '选择位置放下' + SelectIVRMenu.Caption;
    ActiveBox.Cursor := crPUSH;
end;

//取消IVR节点的选择
procedure Tmain.DeSelectIVRPointMenu;
begin
    SelectIVRMenu.Caption := '';
    StatusBar1.Panels[1].Text := '没有任何被选择';
    ActiveBox.Cursor := crMOVE;
end;

//生成ADO类构件的连接串
function Tmain.MakeConnectionString(DBName: String): String;
begin
    Result :=
        'Driver={Microsoft Access Driver (*.mdb)};dbq=' +
        DBName + ';uid=Admin;pwd=ivr';
end;

//根据指定iType值,寻找到其所在的Popup菜单索引值
function Tmain.IVRiTypeToMenu(iType: Integer): Integer;
var
    i: Integer;
begin
    Result := -1;
    for i := 0 to MenuCount - 1 do
    begin
        if IVRTypeIndex[i] = iType then
        begin
            Result := i;
            Exit;
        end;
    end;
end;

//得到版本说明
procedure Tmain.actHelpVersionExecute(Sender: TObject);
begin
    MessageBox(
        main.Handle,
        PChar(DetailMemo),
        PChar(DetailOwner),
        MB_ICONINFORMATION);
end;

//根据IVR节点菜单的索引值,得到这个Popup菜单代表的iType值
function Tmain.IVRMenuToiType(Menu: Integer): Integer;
begin
    if Menu >= MenuCount then
        Result := -1
    else
        Result := IVRTypeIndex[Menu];
end;

//项目属性动作
procedure Tmain.actProjectPropertyExecute(Sender: TObject);
begin
    if ProjectName = '' then
    begin
        clMsgBox('你还没有打开任何项目', MB_ICONERROR);
        Exit;
    end;

    ProjectProperty := TProjectProperty.Create(Self);
    ProjectProperty.ShowModal();
    ProjectProperty.Free();
end;

//节点树被改名后产生的事件
procedure Tmain.IVRPointTreeEdited(Sender: TObject; Node: TTreeNode;
  var S: String);
begin
    {
    TIVRPoint(Node.Data).Caption := s;
    if Trim(TIVRPoint(Node.Data).IVRMemo.iComment) = '' then
        TIVRPoint(Node.Data).IVRMemo.iComment := Copy(s, 1, 40);
    }
end;

//总体设置动作
procedure Tmain.acfSetupGernalExecute(Sender: TObject);
begin
    SetupGernal := TSetupGernal.Create(Self);
    SetupGernal.ShowModal();
    SetupGernal.Free();
end;

//生成StatusBar的进度条
procedure Tmain.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 Tmain.IncProc(IncValue: Integer = 1);
begin
    Proc.Progress := Proc.Progress + IncValue;
end;

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

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

//线条的鼠标DOWN事件
procedure Tmain.OnLineMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
    MainBoxMouseDown(ActiveBox, Button, Shift,
        X + TCLPathLine(Sender).Left,
        Y + TCLPathLine(Sender).Top);
end;

//常量定义动作
procedure Tmain.actProjectDefineExecute(Sender: TObject);
begin
    if ProjectName = '' then
    begin
        clMsgBox('你还没有打开任何项目', MB_ICONERROR);
        Exit;
    end;

    define := Tdefine.Create(Self);
    define.ShowModal();
    define.Free();
end;

//从常量定义资料的ID得到索引值
function Tmain.DefineIDToIndex(ID: Integer): Integer;
var
    i: Integer;
begin
    Result := -1;
    for i := 0 to DefineCount - 1 do
    begin
        if DefineValue[i].id = ID then
        begin
            Result := i;
            Exit;
        end;
    end;
end;

//使用指定的索引编译引擎编译系统
procedure Tmain.BuildUseEngineIndex(Index: Integer);
var
    dllHandle: THandle;
    BuildProc: TBuild;
    s: String;
    MySub:PMySubID ;
begin
    if ProjectName = '' then
    begin
        clMsgBox('你还没有打开任何项目', MB_ICONERROR);
        Exit;
    end;
    ADOConnect.Close(); 
    dllHandle := LoadLibrary(PChar(EngineList[Index]));
    if dllHandle = 0 then
    begin
        clMsgBox('装载' + EngineList[Index] + '出错!');
        Exit;
    end;

    @BuildProc := GetProcAddress(dllHandle, PChar('Build'));
    if @BuildProc = nil then
    begin
        clMsgBox(EngineList[Index] + #13 + #10 + '是一个非法的Visual IVR Studio编译引擎。编译终止!');
        FreeLibrary(dllHandle);
        Exit;
    end;
    new(MySub);
    s := MainProgramPath + 'IVR.Dat';
    MySub.SubProcess := SubProcess ;
    MySub.SubiContent := SubiContent ;
    MySub.SubStartiType :=  SubStartiType ;
    MySub.SubStartiContent := SubStartiContent ;
    MySub.SubEndiType  := SubEndiType ;
    MySub.SubEndiContent := SubEndiContent ;
    BuildProc(PChar(ProjectName),PChar(s),MySub);
    FreeLibrary(dllHandle);
    Dispose(Mysub);                 
end;

//从编译引擎菜单选择编译引擎
procedure Tmain.BuildClick(Sender: TObject);
var
    s: String;
begin
    s := TMenuItem(Sender).Name;
    BuildUseEngineIndex(StrToInt(Copy(s, 7, Length(s) - 6)));
end;

//使用默认编译引擎
procedure Tmain.actProjectBuildExecute(Sender: TObject);
begin
    BuildUseEngineIndex(DefaultEngine);
end;

//设定默认引擎按钮的Caption
procedure Tmain.SetBuildBtnCaption;
begin
    actProjectBuild.Caption := '使用' + EnginePopup.Items[DefaultEngine].Caption + '编译项目';
    actProjectBuild.Hint := actProjectBuild.Caption;
end;

//检查流程逻辑动作
procedure Tmain.actProjectCheckExecute(Sender: TObject);
begin
    if ProjectName = '' then
    begin
        clMsgBox('你还没有打开任何项目', MB_ICONERROR);
        Exit;
    end;
end;

//增加到最近打开项目的菜单里
function Tmain.AddReOpenMenu(NowCount: Integer; MenuCaption: String): Integer;
var
    i: Integer;

  procedure WriteReOpenToINI();
  var
    j: Integer;
  begin
    with TIniFile.Create(MainProgramPath + 'Config.ini') do
    begin
        for j := 1 to Result do
            case j of
            1: WriteString('Reopen', 'File' + IntToStr(j), ReOpen1.Caption);
            2: WriteString('Reopen', 'File' + IntToStr(j), ReOpen2.Caption);
            3: WriteString('Reopen', 'File' + IntToStr(j), ReOpen3.Caption);
            4: WriteString('Reopen', 'File' + IntToStr(j), ReOpen4.Caption);
            5: WriteString('Reopen', 'File' + IntToStr(j), ReOpen5.Caption);
            end;
        Free();
    end;
  end;

begin
    Result := NowCount;
    if ReOpen1.Caption = MenuCaption then
    begin
        WriteReOpenToINI();
        Exit;
    end;
    if ReOpen2.Caption = MenuCaption then
    begin
        ReOpen2.Caption := ReOpen1.Caption;
        ReOpen1.Caption := MenuCaption;
        WriteReOpenToINI();
        Exit;
    end;
    if ReOpen3.Caption = MenuCaption then
    begin
        ReOpen3.Caption := ReOpen2.Caption;
        ReOpen2.Caption := ReOpen1.Caption;
        ReOpen1.Caption := MenuCaption;
        WriteReOpenToINI();
        Exit;
    end;
    if ReOpen4.Caption = MenuCaption then
    begin
        ReOpen4.Caption := ReOpen3.Caption;
        ReOpen3.Caption := ReOpen2.Caption;
        ReOpen2.Caption := ReOpen1.Caption;
        ReOpen1.Caption := MenuCaption;
        WriteReOpenToINI();
        Exit;
    end;
    if ReOpen5.Caption = MenuCaption then
    begin
        ReOpen5.Caption := ReOpen4.Caption;
        ReOpen4.Caption := ReOpen3.Caption;
        ReOpen3.Caption := ReOpen2.Caption;
  

⌨️ 快捷键说明

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