📄 p_word_set.~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 + -