|
unit WordApp;
interface
uses
Windows, Messages, Forms, SysUtils, Variants, Classes, Graphics, Controls, StdCtrls,
Dialogs, ExtCtrls,types, OleCtnrs,dbtables,db, OleServer, Word2000, Office2000,
ComCtrls, math;
type
TAutoShape = Record {自动图形结构}
Style:Byte; {属于那种风格，即：矩形，椭圆，三角形}
Top: Smallint;
Left:Smallint;
Height:Smallint;
Width: Smallint;
end;
type
TLine = Record {直线图形结构}
Color: Byte;
Weight: Byte; {线宽}
EndArrowheadStyle: Byte; {后端风格}
BeginPoint: TPoint; {前端坐标}
EndPoint: TPoint; {后端坐标} {注：此处坐标来源于直线的位置和大小，它本身没有这样的属性}
end;
type
FreeForm = Record {任意多边形－－曲线}
FillColor:Byte;
LineColor:Byte;
Weight:Word;
Count:Word;
{Left:Word;
Top: Word;
Width:Word;
Height:Word;}
Nodes:array of TPoint; {曲线顶数组 }
end;
type
TextFrame = Record {文本框}
Text: String; { WideString;}
{ Font: String;
Color: TColor; }
FontSize:Byte;
Left: Smallint;
Height:Smallint;
Top: Smallint;
Width:Smallint;
Orientation:Byte; {文本框方向}
end;
type
TextEffect = Record {艺术字}
Text : String;
FontSize : Byte;
// FontName:string;
// Color: TColor;
Left : Smallint;
Height : Smallint;
Top : Smallint;
Width : Smallint;
end;
type
TPic = Record
SourceName : String;
Left : Smallint;
Height : Smallint;
Top : Smallint;
Width : Smallint;
end;
Const
GroupStyleNone = 0;
GroupStyleHLadder = 1;
GroupStyleVLadder = 2;
GroupStyleElevator = 3;
GroupStyleWaterSrc = 4;
GroupStyleNorth = 5;
GroupStyleFireFighting = 10;
type
TGroup = Record
Style : Byte; {组合图形类别: 0: 无; 1: 水平 梯@@子 ; 2: 垂直 梯@@子 ; 3: 电梯; 4: 水源; 5 :指北图表; 10+x : 救火点 ,x为救火点的旋转角度}
Left : Smallint;
Height : Smallint;
Top : Smallint;
Width : Smallint;
end;
const
PICKUP_NOREAD = 0;
PICKUP_READING = 1;
PICKUP_READED = 2;
type
PickUpWord = Class(TObject)
WordApplication : OleVariant;
PickUp : Byte; {读取文件状态}
AutoShapeCount : Word; {自由图形数量}
LineCount : Word; {直线数量}
FreeFormCount : Word; {任意多边形数量}
GroupCount : Word; {组数量}
ArtWordCount : Word; {艺术字数量}
PictureCount : Word; {图片数量}
TextBoxCount : Word; {文本框数量}
PageHeight : Word; {页高}
PageWidth : Word; {页宽}
{ DocumentId : OleVariant; {目前操作的word文档}
{ PageId : OleVariant; {当前操作的页数}
PicPath : array[1..15] of Char; {图片文件的路径}
PickUpSts : Array[1..19] of Byte; {1: 不提取 2: 提取，未初始化数组 3: 提取且完成初始化数组}
LineArray : Array of TLine; {直线坐标}
FreeFormArray : Array of FreeForm; {存储任意多边形}
TextFrameArray : Array of TextFrame; {文本框变量}
TextEffectArray : Array of TextEffect; {艺术字变量}
AutoShapeArray : Array of TAutoShape; {自由图形变量}
PictureArray : Array of TPic; {图片变量}
GroupArray : Array of TGroup; {组合图形}
App : TApplication;
private
// DocumentIndex : _Document; {处理目标docment} {加入一个_documents对象，用来控制或者获取当前打开的word document,而不影响其他正在使用的document.}
WordOpened: Boolean;
WordClosed: Boolean;
procedure GetDocumentItem;
procedure SortArray(var Sa:Array of TLine); // 直线按有无末端风格(箭头)排序(降序)
procedure SortArrayFreeForm(var Sa: array of FreeForm); // 曲线按顶点数排序(降序)
public
constructor Create;
destructor Destroy; override;
procedure OpenWord(FileName:String;IsVisible:Boolean=False);
procedure CloseWord(IsSave:Boolean=False);
procedure GetGraphicCount;
procedure GetGraphic;
function GetLine(IntIndex:Word; OleIndex: OleVariant; var LA: Array of TLine):Boolean;
function GetFreeForm(IntIndex:Word; OleIndex: OleVariant; var FFA: array of FreeForm):Boolean; {曲线}
function GetArtWord(IntIndex:Word; OleIndex: OleVariant; var TEA: Array of TextEffect):Boolean;
function GetTextFrame(IntIndex:Word; OleIndex: OleVariant; var TFA: Array of TextFrame):Boolean;
function GetAutoShape(IntIndex:Word; OleIndex: OleVariant; var TAS: Array of TAutoShape):Boolean;
function GetPic(IntIndex:Word; OleIndex: OleVariant; var TPc: Array of TPic): Boolean;
function GetGroup(IntIndex: Word; OleIndex: OleVariant; Var TGp: Array of TGroup): Boolean;
function PointRatation(Src,Center: TPoint; Angle: Single):TPoint;
procedure SaveDataInVtr(FileName:String);
procedure PaintFromVtr(FileName:String;Ca:TCanvas);
procedure PaintLadder(Cn:TCanvas; Left, Top, Height, Width : Integer; HorV: Boolean); {绘制 梯@@子 }
procedure PaintElevator(Cn :TCanvas; Left, Top, Height, Width: Integer);
procedure PaintWaterSource(Cnv:TCanvas; Left,Top,Right,Bottom:Word);
procedure PaintFireFighting(Cn: TCanvas; Left, Top, Height, Width, Angle: Integer);
function GetAPointFromLine(BeginP,EndP:Tpoint;L:Integer): Tpoint;
procedure PaintNorth(Cn: TCanvas; Left, Top, Height, Width : integer);
end;
var
Ftxt:File; {用于读写的二进制文件变量}
implementation
uses comobj, VarUtils, WaitFor, PickUpPas, StdConvs;
Const
C_DOTPICKUP = 0;
C_PICKUP_NOTINITARRAY = 2;
C_ALLRGHIT =3;
{ PickUpWord }
procedure PickUpWord.CloseWord(IsSave: Boolean);
var
SaveChanges, OriginalFormat, RouteDocument: OleVariant; { close word var }
begin
WordClosed := False;
SaveChanges := WdDoNotSaveChanges;
OriginalFormat := UnAssigned;
RouteDocument := UnAssigned;
Try
WordApplication.ActiveDocument.Close(SaveChanges,OriginalFormat,RouteDocument);
PickUp := PICKUP_NOREAD;
except
on E: Exception do
begin
ShowMessage(E.Message + #13#10 + '激活文档已经关闭或者不存在！');
end;
end;
WordClosed := True;
end;
constructor PickUpWord.Create;
begin { Create PickUpWord }
Inherited;
WordApplication := CreateOleObject('Word.Application');
PickUp :=0;
AutoShapeCount :=0;
LineCount :=0;
FreeFormCount :=0;
GroupCount :=0;
ArtWordCount :=0;
PictureCount :=0;
TextBoxCount :=0;
end;
destructor PickUpWord.Destroy;
begin { Destroy PickUpWord }
WordApplication.Quit(0);
LineArray := nil;
FreeFormArray := nil;
TextFrameArray := nil;
PictureArray := nil;
AutoShapeArray := nil;
TextEffectArray := nil;
inherited Destroy;
end;
function PickUpWord.GetAPointFromLine(BeginP, EndP: Tpoint; { 在一条线段上获得一点，距离线段末端 L 象素}
L: Integer): Tpoint;
var
Li:Integer;
begin
Li := Round(sqrt(sqr(BeginP.X - EndP.x) + Sqr(BeginP.Y - EndP.Y)));
Result.X := EndP.X - Round((EndP.X - BeginP.X) * L / Li);
Result.Y := EndP.Y - Round((EndP.Y - BeginP.Y) * L / Li);
end;
function PickUpWord.GetArtWord(IntIndex:Word;OleIndex: OleVariant; var TEA: Array of TextEffect): Boolean;
begin
try
TEA[IntIndex-1].Text := WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextEffect.Text; {
TEA[IntIndex-1].FontName := WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextEffect.FontName;
TEA[IntIndex-1].Color := Tcolor(WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextEffect.); }
TEA[IntIndex-1].FontSize := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextEffect.FontSize);
TEA[IntIndex-1].Left := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Left * Screen.PixelsPerInch * 10 / (254 * 2.835));
TEA[IntIndex-1].Top := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Top * Screen.PixelsPerInch * 10 / (254 * 2.835));
TEA[IntIndex-1].Width := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Width * Screen.PixelsPerInch * 10 / (254 * 2.835));
TEA[IntIndex-1].Height := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Height * Screen.PixelsPerInch * 10 / (254 * 2.835));
except
Result:= False;
end;
Result:=True;
end;
function PickUpWord.GetAutoShape(IntIndex: Word; OleIndex: OleVariant; var TAS: Array of TAutoShape): Boolean;
var
Angle: Single;
Tmp:TPoint;
x1,y1,x2,y2:Integer;
begin
TAS[IntIndex-1].Style := WordApplication.ActiveDocument.Shapes.Item(OleIndex).AutoShapeType;
TAS[IntIndex-1].Top := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Top * Screen.PixelsPerInch * 10 / (254*2.835));
TAS[IntIndex-1].Left := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Left * Screen.PixelsPerInch * 10 / (254*2.835));
TAS[IntIndex-1].Height := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Height * Screen.PixelsPerInch * 10 / (254*2.835));
TAS[IntIndex-1].Width := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Width * Screen.PixelsPerInch * 10 / (254*2.835));
Angle := WordApplication.ActiveDocument.Shapes.Item(OleIndex).Rotation;
Tmp.X := (TAS[IntIndex-1].Left+TAS[IntIndex-1].Width) div 2;
Tmp.Y := (TAS[IntIndex-1].Top+TAS[IntIndex-1].Height) div 2;
x1 := TAS[IntIndex-1].Left;
y1 := TAS[IntIndex-1].Top;
x2 := x1 + TAS[IntIndex-1].Width;
y2 := y1 + TAS[IntIndex-1].Height;
TAS[IntIndex-1].Left := PointRatation(point(x1,y1),Tmp,Angle).X;
TAS[IntIndex-1].Top := PointRatation(point(x1,y1),Tmp,Angle).y;
TAS[IntIndex-1].Width := PointRatation(point(x2,y2),Tmp,Angle).X-TAS[IntIndex-1].Left;
TAS[IntIndex-1].Height := PointRatation(point(x2,y2),Tmp,Angle).Y-TAS[IntIndex-1].Top;
Result:=True;
end;
procedure PickUpWord.GetDocumentItem;
begin
//DocumentId:=WordApplication.ActiveDocument;
end;
function PickUpWord.GetFreeForm(IntIndex:Word;OleIndex: OleVariant; var FFA: array of FreeForm): Boolean;
var
j:word;
OleIndex2:OleVariant;
WordApp, Nodes, Points: OleVariant;
begin
Result:=True;
try
try
WordApp := GetActiveOleObject('Word.Application');
except
WordApp := CreateOleObject('Word.Application');
ShowMessage('无法获得激活的word文件！');
end;
FFA[IntIndex-1].FillColor := WordApp.ActiveDocument.Shapes.Item(OleIndex).Fill.ForeColor.RGB;
FFA[IntIndex-1].LineColor := WordApp.ActiveDocument.Shapes.Item(OleIndex).Line.ForeColor.RGB; {
FFA[IntIndex-1].Left := Round(WordApp.ActiveDocument.Shapes.Item(OleIndex).Left * Screen.PixelsPerInch * 10 / (254*2.835));
FFA[IntIndex-1].Top := Round(WordApp.ActiveDocument.Shapes.Item(OleIndex).Top * Screen.PixelsPerInch * 10 / (254*2.835));
FFA[IntIndex-1].Height := Round(WordApp.ActiveDocument.Shapes.Item(OleIndex).Height * Screen.PixelsPerInch * 10 / (254*2.835));
FFA[IntIndex-1].Width := Round(WordApp.ActiveDocument.Shapes.Item(OleIndex).Width * Screen.PixelsPerInch * 10 / (254*2.835)); }
FFA[IntIndex-1].Weight := WordApp.ActiveDocument.Shapes.Item(OleIndex).Line.Weight;
FFA[IntIndex-1].Count := WordApp.ActiveDocument.Shapes.Item(OleIndex).Nodes.Count;
SetLength(FFA[IntIndex-1].Nodes,FFA[IntIndex-1].Count); {确定一条曲线有几个节点}
for j := 1 to WordApp.ActiveDocument.Shapes.Item(OleIndex).Nodes.Count do
begin
OleIndex2 := j;
Nodes := WordApp.ActiveDocument.Shapes.Item(OleIndex).Nodes;
Points := Nodes.Item(OleIndex2).Points;
FFA[IntIndex-1].Nodes[j-1].X := Round(Points[1,1] * Screen.PixelsPerInch * 10 / (254*2.835));
FFA[IntIndex-1].Nodes[j-1].Y := Round(Points[1,2] * Screen.PixelsPerInch * 10 / (254*2.835));
end;
finally
//
end;
end;
procedure PickUpWord.GetGraphic;
var
i : integer;
Ff, ln, pc, te, tb, au, Gp: Word;
Index : OleVariant;
begin
Ff := 0;
ln := 0;
pc := 0;
te := 0;
tb := 0;
au := 0;
Gp := 0;
PageHeight := WordApplication.ActiveDocument.PageSetup.PageHeight;
PageWidth := WordApplication.ActiveDocument.PageSetup.PageWidth;
Frm_WaitFor.Pb_Pickup.Max:=WordApplication.ActiveDocument.Shapes.Count;
for i := 1 to WordApplication.ActiveDocument.Shapes.Count do
begin
App.ProcessMessages;
Index := i;
Frm_WaitFor.Pb_Pickup.Position := i;
Frm_WaitFor.Lb_Shape.Caption := '正在提取图形：' + String(WordApplication.ActiveDocument.Shapes.Item(Index).Name);
if PickUpSts[Integer(WordApplication.ActiveDocument.Shapes.Item(Index).type)] = C_DOTPICKUP then Continue; {不提取}
try
case WordApplication.ActiveDocument.Shapes.Item(Index).type of
1 : {msoAutoShape}
begin
if PickUpSts[1] = C_PICKUP_NOTINITARRAY then
begin
SetLength(AutoShapeArray,AutoShapeCount);
PickUpSts[1] := C_ALLRGHIT;
end;
Inc(au);
GetAutoShape(au, Index, AutoShapeArray);
end;
5 : {msoFreeform}
begin
if PickUpSts[5] = C_PICKUP_NOTINITARRAY then
begin
SetLength(FreeFormArray,FreeFormCount);
PickUpSts[5] := C_ALLRGHIT;
end;
Inc(Ff);
GetFreeForm(Ff, Index, FreeFormArray);
end;
6 : {msoGroup}
begin
if PickUpSts[6] = C_PICKUP_NOTINITARRAY then
begin
SetLength(GroupArray, GroupCount);
PickUpSts[6] := C_ALLRGHIT;
end;
Inc(Gp);
GetGroup(Gp, Index, GroupArray);
end;
9 : {msoLine}
begin
if PickUpSts[9] = C_PICKUP_NOTINITARRAY then
begin
SetLength(LineArray, LineCount);
PickUpSts[9] := C_ALLRGHIT;
end;
inc(ln);
GetLine(ln,Index, LineArray);
end;
13 : {msoPicture}
begin
if PickUpSts[13] = C_PICKUP_NOTINITARRAY then
begin
SetLength(PictureArray, PictureCount);
PickUpSts[13] := C_ALLRGHIT;
end;
inc(pc);
GetPic(pc,Index, PictureArray);
end;
15 : {ArtWord} {msoTextEffect}
begin
if PickUpSts[15] = C_PICKUP_NOTINITARRAY then
begin
SetLength(TextEffectArray, ArtWordCount);
PickUpSts[15] := C_ALLRGHIT;
end;
Inc(te);
GetArtWord(te, Index, TextEffectArray);
end;
17 : {msoTextBox}
begin
if PickUpSts[17] = C_PICKUP_NOTINITARRAY then
begin
SetLength(TextFrameArray, TextBoxCount);
PickUpSts[17] := C_ALLRGHIT;
end;
Inc(tb);
GetTextFrame(tb, Index, TextFrameArray);
end
else ;
end;
except
on e:exception do
begin
ShowMessage(e.Message+#13#10+VarToStr(WordApplication.ActiveDocument.Shapes.item(index).name));
end;
end;
end;
PickUp:=PICKUP_READED;
end;
procedure PickUpWord.GetGraphicCount;
var
i : word;
OleIndex : OleVariant;
GroupTag : boolean;
begin
if not WordOpened then exit;
AutoShapeCount := 0;
FreeFormCount := 0;
LineCount := 0;
PictureCount := 0;
GroupCount := 0;
TextBoxCount := 0;
ArtWordCount := 0;
AutoShapeArray := nil;
FreeFormArray := nil;
LineArray := nil;
GroupArray := nil;
PictureArray := nil;
TextFrameArray := nil;
TextEffectArray := nil;
// GroupTag:=false;
PickUp:=PICKUP_READING;
App := TApplication.Create(nil);
{ while not GroupTag do { 取消所有组合.
begin
GroupTag:=True;
for i:=1 to WordApplication.ActiveDocument.Shapes.Count do
begin
OleIndex:=i;
if Integer(WordApplication.ActiveDocument.Shapes.Item(OleIndex).type) =6 then
begin
GroupTag:=false;
WordApplication.ActiveDocument.Shapes.Item(OleIndex).Ungroup;
end;
end;
end; }
for i := 1 to WordApplication.ActiveDocument.Shapes.Count do
begin
OleIndex := i;
App.ProcessMessages;
case Integer(WordApplication.ActiveDocument.Shapes.Item(OleIndex).type) of
1: Inc(AutoShapeCount);
5: Inc(FreeFormCount);
6: Inc(GroupCount);
9: Inc(LineCount);
13: Inc(PictureCount);
15: Inc(ArtWordCount);
17: Inc(TextBoxCount)
else ;
end;
end;
end;
function PickUpWord.GetGroup(IntIndex: Word; OleIndex: OleVariant;
var TGp: array of TGroup): Boolean;
var
TmpInt: Byte;
TmpOleVar,GroupItemOle: OleVariant;
Angle : integer;
TmpH, TmpW : Single;
IsElevator : Boolean;
begin
Result := True;
IsElevator := False;
try
TGp[IntIndex-1].Left := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Left * Screen.PixelsPerInch * 10 / (254*2.835));
TGp[IntIndex-1].Top := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Top * Screen.PixelsPerInch * 10 / (254*2.835));
TGp[IntIndex-1].Height := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Height * Screen.PixelsPerInch * 10 / (254*2.835));
TGp[IntIndex-1].Width := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Width * Screen.PixelsPerInch * 10 / (254*2.835));
case WordApplication.ActiveDocument.Shapes.Item(OleIndex).GroupItems.Count of
2: {指北图表,水源, 梯@@子 }
begin
for TmpInt := 1 to 2 do
begin
TmpOleVar := TmpInt; {artw,group} {freef,group} {autoshap,group}
case WordApplication.ActiveDocument.Shapes.Item(OleIndex).GroupItems.Item(TmpOleVar).Type of
1:
begin
Angle := WordApplication.ActiveDocument.Shapes.Item(OleIndex).GroupItems.Item(TmpOleVar).Rotation;
if Abs(Sin(Angle * Pi/180)) = 1 then {根据 梯@@子 中间的矩形框的宽高值判断它的方向}
TGp[IntIndex-1].Style := GroupStyleHLadder
else TGp[IntIndex-1].Style := GroupStyleVLadder;
end;
5:
begin
TGp[IntIndex-1].Style := GroupStyleWaterSrc;
end;
15:
begin
TGp[IntIndex-1].Style := GroupStyleNorth;
end
else ;
end;
end;
end;
3: {救火点, 电梯}
begin
for TmpInt := 1 to 3 do {组合元素中包括矩形的为电梯,否则为救火点}
begin
TmpOleVar := TmpInt;
if WordApplication.ActiveDocument.Shapes.Item(OleIndex).GroupItems.Item(TmpOleVar).Type = 1 then
IsElevator := True;
end;
if IsElevator then
TGp[IntIndex-1].Style := GroupStyleElevator
else TGp[IntIndex-1].Style := GroupStyleFireFighting + WordApplication.ActiveDocument.Shapes.Item(OleIndex).GroupItems.Rotation;
end
else ;
end;
except
end;
end;
function PickUpWord.GetLine(IntIndex:Word;OleIndex: OleVariant; var LA: Array of TLine): boolean;
const
pin=Pi/180;
var
TmpPoint:TPoint;
Angle:Double; {旋转角度}
p1,p2: TPoint;
begin
try
LA[IntIndex-1].Weight:=Byte(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Line.Weight);
LA[IntIndex-1].EndArrowheadStyle:=Byte(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Line.EndArrowheadStyle);
LA[IntIndex-1].Color:=WordApplication.ActiveDocument.Shapes.Item(OLeIndex).Line.ForeColor.RGB;
if WordApplication.ActiveDocument.Shapes.Item(OleIndex).HorizontalFlip=0 then
begin
LA[IntIndex-1].BeginPoint.X := (Round(WordApplication.ActiveDocument.Shapes.item(OleIndex).
Left* Screen.PixelsPerInch * 10 / (254*2.835)));
LA[IntIndex-1].EndPoint.X := (Round((WordApplication.ActiveDocument.Shapes.item(OleIndex).
left+WordApplication.ActiveDocument.Shapes.item(OleIndex).Width)* Screen.PixelsPerInch * 10 /(254*2.835)));
end
else begin
LA[IntIndex-1].EndPoint.X := (Round(WordApplication.ActiveDocument.Shapes.item(OleIndex).Left* Screen.PixelsPerInch * 10 / (254*2.835)));
LA[IntIndex-1].BeginPoint.X := (Round((WordApplication.ActiveDocument.Shapes.item(OleIndex).left+WordApplication.ActiveDocument.Shapes.item(OleIndex).Width)* Screen.PixelsPerInch * 10 /(254*2.835)));
end;
if WordApplication.ActiveDocument.Shapes.Item(OleIndex).VerticalFlip=0 then
begin
LA[IntIndex-1].BeginPoint.Y := (Round(WordApplication.ActiveDocument.Shapes.item(OleIndex).Top* Screen.PixelsPerInch * 10 / (254*2.835)));
LA[IntIndex-1].EndPoint.Y := (Round((WordApplication.ActiveDocument.Shapes.item(OleIndex).Top+
WordApplication.ActiveDocument.Shapes.item(OleIndex).Height)* Screen.PixelsPerInch * 10 /(254*2.835)));
end
else begin
LA[IntIndex-1].EndPoint.Y := (Round(WordApplication.ActiveDocument.Shapes.item(OleIndex).Top* Screen.PixelsPerInch * 10 / (254*2.835)));
LA[IntIndex-1].BeginPoint.Y := (Round((WordApplication.ActiveDocument.Shapes.item(OleIndex).Top+
WordApplication.ActiveDocument.Shapes.item(OleIndex).Height)* Screen.PixelsPerInch * 10 /(254*2.835)));
end;
{处理旋转问题}
TmpPoint.X:=(LA[IntIndex-1].BeginPoint.X+LA[IntIndex-1].EndPoint.X) div 2;
TmpPoint.Y:=(LA[IntIndex-1].BeginPoint.Y+LA[IntIndex-1].EndPoint.Y) div 2;
Angle:=WordApplication.ActiveDocument.Shapes.Item(OleIndex).Rotation;
p1:=LA[IntIndex-1].BeginPoint;
p2:=LA[IntIndex-1].EndPoint;
LA[IntIndex-1].BeginPoint:=PointRatation(p1,TmpPoint,Angle);
LA[IntIndex-1].EndPoint:=PointRatation(p2,TmpPoint,Angle);
except
on E: Exception do
begin
Result:=False;
ShowMessage(E.Message+#13#10+' 报错图形：'+WordApplication.ActiveDocument.Shapes.item(OleIndex).Name);
// WordApplication.Disconnect;
end;
end;
Result:=True;
end;
function PickUpWord.GetPic(IntIndex: Word; OleIndex: OleVariant;
var TPc: array of TPic): Boolean;
begin
TPc[IntIndex-1].SourceName := Copy(Trim(WordApplication.ActiveDocument.Fields.Item(intIndex).LinkFormat.SourceName),1,
Length(Trim(WordApplication.ActiveDocument.Fields.Item(intIndex).LinkFormat.SourceName))-3)+'jpg';
TPc[IntIndex-1].Left := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Left* Screen.PixelsPerInch * 10 / (254*2.835)) ;
TPc[IntIndex-1].Top := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Top* Screen.PixelsPerInch * 10 / (254*2.835)) ;
TPc[IntIndex-1].Height := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Height* Screen.PixelsPerInch * 10 / (254*2.835)) ;
TPc[IntIndex-1].Width := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Width* Screen.PixelsPerInch * 10 / (254*2.835)) ;
Result := true;
end;
function PickUpWord.GetTextFrame(IntIndex: Word; OleIndex: OleVariant; var TFA: Array of TextFrame): Boolean;
var
b:Byte;
begin
TFA[IntIndex-1].Text:= Trim(WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextFrame.TextRange.Text);
try
b:=StrToInt(Copy(TFA[IntIndex-1].Text,1,2));
TFA[IntIndex-1].Text:=IntToStr(b);
except
;
end;
TFA[IntIndex-1].Orientation := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextFrame.Orientation); {
TFA[IntIndex-1].Font := WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextFrame.TextRange.Font.Name;}
TFA[IntIndex-1].FontSize := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).TextFrame.TextRange.Font.Size);
TFA[IntIndex-1].Left := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Left* Screen.PixelsPerInch * 10 / (254*2.835));
TFA[IntIndex-1].Top := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Top* Screen.PixelsPerInch * 10 / (254*2.835));
TFA[IntIndex-1].Width := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Width* Screen.PixelsPerInch * 10 / (254*2.835));
TFA[IntIndex-1].Height := Round(WordApplication.ActiveDocument.Shapes.Item(OleIndex).Height* Screen.PixelsPerInch * 10 / (254*2.835));
Result:= True;
end;
procedure PickUpWord.OpenWord(FileName: String; IsVisible: Boolean);
var
TempDoc,NewTempDoc,TempWord,TempEmpty:OleVariant;
begin
WordOpened:=False;
try
TempEmpty := EmptyParam;
TempDoc := EmptyParam;
NewTempDoc := True;
TempWord := FileName;
WordApplication.Visible := IsVisible;
WordApplication.Documents.Open(TempWord,TempEmpty,NewTempDoc,NewTempDoc,TempEmpty,TempEmpty,TempEmpty,TempEmpty,TempEmpty,TempEmpty,TempEmpty,TempEmpty);
PickUp:=PICKUP_NOREAD;
// SetLength(PicPath,15);
PicPath:='D:\word\SubPic\';
except
ShowMessage('打开word文档错误！'+#13#10+'请检查您是否安装了word，或者您开启了防火墙。');
Raise;
end;
WordOpened:=True;
end;
procedure PickUpWord.PaintElevator(Cn: TCanvas; Left, Top, Height,
Width: Integer);
begin
Cn.Rectangle(Left, Top, Left + Width, Top + Height);
Cn.MoveTo(Left, Top);
Cn.LineTo(Left + Width, Top + Height);
Cn.MoveTo(Left, Top + Height);
Cn.LineTo(Left + Width, Top);
end;
procedure PickUpWord.PaintFireFighting(Cn: TCanvas; Left, Top, Height,
Width, Angle: Integer);
var
BeginP, EndP, Tmp, Tmpc, Tmps, Tmp_s:TPoint;
begin
BeginP.X := Left + Width Div 2;
BeginP.Y := Top + Height;
EndP.X := Left + Width Div 2;
EndP.Y := Top;
with Cn do
begin
Tmpc.X := (BeginP.X + EndP.Y) div 2;
TmpC.Y := (BeginP.Y + EndP.Y) div 2;
Tmps := PointRatation(BeginP,Tmpc,Angle);
BeginP := Tmps;
Tmps := PointRatation(Endp,Tmpc,Angle);
Endp := Tmps;
Tmp := GetAPointFromLine(BeginP, EndP, Round(0.28 * Height));
Tmpc := EndP;
Tmps := PointRatation(tmp, tmpc, Angle);
Tmp_s := PointRatation(tmp, tmpc, 360 - Angle); //45 为 箭头和线之间的角度
MoveTo(BeginP.X, BeginP.Y);
LineTo(EndP.X, EndP.Y);
moveto(tmp.X, tmP.Y);
Lineto(tmps.x, tmps.y);
moveto(tmP.X, tmP.Y);
Lineto(tmp_s.x, tmp_s.Y);
end;
end;
procedure PickUpWord.PaintFromVtr(FileName: String; Ca: TCanvas);
var
f : File;
i, j, CurrPos, Step, ReadSize, FileL : Integer;
s : String;
ShapeType, DataL, DataLin, Wd1, Wd2, Wd3, Wd4: Word;
D1, D2, D3, D4 : Smallint;
Data, Data1, Data2 ,Data3, Data4: Byte;
c : array[1..127] of Char;
begin
AssignFile(F, FileName); { 变量类型保持和写入文件时使用同样的类型.}
Try
Reset(F,1);
Seek(F,0);
except
ShowMessage('文件打开错误,请重试!');
Exit;
end;
Seek(f, 4);
BlockRead(F, FileL, 4, ReadSize); {Read File Length and set var FileL}
Seek(f, 12);
CurrPos := 12; {shape data start}
Ca.Pen.Color := clBlack;
Ca.Pen.Width := 1;
Ca.Brush.Color := clNone;
while CurrPos < FileL do
begin
BlockRead(F, ShapeType, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
case ShapeType of
$FF01: {65281}
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos); { autoshape图形数据开始处}
j := 1;
While j < DataL do
begin
BlockRead(F,Data,1,ReadSize);
Inc(CurrPos,1);
Seek(F,CurrPos);
BlockRead(F,D1,2,ReadSize);
Inc(CurrPos,2);
Seek(F,CurrPos);
BlockRead(F,D2,2,ReadSize);
Inc(CurrPos,2);
Seek(F,CurrPos);
BlockRead(F,D3,2,ReadSize);
Inc(CurrPos,2);
Seek(F,CurrPos);
BlockRead(F,D4,2,ReadSize);
Inc(CurrPos,2);
Seek(F,CurrPos);
if Data = 1 then
Ca.Rectangle(D1, D2, D1 + D4, D2 + D3)
else Ca.Ellipse(D1, D2, D1 + D4, D2 + D3);
Inc(j,9);
end;
end;
$FF05:
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos); { FreeForm图形数据开始处}
j := 1;
while j < DataL do
begin
BlockRead(F, DataLin, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, Data2, 1, ReadSize);
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, Data3, 1, ReadSize);
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, Data4, 1, ReadSize);
Inc(CurrPos, 1);
Seek(F, CurrPos);
Ca.Pen.Color := Data2;
Ca.Brush.Color := Data3;
Ca.Pen.Width := Data4;
Step := 5;
BlockRead(F, D1, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D2, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.MoveTo(D1, D2);
while Step < DataLin do
begin
BlockRead(F, D1, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D2, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.LineTo(D1, D2);
Inc(Step, 4);
end;
Inc(j, DataLin + 5);
end;
end;
$FF55:
begin // FreeForm图形顶点数小于70的数据开始处
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
j := 1;
while j < DataL do
begin
BlockRead(F, Wd1, 2, ReadSize); {Left}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, Wd2, 2, ReadSize); {Top}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, Wd3, 2, ReadSize); {Height}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, Wd4, 2, ReadSize); {width}
Inc(CurrPos, 2);
Seek(F, CurrPos);
PickUpForm.PaintWaterSource(Ca, Wd1, Wd2, Wd3, Wd4);
Inc(j, 8);
end;
end;
$FF06:
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
j := 1;
Ca.Pen.Width := 1;
While j < DataL do
begin
BlockRead(F, Data, 1, ReadSize);
Inc(CurrPos, 1);
Seek(F,CurrPos);
BlockRead(F, D1, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F,CurrPos);
BlockRead(F, D2, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F,CurrPos);
BlockRead(F, D3, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F,CurrPos);
BlockRead(F, D4, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F,CurrPos);
case Data of
0: ;
1:
begin
PaintLadder(Ca, D1, D2, D4, D3, True);
end;
2: PaintLadder(Ca, D1, D2, D3, D4, False);
3: PaintElevator(Ca, D1, D2, D3, D4);
4: PaintWaterSource(Ca, D1, D2, D1 + D4, D2 + D3);
5: PaintNorth(Ca, D1, D2, D3, D4);
else begin
PaintFireFighting(Ca, D1, D2, D3, D4, Data - 10);
end;
end;
Inc(j, 9);
end;
end;
$FF09: {65289}
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.Pen.Width := 1;
j := 1;
while j < DataL do
begin
BlockRead(F, D1, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D2, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D3, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D4, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.MoveTo(D1, D2);
Ca.LineTo(D3, D4);
Inc(j, 8);
end;
end;
$FF99:
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
j := 1;
while j < DataL do
begin
BlockRead(F, Data1, 1, ReadSize); {data1 is weight}
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, Data2, 1, ReadSize); {data2 is color}
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, D1, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D2, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D3, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D4, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.Pen.Width := Data1;
Ca.Pen.Color := TColor(Data2);
PickUpForm.PaintArrowHeadLine(Ca, Point(D1, D2), Point(D3, D4));
Inc(j, 10);
end;
end;
$FF0D: {pic}
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
j := 1;
while j < DataL do
begin
BlockRead(F, D1, 2);
Inc(CurrPos, 2);
Seek(F, CurrPos); {待处理}
BlockRead(F, D2, 2);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D3, 2);
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D4, 2);
Inc(CurrPos, 2);
Seek(F, CurrPos);
Inc(j, 9);
end;
end;
$FF11: {textbox}
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
DataLin := 0;
while DataLin < DataL do
begin
FillChar(C,SizeOf(C),0);
BlockRead(F, Data, 1, ReadSize); {文本长度}
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, C, Data, ReadSize); {取出文本内容}
Inc(CurrPos, Data);
Seek(F, CurrPos);
BlockRead(F, Data1, 1, ReadSize); {取出文本方向}
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, Data2, 1, ReadSize); {取出文本字体}
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, D1, 2, ReadSize); {取出文本left}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D2, 2, ReadSize); {取出文本top}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D3, 2, ReadSize); {取出文本height}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D4, 2, ReadSize); {取出文本width}
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.Brush.Color := clBtnFace;
Ca.Pen.Color := clBlack;
if Data1 = 1 then
Ca.TextOut(D1,D2,c)
else begin
i:=1;
while i < Data do
begin {绘制垂直的文本框}
if byte(c[i])>128 then
begin
Ca.TextOut(D1,D2 + i* (Data2-5),C[i]+C[i+1]);
inc(i);
end;
inc(i);
end;
end;
Inc(DataLin, 11 + Data);
end;
end;
$FF0F: {artword}
begin
BlockRead(F, DataL, 2, ReadSize);
Inc(CurrPos, 2);
Seek(F, CurrPos);
j := 1;
while j < DataL do
begin
FillChar(c,SizeOf(c),0);
BlockRead(F, Data, 1, ReadSize);
Inc(CurrPos, 1);
Seek(F, CurrPos); {}
BlockRead(F, c, Data, ReadSize);
Inc(CurrPos, Data);
Seek(F, CurrPos);
BlockRead(F, Data1, 1, ReadSize);
Inc(CurrPos, 1);
Seek(F, CurrPos);
BlockRead(F, D1, 2, ReadSize); {取出艺术字left}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D2, 2, ReadSize); {取出艺术字top}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D3, 2, ReadSize); {取出艺术字height}
Inc(CurrPos, 2);
Seek(F, CurrPos);
BlockRead(F, D4, 2, ReadSize); {取出艺术字width}
Inc(CurrPos, 2);
Seek(F, CurrPos);
Ca.Brush.Color := clBtnFace;
Ca.Pen.Color := clBlack;
Ca.TextOut(D1, D2, C);
Inc(j,10 + Data);
end;
end;
$FF03: {纯文本部分}
begin
end;
$FFFF: {end}
begin
end
else
Inc(CurrPos,2);
end;
end;
end;
procedure PickUpWord.PaintLadder(Cn: TCanvas; Left, Top, Height,
Width: Integer; HorV: Boolean);
var
i : integer;
begin
if HorV then
With Cn do
begin
MoveTo(Left, Top);
LineTo(Left + Width, Top);
MoveTo(Left, Top + Height);
LineTo(Left + Width, Top + Height); {两条平行线}
for i:= 1 to 9 do
begin
MoveTo(Left + i * Width div 10, Top);
LineTo(Left + i * Width div 10, Top + Height);
end;
Rectangle(Left + Round(Width/12), Top + Round(4 * Height/9), Left + Round(1 - 1/12) * Width, Top + Round(5 * Height/9));
end
else
With Cn do
begin
MoveTo(Left, Top);
LineTo(Left, Top + Height);
MoveTo(Left + Width , Top);
LineTo(Left + Width, Top + Height); {两条平行线}
for i:= 1 to 9 do
begin
MoveTo(Left, Top + i * Height div 10);
LineTo(Left + Width, Top + i * Height div 10);
end;
Rectangle(Left + Round(4 * Width/9), Top + Round(Height/12), Left + Round(5 * Width/9), Top + Round(1 - 1/12) * Height);
end;
end;
procedure PickUpWord.PaintNorth(Cn: TCanvas; Left, Top, Height,
Width: integer);
begin
Cn.Brush.Color := clBtnFace;
Cn.TextOut(Left,Top,'北');
end;
procedure PickUpWord.PaintWaterSource(Cnv: TCanvas; Left, Top, Right,
Bottom: Word);
begin
Cnv.Ellipse(Left, Top, Right, Bottom);
Cnv.Brush.Color:=clred;
Cnv.Pie(Left,Top,Right,Bottom,(Right + Left) div 2,Bottom,(Left + Right) div 2,Top); {扇形部分}
Cnv.Brush.Color := clBtnFace;
end;
function PickUpWord.PointRatation(Src,Center: TPoint; Angle: Single): TPoint;
const
pin=Pi/180;
begin
Result.X:= Round(Center.X+(Src.X-Center.X)*cos(Angle*Pin)-(Src.Y-Center.Y)*Sin(Angle*Pin));
{ x0+(x-x0)cos@-(y-y0)sin@ }
Result.Y:= Round(Center.Y+(Src.X-Center.X)*Sin(Angle*Pin)+(Src.Y-Center.Y)*Cos(Angle*Pin));
{ y0+(x-x0)sin(θ)+(y-y0)cos(θ)}
end;
procedure PickUpWord.SaveDataInVtr(FileName: String);
var
s : array[1..4] of Char;
C : array[1..127] of Char;
i,j,frfm,tb,at,tt:Smallint;
AllLength:Integer;
ShapeType,ShapeL, LineNormalL,FreeFormNormalL, FreeFormNormCount, LineNormCount,PicSrcNameL, GroupDL:Word;
TextL,F_L:Byte;
begin
AssignFile(Ftxt,FileName);
try
Reset(Ftxt,1);
except
On EInOutError do
begin
try
if FileExists(FileName) = False then
ReWrite(Ftxt, 1)
else
MessageDlg('文件不能打开', mtWarning, [mbOK], 0);
except
On EInOutError do
MessageDlg('文件不能创建', mtWarning, [mbOK], 0);
end;
end;
end;
{open file}
try
s:='vtr ';
BlockWrite(Ftxt, s, 4); {文件头(4字节)}
except
on e:Exception do
ShowMessage('写入异常:'+#10#13+e.Message);
end;
frfm := 0;
tb := 0;
at := 0;
{ ****** 获得所有数据的长度 ******** }
AllLength := 14; // 文件头和尾的长度. 详见设计文档<矢量图形开发综述文档>
if AutoShapeArray <> nil then
AllLength := AllLength + AutoShapeCount * 9 + 4;
///
if FreeFormArray <> nil then
begin
SortArrayFreeForm(FreeFormArray); // 按图形定点数升序排序
for i := Low(FreeFormArray) to High(FreeFormArray) do // 处理顶点数小于70的多边形,
frfm := frfm + FreeFormArray[i].Count;
FreeFormNormCount := FreeFormCount;
AllLength:=AllLength + 4 * (frfm + 1) + 5 * FreeFormNormCount;
end;
///
if GroupArray <> nil then {组合图形数据长度}
AllLength := AllLength + GroupCount * 9 + 4;
if LineArray <> nil then
begin
SortArray(LineArray);
for i:=Low(LineArray) to High(LineArray) do
if LineArray[i].EndArrowheadStyle = 1 then
LineNormCount := i // 从数组中取出末尾有箭头的直线的开始点.
else break;
Inc(LineNormCount);
LineNormalL:= LineNormCount * 8 + 4;
AllLength := AllLength + LineNormalL;
if LineNormCount <> LineCount then
AllLength:= AllLength + (LineCount-LineNormCount) * 10 + 4;
end;
/////////////////
if PictureArray <> nil then
begin
AllLength:=AllLength + PictureCount * 9 + 5;
AllLength:=AllLength + Length(PicPath);
for i:=Low(PictureArray) to High(PictureArray) do
PicSrcNameL:=PicSrcNameL + Length(PictureArray[i].SourceName);
AllLength := AllLength + PicSrcNameL;
end;
/// pic data length
if TextFrameArray <> nil then
begin
AllLength := AllLength + 4 + 11 * TextBoxCount;
for i:=Low(TextFrameArray) to High(TextFrameArray) do
tb:=tb+Length(TextFrameArray[i].Text);
AllLength := AllLength + tb;
end;
/// text frame data Length
if TextEffectArray <> nil then
begin
AllLength := AllLength + 4 + 10 * ArtWordCount;
for i:=Low(TextEffectArray) to High(TextEffectArray) do
at:=at+Length(TextEffectArray[i].Text);
AllLength := AllLength + at;
end;
// art word data length
{如果涉及到纯文本, 在此处加入获得纯文本长度代码}
/////////////////////////////////////////////////////////////////////////////
try
BlockWrite(Ftxt,AllLength,4); // 文件的总长度； (4字节)
ShowMessage('file Length:'+IntToStr(AllLength));{}
/////////////////////////////////////////////////////////////////////////////////////
s:='0.91'; // 文件版本信息: (4字节)
BlockWrite(Ftxt,s,4);
if AutoShapeArray <> nil then
begin
ShapeType:=$FF01; // 自动图形头标识 (2字节)
BlockWrite |
客服电话
APP下载
官方微信
请发表评论