unit PreviewWord;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB, OleCtnrs,ComObj, Buttons, Mask, DBCtrls,
ExtCtrls;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
OpenDialog1: TOpenDialog;
OleContainer2: TOleContainer;
DBEdit1: TDBEdit;
DataSource1: TDataSource;
BitBtn1: TBitBtn;
Button1: TButton;
Panel1: TPanel;
ScrollBox1: TScrollBox;
OleContainer1: TOleContainer;
ScrollBox2: TScrollBox;
Splitter1: TSplitter;
procedure Button1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure DBEdit1Change(Sender: TObject);
private
procedure s_ole_clickck(Sender:TObject;Button:TMouseButton; Shift: TShiftState; X, Y: Integer);
function create_S_Ole(nn:integer):ToleContainer;
procedure delete_s_ole;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function get_th(i:integer):string;
var
s:string;
begin
s:='一 二 三 四 五 六 七 八 九 十 十一 十二 十三';
s:=s+' 十四 十五 十六 十七 十八 十九 二十 二十一二十二二十三二十四二十五二十六二十七二十八二十九三十 ';
result:=(trim(copy(s,i*6+1,6)));
end;
function get_olecontainer(word:variant):string;
var
ss:string;
begin
word.selection.homekey(6); //Ctrl+Home;
word.browser.next; //Next Page;
word.selection.homekey(6,1); //Ctrl+Shift+Home
ss:=word.selection;
try
word.selection.cut; //cut
except
ss:='';
word.selection.WholeStory;
word.selection.cut; //cut
end;
result:=ss;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
BS: tmemorystream;
word:variant;
s:string;
BlobField: TField;
begin //分解Word 原文
dbedit1.DataField:='';
delete_s_ole;
if not OpenDialog1.Execute then exit;
with adoquery1 do begin
close;
sql.Text:='delete from File_nr';
execsql;
close;
sql.Text:='select * from File_nr';
open;
end;
word:=createoleobject('word.application');
word.documents.add;
word.Selection.InsertFile(OpenDialog1.FileName); //打开word文件
s:='s';
while s<>'' do begin
s:=get_olecontainer(word); // 得到Word的每一页
if olecontainer2.canpaste then olecontainer2.paste;
olecontainer2.update;
with adoquery1 do begin //存贮得到的一页Word文件
bs:=tmemorystream.Create;;
olecontainer2.SaveToStream(bs);
blobField:=fieldbyname('nr');
Append;
(BlobField as Tblobfield).loadFromStream(bs);
Post;
end;
end;
word.ActiveDocument.Saved:=True;
word.quit;
BitBtn1.Click; // 预览
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
nn:integer;
BS:TStream;
olename:tolecontainer;
begin
dbedit1.DataField:='';
delete_s_ole;
with adoquery1 do begin
close;
sql.Text:='select * from file_nr';
open;
first;
nn:=0;
while not eof do begin
olename:=create_S_Ole(nn);
bs:=adoquery1.CreateBlobStream(fieldbyname('nr'),bmread);
bs.Position:=0;
olename.LoadFromstream(bs);
olename.update;
nn:=nn+1;
next;
end;
end;
dbedit1.DataField:='id';
end;
procedure TForm1.s_ole_clickck(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
n:integer;
s:string;
begin
dbedit1.DataField:='';
s:=(sender as Tolecontainer).name;
adoquery1.First;
n:=strtoint(copy(s,6,length(s)));
adoquery1.moveby
;
dbedit1.DataField:='id';
end;
function TForm1.create_S_Ole(nn: integer): ToleContainer;
var
ss:Tolecontainer;
tt:Tlabel;
row:integer;
begin
row:=nn+1;
scrollbox2.VertScrollBar.Position:=0;
ss:=tolecontainer.Create(scrollbox2);
ss.Left:=1;
ss.Top:=(row-1)*180+10;
ss.Width:=130;
ss.Height:=150;
ss.Name:='ole_s'+inttostr(nn);
ss.parent:=scrollbox2;
ss.SizeMode:=smScale;
ss.Visible:=True;
ss.AllowInPlace:=False;
ss.AllowActiveDoc:=False;
ss.AutoVerbMenu:=False;
ss.AutoActivate:=aaManual;
ss.OnMouseDown:=s_ole_clickck;
tt:=Tlabel.Create(scrollbox2);
tt.parent:=scrollbox2;
tt.Left:=ss.Left+45;
tt.Top:=ss.top+ss.Height+5;
tt.Caption:='第'+get_th(nn)+'页';
tt.Visible:=True;
result:=ss;
end;
procedure TForm1.DBEdit1Change(Sender: TObject);
var
BS: TStream;
begin
if dbedit1.DataField='' then exit;
with adoquery1 do begin
bs:=adoquery1.CreateBlobStream(fieldbyname('nr'),bmread);
bs.Position:=0;
olecontainer1.LoadFromstream(bs);
olecontainer1.update;
if olecontainer1.Visible then
olecontainer1.SetFocus;
end;
dbedit1.DataField:='id';
end;
procedure TForm1.delete_s_ole;
var
i:integer;
begin
for i:=scrollbox2.ControlCount-1 downto 0 do begin
scrollbox2.Controls
.Destroy;
end;
end;
end.
]