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

📄 main.pas

📁 对金智能试卷软件的功能补充
💻 PAS
📖 第 1 页 / 共 2 页
字号:
            case  Style of
            1:
               begin       //每行文本间有空行
                   wordApp.Selection.TypeText(id+' ');
                   WordApp.Selection.InsertFile('c:\~Shiti.doc', '', False, false, false);
                   wordApp.Selection.TypeText('答案: ');
                   WordApp.Selection.InsertFile('c:\~Daan.doc', '', False, false, false);
               end;
            2:
               begin  //  两题之间有空行
                   wordApp.Selection.TypeText(id+' ');
                   WordApp.Selection.InsertFile('c:\~Shiti.doc', '', False, false, false);
                   wordApp.Selection.delete(wdWord,1);
                   wordApp.Selection.TypeText('答案: ');
                   WordApp.Selection.InsertFile('c:\~Daan.doc', '', False, false, false);
               end;
            3:
               begin       //没有空行
                   wordApp.Selection.TypeText(id+' ');
                   WordApp.Selection.InsertFile('c:\~Shiti.doc', '', False, false, false);
                   wordApp.Selection.delete(wdWord,1);
                   wordApp.Selection.TypeText('答案: ');
                   WordApp.Selection.InsertFile('c:\~Daan.doc', '', False, false, false);
                   wordApp.Selection.delete(wdWord,1);
               end;
            end;
            next;
        end;
    end;
    try
       try
          newdoc.SaveAs('c:\~tk_temp.doc');
          if SaveDialog1.Execute then
             if copyfile('c:\~tk_temp.doc',Pchar(SaveDialog1.FileName),false) then
                ShowMessage('数据成功导出至文件:'+SaveDialog1.FileName);
       except
          exit;
       end;
     finally
          newdoc.close(wdSaveChanges);
          DeleteFile('c:\~tk_temp.doc');      {删除临时文件}
          if not VarIsEmpty(Wordapp) then     {回收变量内存}
             Wordapp.Quit;
             Wordapp := Unassigned;
     end;
    end;
end;

{打开记事本编辑配置文件}
procedure Tfrmtkaid.N11Click(Sender: TObject);
begin
    WinExec(pchar('notepad '+ExtractFilePath(Application.ExeName)+'tkaid.ini'),sw_show);
end;

{建立树型控件的主结构}
procedure Tfrmtkaid.BuildTree(sql_str :string);
var
     QryTmp     : TQuery;
     topNode    : Ttreenode;
     ParentNode : TTreeNode;
begin
     Session.AddPassword('jIGGAe');     {解除设定密码}
     QryTmp:=TQuery.Create(self);      {建立临时查询}
     with QryTmp do
     begin
         try
            SQL.Clear;
            SQL.Add(sql_str);
            open;
         except
            ShowMessage('打开数据库失败');
            free;
            exit;
         end;
     end;

     TopNode := Treeview1.Items.AddChild(Treeview1.Items.GetFirstNode,'题库目录');
     with QryTmp do
     begin
         first;
         while not eof do
         begin
             if fieldbyname('Id_Parent').AsInteger = 0 then
             begin
                ParentNode:=Treeview1.Items.AddChild(TopNode,fieldbyname('Name').AsString );
                addchildnode(fieldbyname('Id').AsInteger,sql_str,ParentNode);
             end;
             next;
         end;
         close;
         free;
     end;
end;



{在树型控件上增加子节点的递归函数}

procedure Tfrmtkaid.AddChildNode(Id :integer ; sql_str :string ; FatherNode :TTreeNode);
var
    QryTmp :TQuery;
    myNode :TTreeNode;
begin
    QryTmp:=TQuery.Create(self);     {建立动态查询}
    with QryTmp do
    begin
        SQL.Add(sql_str);
        SQL.Add('where Id_Parent ='+inttostr(Id));
        Open;
        while not Eof do
        begin
            myNode:=Treeview1.Items.AddChild(FatherNode,fieldbyname('Name').AsString+'['+IntToStr(fieldbyname('Id').AsInteger)+']');
            if fieldbyname('Child').AsInteger = 1 then
            AddChildNode(fieldbyname('Id').AsInteger,sql_str,myNode);    {递归}
            Next;
        end;
        close;
        Free;
     end;
end;

procedure Tfrmtkaid.TreeView1Click(Sender: TObject);

begin
      if assigned(Treeview1.Selected) then
         StatusBar1.Panels.Items[0].Text:=Treeview1.Selected.Text;
end;

{调用设置窗口}

procedure Tfrmtkaid.N10Click(Sender: TObject);
begin
      frmset.show;
end;

{编辑按钮的动作代码}

procedure Tfrmtkaid.SpeedButton3Click(Sender: TObject);
var
    Wordapp     : OleVariant;
    EditWordDoc : OleVariant;
begin

       if Tbl_tk.Active = false then
       begin
           ShowMessage('数据库未连接');
           exit;
       end;

    if not CheckTempFile() then
            ShowMessage('这项操作需要关闭临时文件 ~Shiti.doc, ~Daan.doc,~tk_editing.doc')
    else
    begin
       Wordapp := OpenWordApp( );
       Wordapp.Visible := true;
       EditWordDoc := NewWordDoc(Wordapp);
       if pagecontrol1.ActivePageIndex = 0 then
       begin
            WordApp.Selection.InsertFile('c:\~Shiti.doc', '', False, false, false);
            EditWordDoc.SaveAs('c:\~tk_editing.doc');
            wordApp.Selection.delete(wdWord,1);
            Edit_Id    := tbl_tk.RecNo ;
            Edit_field := 'Shiti';
            StatusBar1.Panels.Items[2].Text:='记录号 = '+IntToStr(Edit_Id)+' 的试题在编辑状态';
       end;
       if pagecontrol1.ActivePageIndex = 1 then
       begin
            WordApp.Selection.InsertFile('c:\~Daan.doc', '', False, false, false);
            EditWordDoc.SaveAs('c:\~tk_editing.doc');
            wordApp.Selection.delete(wdWord,1);
            Edit_Id := tbl_tk.RecNo ;
            Edit_field := 'Daan';
            StatusBar1.Panels.Items[2].Text:='记录号 = '+IntToStr(Edit_Id)+' 的答案在编辑状态';
       end;
    end;
end;

 { 存档按钮的动作代码 }

procedure Tfrmtkaid.SpeedButton4Click(Sender: TObject);
begin
       if Tbl_tk.Active = false then
       begin
           ShowMessage('数据库未连接');
           exit;
       end;
       if  ( Edit_Id = 0 ) or ( Edit_field = '' ) then
       begin
           ShowMessage('没有记录被编辑');
           exit;
       end;
       if  not FileExists('c:\~tk_editing.doc') then
       begin
           ShowMessage('编辑的文件不存在');
           exit;
       end;
       if  not CheckTempFile() then
           ShowMessage('这项操作需要关闭临时文件 ~Shiti.doc, ~Daan.doc,~tk_editing.doc')
       else
       with Tbl_tk do
       begin
           First;
           MoveBy( Edit_Id - 1 );       {注意移动的步数}
           Edit;
           try
              if Edit_field = 'Shiti' then
                 TBlobField(FieldByName('Shiti')).LoadFromFile('c:\~tk_editing.doc');
              if Edit_field = 'Daan' then
                 TBlobField(FieldByName('Daan')).LoadFromFile('c:\~tk_editing.doc');
           except
                 ShowMessage('编辑内容写回数据库失败');
                 exit;
           end;
           post;
           ReadWordField();
           WriteIntoMemo();
           ShowMessage('编辑内容已经成功写回数据库');
           StatusBar1.Panels.Items[2].Text:='记录号 = '+IntToStr(Edit_Id)+' 的记录已经存档';
           Edit_Id    := 0;
           Edit_field := '';
       end;
end;


{按指定格式处理数据库记录}

procedure Tfrmtkaid.SpeedButton1Click(Sender: TObject);
var
    tx        : string;
    Action    : string;
    myinifile : TIniFile;
    Wordapp   : OleVariant;
    worddoc   : OleVariant;
    count,i   : integer;

begin
       if Tbl_tk.Active = false then
          begin
              ShowMessage('数据库未连接');
              exit;
          end;
       if not CheckTempFile() then
          ShowMessage('这项操作需要关闭临时文件 ~Shiti.doc, ~Daan.doc,~tk_editing.doc')
       else
       begin
           myinifile:=Tinifile.create(ExtractFilePath(Application.ExeName)+'tkaid.ini');
           tx    := myinifile.ReadString('TK_SET','Range','') ;
           count := StrToInt(myinifile.ReadString('TK_SET','Count','0'));
           Action:= myinifile.ReadString('TK_SET','Action','') ;
           myinifile.Free;
           if (tx = '') or (Count = 0) or (Action= '') then
              exit;
           if MessageDlg('确定要按设定的格式对题库进行批量修改吗',
                          mtConfirmation,mbOKCancel,0) = mrCancel then
              exit;

           Wordapp := OpenWordApp();
           if  not Wordapp.Visible = true then
               Wordapp.Visible := false;
           with Tbl_tk do
           begin
               First;
               while not Eof do
               begin
                   edit;
                   if pos('$'+IntToStr(FieldByName('Tx').AsInteger)+'$',tx) > 0  then
                   begin
                       ReadWordField();
                       worddoc := NewWordDoc(Wordapp);
                       WordApp.Selection.InsertFile('c:\~Shiti.doc', '', False, false, false);
                       wordApp.Selection.delete(wdWord,1);
                       if Action = 'Add' then
                          for i:=1 to count do
                          begin
                              wordApp.Selection.TypeText(#13);
                          end;
                       if Action = 'Delete' then
                          for i:=1 to count do
                          begin
                              wordApp.Selection.setRange(WordApp.Selection.end-1,WordApp.Selection.end);
                              if  Wordapp.Selection.text = #13 then
                                  wordApp.Selection.delete(wdWord,1);
                          end;
                       worddoc.SaveAs('c:\~Shiti.doc');
                       worddoc.Close(wdSaveChanges);
                       TBlobField(FieldByName('Shiti')).LoadFromFile('c:\~Shiti.doc');
                   end;
                   Post;
                   Next;
               end;
               ShowMessage('数据库格式批量修改成功');
           end;
           if not VarIsEmpty(Wordapp) then
              Wordapp.Quit;
              Wordapp := Unassigned;
       end;
end;

procedure Tfrmtkaid.N9Click(Sender: TObject);
begin
     frmabout.show;
end;

{判断是否有打开的~Shiti.DOC 和 ~Daan.doc}

Function Tfrmtkaid.CheckTempFile() :boolean ;
var
    hword1 :Thandle;
    hword2 :Thandle;
    hword3 :Thandle;
begin

     HWord1:=FindWindow(NIL,'~Shiti - Microsoft Word');
     HWord2:=FindWindow(NIL,'~Daan - Microsoft Word');
     HWord3:=FindWindow(NIL,'~tk_editing - Microsoft Word');
     if (hWord1 = 0) and (hWord2 = 0) and (hWord3 = 0)then
       result:= true
     else
       result:= false;
end;

procedure Tfrmtkaid.SpeedButton2Click(Sender: TObject);
begin
     frmrepair.show;
end;


procedure Tfrmtkaid.N5Click(Sender: TObject);
begin
     button_linkClick(self);
end;

procedure Tfrmtkaid.N6Click(Sender: TObject);
begin
      button_outClick(self);
end;

procedure Tfrmtkaid.N7Click(Sender: TObject);
begin
       SpeedButton1Click(Self);
end;

procedure Tfrmtkaid.N13Click(Sender: TObject);
begin
    SpeedButton3Click(Self);
end;

procedure Tfrmtkaid.N14Click(Sender: TObject);
begin
     SpeedButton4Click(Self);
end;

procedure Tfrmtkaid.N8Click(Sender: TObject);
begin
     if MessageDlg('要退出题库管理助手吗 ?',mtConfirmation,mbOKCancel,0) = mrOK then

      close;

end;

procedure Tfrmtkaid.N16Click(Sender: TObject);
begin
    SpeedButton2Click(Self);
end;

end.





⌨️ 快捷键说明

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