Эксперт
Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006
Репутация: 17
Всего: 50
|
Работаю с WordApplication и WordDocument, форма находится поверх ворда, нажымаю на кнопочки, происходят разные крязозябры с документом. И в какой-то момент форма становится не поверх всех, без какой-либо закономености. Вот в этих проц и происходят непонятки Button9Click
Button3Click
Button4Click
Button5Click
Button6Clickвот код | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Word2000, OleServer, Activex, ExtCtrls, ComCtrls, Buttons,
SHEllapi;
type
TMainFormWordMM_ = class(TForm)
App: TWordApplication;
Doc1: TWordDocument;
OpenDialog1: TOpenDialog;
Doc2: TWordDocument;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Timer1: TTimer;
StaticText1: TStaticText;
StaticText3: TStaticText;
StaticText2: TStaticText;
TabSheet4: TTabSheet;
Button7: TButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
procedure Button_Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
Sel3_bol2 : Byte;
procedure ShowStep(k:Integer);
function set_aaa:Integer;
function sel3:Boolean;
public
{ Public declarations }
end;
var
MainFormWordMM_: TMainFormWordMM_;
gDirApp : AnsiString;
gCloseBol : Boolean;
WordList : TStringList;
implementation
{$R *.dfm}
const
gCapt = 'Этап ';
procedure CloseMes;
begin
SendMessage(FindWindow('TMesFormMM_', nil), WM_CLOSE, 0, 0);
end;
procedure StartMes(const aText:AnsiString);
begin
ShellExecute(0, 'open', PChar(gDirApp+'textwindows.exe'), PChar('"'+aText+'"'), PChar(gDirApp), SW_SHOWNORMAL);
end;
procedure WordReplace2(WordApp:TWordApplication;FindText,ReplaceText:WideString);
var p1,p2 : OleVariant;
begin
p1 := wdStory;
WordApp.Selection.HomeKey(p1,EmptyParam);
WordApp.Selection.Find.ClearFormatting;
WordApp.Selection.Find.Replacement.ClearFormatting;
With WordApp.Selection.Find do
begin
Text := FindText;
Replacement.Text := '';
Forward := True;
Wrap := wdFindContinue;
Format := False;
MatchCase := False;
MatchWholeWord := False;
MatchWildcards := False;
MatchSoundsLike := False;
MatchAllWordForms := False;
End;
while WordApp.Selection.Find.Execute(EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam) do
begin
p1 := wdCharacter;
p2 := 1;
WordApp.Selection.MoveRight(p1,p2,EmptyParam);
WordApp.Selection.TypeText(ReplaceText);
WordApp.Selection.MoveLeft(p1,p2,EmptyParam);
end;
end;
procedure WordReplace(WordApp:TWordApplication;FindText,ReplaceText:WideString);
var p1 : OleVariant;
begin
p1 := wdStory;
WordApp.Selection.HomeKey(p1,EmptyParam);
WordApp.Selection.Find.ClearFormatting;
WordApp.Selection.Find.Replacement.ClearFormatting;
With WordApp.Selection.Find do
begin
Text := FindText;
Replacement.Text := ReplaceText;
Forward := True;
Wrap := wdFindContinue;
Format := False;
MatchCase := False;
MatchWholeWord := False;
MatchWildcards := False;
MatchSoundsLike := False;
MatchAllWordForms := False;
End;
p1 := wdReplaceAll;
WordApp.Selection.Find.Execute(EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,p1,EmptyParam,
EmptyParam,EmptyParam,EmptyParam);
end;
procedure FindAndKras(WordApp:TWordApplication;FindText:WideString;Color:TOleEnum;Bold:Integer);
var p1 : OleVariant;
begin
p1 := wdStory;
WordApp.Selection.HomeKey(p1,EmptyParam);
WordApp.Selection.Find.ClearFormatting;
With WordApp.Selection.Find do
begin
Text := FindText;
Replacement.Text := '';
Forward := True;
Wrap := wdFindContinue;
Format := False;
MatchCase := False;
MatchWholeWord := False;
MatchWildcards := False;
MatchSoundsLike := False;
MatchAllWordForms := False;
End;
while WordApp.Selection.Find.Execute(EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam) do
begin
WordApp.Selection.Font.Color := Color;
WordApp.Selection.Font.Bold := Bold;
end;
end;
procedure TMainFormWordMM_.Button_Click(Sender: TObject);
var p1,p2,p3 : OleVariant;
j,k : Integer;
h,w : Integer;
zz : AnsiString;
begin
if not OpenDialog1.Execute then
begin
Close;
exit;
end;
StartMes('Идет начальная обработка документа.'#13#10'Ждите...');
p1 := OpenDialog1.FileName;
try
app.Connect;
app.Visible := True;
app.ShowMe;
app.ChangeFileOpenDirectory(gDirApp);
doc1.ConnectTo(app.Documents.Open(p1,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam));
doc1.Activate;
Application.ProcessMessages;
//----------------------------------
// разрыв колонки
WordReplace(app, '^n', '#@#^n'); // Разрыв колонки
// разрыв страницы
WordReplace2(app, '^b', '@#@'); // Разрыв колонки
// покрас
FindAndKras(app, '#@#', wdColorBlue, wdToggle);
FindAndKras(app, '@#@', wdColorRed, wdToggle);
//----------------------------------
// удаление колонок
k := doc1.Paragraphs.Count;
for j:=1 to k do
begin
doc1.Paragraphs.Item(j).Range.Select;
try
if app.Selection.PageSetup.TextColumns.Count>1 then
app.Selection.PageSetup.TextColumns.SetCount(1);
except
end;
// размер фрифта
doc1.Paragraphs.Item(j).Range.Select;
try
if app.Selection.Font.Size<10 then
app.Selection.Font.Size := 10
except
end;
// междустрочный интервал
try
doc1.Paragraphs.Item(j).Range.Select;
App.Selection.ParagraphFormat.LineSpacingRule := wdLineSpaceSingle;
except
end;
doc1.Paragraphs.Item(j).Range.Select;
Application.ProcessMessages;
end;
//----------------------------------
// удаление рамок
k := doc1.Frames.Count;
for j:=k downto 1 do
doc1.Frames.Item(j).Delete;
//----------------------------------
// замена
WordReplace(app, '^-^l', ''); // мягкий перенос + Принудительный разрыв строки
Application.ProcessMessages;
WordReplace(app, '^-', ''); // мягкий перенос
Application.ProcessMessages;
WordReplace(app, '^b', ''); // Разрыв раздела
Application.ProcessMessages;
WordReplace(app, '^l', ' '); // Принудительный разрыв строки
Application.ProcessMessages;
WordReplace(app, '^m', ''); // Принудительный разрыв страницы
Application.ProcessMessages;
WordReplace(app, '^n', ''); // Разрыв колонки
Application.ProcessMessages;
//----------------------------------
set_aaa;
//----------------------------------
// удаление картинок
k := doc1.Shapes.Count;
for j:=k downto 1 do
begin
p1 := j;
try
doc1.Shapes.Item(p1).Select(EmptyParam);
h := round(doc1.Shapes.Item(p1).Height);
w := round(doc1.Shapes.Item(p1).Width);
if (h<3) or (w<3) then
doc1.Shapes.Item(p1).Delete;
except
end;
Application.ProcessMessages;
end;
k := doc1.InlineShapes.Count;
for j:=k downto 1 do
begin
p1 := j;
try
doc1.InlineShapes.Item(p1).Select;
h := round(doc1.InlineShapes.Item(p1).Height);
w := round(doc1.InlineShapes.Item(p1).Width);
if (h<3) or (w<3) then
doc1.InlineShapes.Item(p1).Delete;
except
end;
Application.ProcessMessages;
end;
//----------------------------------
// в начало документа
p1 := wdStory;
App.Selection.HomeKey(p1,EmptyParam);
finally
Application.ProcessMessages;
end;
Caption := gCapt+'Обработки абзацев';
CloseMes;
ShowStep(3);
Show;
sel3;
end;
procedure TMainFormWordMM_.FormCreate(Sender: TObject);
begin
gCloseBol := False;
gDirApp := ExtractFilePath(ParamStr(0));
WordList := TStringList.Create;
Application.ShowMainForm := False;
OpenDialog1.InitialDir := gDirApp;
Left := Screen.WorkAreaRect.Right - Width - 20;
Top := Screen.WorkAreaRect.Top + 20;
app.Connect;
if app.Documents.Count>0 then
begin
ShowMessage('Работает MS Word'#13#10'Программа быдет закрыта');
FormStyle := fsStayOnTop;
gCloseBol:=True;
end;
app.Disconnect;
ShowStep(1);
Sel3_bol2 := 1;
Timer1.Enabled := True;
end;
procedure TMainFormWordMM_.Timer1Timer(Sender: TObject);
begin
timer1.Enabled := False;
if gCloseBol then
begin
close
end
else
begin
Button_Click(nil);
end
end;
procedure TMainFormWordMM_.Button3Click(Sender: TObject);
var p1,p2,p3:OleVariant;
ch:Char;
ss:string;
s,e:Integer;
begin
if sel3 then
begin
s := app.Selection.Range.Start;
e := app.Selection.Range.End_;
p1 := wdCharacter;
p2 := 1;
p3 := wdExtend;
app.Selection.MoveLeft(p1,p2,EmptyParam);
p2 := 2;
app.Selection.MoveLeft(p1,p2,p3);
ss := app.Selection.Text;
ch := ss[1];
if IsCharAlpha(ch) then
begin
app.Selection.SetRange(s,e);
app.Selection.TypeBackspace;
app.Selection.TypeBackspace;
// app.Selection.MoveRight(p1,p2,EmptyParam);
app.Selection.TypeText(#32);
sel3
end
else
begin
ShowMessage('Автоматическое соединение невозможно');
end;
end;
FormStyle := fsStayOnTop;
end;
procedure TMainFormWordMM_.Button4Click(Sender: TObject);
begin
if sel3 then
begin
app.Selection.TypeBackspace;
app.Selection.TypeBackspace;
app.Selection.TypeBackspace;
sel3
end;
FormStyle := fsStayOnTop;
end;
procedure TMainFormWordMM_.ShowStep(k: Integer);
begin
if k>0 then
if k<=PageControl1.PageCount then
PageControl1.ActivePageIndex := k-1;
end;
procedure TMainFormWordMM_.Button5Click(Sender: TObject);
var p1,p2,p3:OleVariant;
begin
if sel3 then
begin
p1 := wdWord;
p2 := 1;
app.Selection.MoveLeft(p1,p2,EmptyParam);
p1 := wdParagraph;
p2 := 1;
p3 := wdExtend;
app.Selection.MoveDown(p1,p2,p3);
if (app.Selection.Range.ComputeStatistics(wdStatisticLines)>1) or
(app.Selection.Range.ComputeStatistics(wdStatisticCharacters)>20)
then
begin
showmessage('Абзац удалению не подлежит');
FormStyle := fsStayOnTop;
end
else
begin
p1 := wdCharacter;
p2 := 1;
app.Selection.Delete(p1,p2);
sel3
end
end;
FormStyle := fsStayOnTop;
end;
function TMainFormWordMM_.sel3: Boolean;
const t1 : WideString = '#@#';
t2 : WideString = '@#@';
t3 : WideString = '@@@';
var p1 : OleVariant;
zz : WideString;
begin
try
case Sel3_bol2 of
1 : zz := t1;
2 : zz := t2;
3 : zz := t3;
end;
//-----------------------------------
if app.Selection.Text<>zz then
begin
App.Selection.Find.ClearFormatting;
With App.Selection.Find do
begin
Text := zz;
Replacement.Text := '';
Forward := True;
Wrap := wdFindContinue;
Format := False;
MatchCase := False;
MatchWholeWord := False;
MatchWildcards := False;
MatchSoundsLike := False;
MatchAllWordForms := False;
End;
if App.Selection.Find.Execute(EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam) then
begin
result := False
end
else
begin
case Sel3_bol2 of
1 : begin
Sel3_bol2 := 2;
result := sel3;
end;
2 : begin
SpeedButton2.Enabled := False;
Sel3_bol2 := 3;
result := sel3;
end;
3 : begin
p1 := wdStory;
App.Selection.HomeKey(p1,EmptyParam);
if set_aaa=0 then
begin
result := False;
Caption := gCapt + 'Маркировки статей';
ShowStep(4);
ShowMessage('Проверте внимательно начало '#13#10'каждой статьи (ВЕРХНИЙ РЕГИСТР, Полужирный)');
FormStyle := fsStayOnTop;
end
else
begin
Sel3_bol2 := 1;
result := sel3;
ShowMessage('Вы НЕВЕРНО обработали разрывы текста'#13#10'(Зеленая метка "@@@")'#13#10#13#10'Этап не завершен.');
FormStyle := fsStayOnTop;
end
end;
end;
end;
end
else
begin
result := True
end;
except
result := False
end;
FormStyle := fsStayOnTop;
end;
procedure TMainFormWordMM_.Button6Click(Sender: TObject);
begin
if sel3 then
begin
app.Selection.TypeBackspace;
sel3
end;
FormStyle := fsStayOnTop;
end;
procedure TMainFormWordMM_.Button7Click(Sender: TObject);
var j,k : Integer;
p1,p2,p3 : OleVariant;
sss : AnsiString;
begin
WordList.Clear;
k := doc1.Paragraphs.Count;
for j:=1 to k do
begin
doc1.Paragraphs.Item(j).Range.Select;
p1 := wdCharacter;
p2 := 1;
p3 := wdExtend;
app.Selection.MoveLeft(p1,p2,EmptyParam);
if app.Selection.Font.Bold<>0 then
begin
p1 := wdWord;
sss := '';
while (app.Selection.Font.Bold<>0) and (pos(#13,sss)=0) do
begin
app.Selection.MoveRight(p1,p2,p3);
sss := app.Selection.Text;
p1 := wdCharacter;
app.Selection.MoveRight(p1,p2,EmptyParam);
end;
if pos(#13,sss)=0 then p2 := 3
else p2 := 1;
app.Selection.MoveLeft(p1,p2,EmptyParam);
p1 := wdLine;
app.Selection.HomeKey(p1,p3);
sss := app.Selection.Text;
if pos(#13,sss)=0 then
begin
WordList.Add(sss);
p1 := wdLine;
app.Selection.HomeKey(p1,EmptyParam);
app.Selection.TypeText('@#@#@ ');
end
end;
Application.ProcessMessages;
end;
ShowMessage('Найдено всего статей'#13#10+WordList.Text);
FormStyle := fsStayOnTop;
end;
procedure TMainFormWordMM_.Button9Click(Sender: TObject);
begin
sel3
end;
function TMainFormWordMM_.set_aaa:Integer;
var k,j : Integer;
p1,p2,p3 : OleVariant;
zz : AnsiString;
bol : Boolean;
begin
bol := FindWindow('TMesFormMM_', nil)=0;
if bol then
begin
Hide;
StartMes('Идет обработка документа.'#13#10'Ждите...');
end;
result := 0;
//----------------------------------
k := doc1.Paragraphs.Count;
for j:=1 to k do
begin
doc1.Paragraphs.Item(j).Range.Select;
if not app.Selection.Information[wdWithInTable] then
begin
p1 := wdCharacter;
p2 := 1;
app.Selection.MoveLeft(p1,p2,EmptyParam);
p2 := 3;
p3 := wdExtend;
app.Selection.MoveRight(p1,p2,p3);
zz := app.Selection.Text;
if (zz<>'#@#') and (zz<>'@#@') and (pos(#13,zz)=0) and (not IsCharUpper(zz[1])) then
begin
p2 := 1;
app.Selection.MoveLeft(p1,p2,EmptyParam);
app.Selection.Font.Color := wdColorGreen;
app.Selection.TypeText('@@@');
Inc(result)
end
end;
Application.ProcessMessages;
end;
if bol then
begin
CloseMes;
Show;
end
end;
procedure TMainFormWordMM_.FormActivate(Sender: TObject);
begin
FormStyle := fsStayOnTop
end;
end.
|
|
Проблемы с FormStyle=fsStayOnTo, форма пропадает 
Загрузка ...
