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

📄 p_word_set.~pas

📁 学员管理的软件
💻 ~PAS
字号:
unit P_word_set;

interface

uses
 // Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 // Dialogs, StdCtrls, ComCtrls, Buttons, Word2000, OleServer, DB, ADODB,Word97, clipbrd;
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, Db, DBTables, OleServer,
  Word97, clipbrd, Word2000, ADODB, ComCtrls, Buttons;
type
  Tword_set = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Fonttype: TListBox;
    Label2: TLabel;
    Size: TEdit;
    ChkBoxUnderline: TCheckBox;
    ChkBoxBold: TCheckBox;
    ChkBoxItalic: TCheckBox;
    ChkBoxEmboss: TCheckBox;
    ChkBoxEngrave: TCheckBox;
    ChkBoxShadow: TCheckBox;
    ChkBoxDoublestrike: TCheckBox;
    ChkBoxStrike: TCheckBox;
    WordDocument: TWordDocument;
    WordFont: TWordFont;
    WordApplication: TWordApplication;
    BitBtn1: TBitBtn;
    ProgressBar1: TProgressBar;
    ComboBox1: TComboBox;
    Label3: TLabel;
    UpDown1: TUpDown;
    BtnPrint: TBitBtn;
    BtnPreview: TBitBtn;
    Label4: TLabel;
    lbDocs: TListBox;
    ADOQuery1: TADOQuery;
    ChkBoxNewDoc: TCheckBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnCloseWordClick(Sender: TObject);
    procedure BtnPrintClick(Sender: TObject);
    procedure BtnPreviewClick(Sender: TObject);
    procedure WordApplicationDocumentChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  word_set: Tword_set;

implementation
uses main,Variants;
{$R *.dfm}

procedure Tword_set.BitBtn1Click(Sender: TObject);
var
  Docs, Template, NewTemplate, ItemIndex: OleVariant;
  sj_id,znum,cur_num:integer;
    procedure setfont;
    begin
      WordFont.ConnectTo(WordDocument.Sentences.Get_Last.Font);
      if ChkBoxUnderline.checked then WordFont.Underline := 2;
      if ChkBoxBold.checked then WordFont.Bold := 1;
      if ChkBoxItalic.Checked then WordFont.Italic := 1;
      if ChkBoxEmboss.Checked then WordFont.Emboss := 1;
      if ChkBoxEngrave.checked then WordFont.Engrave := 1;
      if ChkBoxShadow.checked then WordFont.shadow := 1;
      if ChkBoxDoublestrike.checked then WordFont.DoubleStrikeThrough := 1;
      if ChkBoxStrike.checked then WordFont.StrikeThrough := 1;
      WordFont.Size := StrToInt(Size.text);
      if Fonttype.Itemindex >= 0 then
         WordFont.Name := FontType.Items[FontType.Itemindex];
    end;

begin
  try
    Template := EmptyParam;
    NewTemplate := True;
    ItemIndex := 1;
    try
      Wordapplication.Connect;
    except
      MessageDlg('Word没有安装!', mtError, [mbOk], 0);
      Abort;
    end;
    Wordapplication.Visible := True;
    WordApplication.Caption := 'Delphi automation';
    {创建新的文档}
    Template := EmptyParam;
    NewTemplate := False;
    if ChkBoxNewDoc.Checked then
    begin
      Docs := WordApplication.Documents;
      Docs.Add(NewTemplate := True);
      {WordDocument组件赋值}
      WordDocument.ConnectTo(WordApplication.Documents.Item(ItemIndex));
    end;
    {关闭拼写检查,如果进行拼写检查,将减缓Winword速度}
    WordApplication.Options.CheckSpellingAsYouType := False;
    WordApplication.Options.CheckGrammarAsYouType := False;
    {插入数据}
    //DBImgFishImg.CopyToClipboard;
    WordDocument.Sentences.Last.Paste;
    adoquery1.Close;
    adoquery1.SQL.Clear;
    adoquery1.SQL.Add('select 试卷号 from 试卷表 where 试卷名称='''+trim(combobox1.Text)+'''');
    adoquery1.Open;
    if adoquery1.Eof then
    begin
    messagebox(handle,'无记录','错误',MB_OK);
    exit;
    end;
    adoquery1.First;
    znum:=0;
    while not adoquery1.Eof do
    begin
    znum:=znum+1;
    adoquery1.Next;
    end;
    progressbar1.Max:=znum;
    cur_num:=0;
    sj_id:=adoquery1.FieldValues['试卷号'];
    adoquery1.Close;
    adoquery1.SQL.Clear;
    adoquery1.SQL.Add('select 试题表.* from 试题表,用户作答表 where 试题表.试题号=用户作答表.题号 and 试卷号='+inttostr(sj_id));
    adoquery1.Open;
    while not adoquery1.Eof do
    begin
    WordDocument.Range.InsertAfter('题目: ' + adoquery1.FieldValues['题目'] + #13);
    SetFont;
    WordDocument.Range.InsertAfter('难度:' + inttostr(adoquery1.FieldValues['难度']) +#13);
    WordDocument.Range.InsertAfter('分值: ' + inttostr(adoquery1.FieldValues['分值']) + #13);
    WordDocument.Range.InsertAfter('选项1:' + adoquery1.FieldValues['选项1'] +#13);
    WordDocument.Range.InsertAfter('选项2: ' + adoquery1.FieldValues['选项2'] + #13);
    WordDocument.Range.InsertAfter('选项3:' + adoquery1.FieldValues['选项3'] +#13);
    WordDocument.Range.InsertAfter('选项4: ' + adoquery1.FieldValues['选项4'] + #13);
    WordDocument.Range.InsertAfter('标准答案:' + adoquery1.FieldValues['标准答案'] +#13);
    WordDocument.Range.InsertAfter(' ' + #13);
    adoquery1.next;
    cur_num:=cur_num+1;
    progressbar1.Position:=cur_num;
    //WordDocument.Range.InsertAfter(' ' + #13);
    //WordDocument.Range.InsertAfter(' ' + #13);
    end;
  //  BtnCloseWord.Enabled := True;
    BtnPrint.Enabled := True;
    BtnPreview.Enabled := True;
  except
    on E: Exception do
    begin
      ShowMessage(E.Message);
      WordApplication.Disconnect;
    end;
  end;
end;

procedure Tword_set.FormCreate(Sender: TObject);
begin
Fonttype.Items := Screen.Fonts;
end;

procedure Tword_set.BtnCloseWordClick(Sender: TObject);
var
  SaveChanges,
  OriginalFormat,
  RouteDocument: OleVariant;

begin
  SaveChanges := WdDoNotSaveChanges;
  OriginalFormat := UnAssigned;
  RouteDocument := UnAssigned;
  try
    WordApplication.Quit(SaveChanges, OriginalFormat, RouteDocument);
    WordApplication.Disconnect;
  //  BtnCloseWord.Enabled := False;
    BtnPrint.Enabled := False;
    BtnPreview.Enabled := False;
  except
    on E: Exception do
    begin
      Showmessage(E.Message);
      WordApplication.Disconnect;
    end;
  end;
end;
procedure Tword_set.BtnPrintClick(Sender: TObject);
begin
  WordDocument.PrintOut;

end;

procedure Tword_set.BtnPreviewClick(Sender: TObject);
begin
 WordDocument.PrintPreview;
end;

procedure Tword_set.WordApplicationDocumentChange(Sender: TObject);
begin
lbDocs.items.add(WordDocument.Name);
end;

procedure Tword_set.FormShow(Sender: TObject);
begin
with main.DataModule2 do
begin
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.Add('select 试卷名称 from 试卷表');
aq1.Open;
while not aq1.Eof do
begin
ComboBox1.Items.Add(aq1.FieldValues['试卷名称']);
aq1.Next;
end;
end;
end;

end.

⌨️ 快捷键说明

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