| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj, ShlObj;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
public
end;
var Form1: TForm1;
implementation
{$R *.dfm}
function Select_Dir(Form: TForm): string;
var
TitleName, s: string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Выберите папку :';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId<>nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
s:=TempPath ;
if s[length(s)]<>'\' then Result:=s+'\'
else Result:=s;
GlobalFreePtr(lpItemID);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if not(DirectoryExists(ExtractFilePath(Application.ExeName)+'TXT'))then
CreateDir(ExtractFilePath(Application.ExeName)+'TXT');
end;
procedure TForm1.Button1Click(Sender: TObject);
var Docs_Dir,Text_Dir,new_name: string;
WordApp: Variant;
sr: TSearchRec;
begin
Docs_Dir:=Select_Dir(Form1);
Text_Dir:=ExtractFilePath(Application.ExeName)+'TXT';
if Docs_Dir='' then Exit;
FindFirst(Docs_Dir+'*.doc',faArchive,sr);
WordApp:=CreateOleObject('Word.Basic');
repeat
new_name:=ChangeFileExt(sr.Name,'.txt');
WordApp.FileOpen(Docs_Dir+sr.Name);
WordApp.FileSaveAs(Name:=Text_Dir+'\'+new_name, Format := 2);
until FindNext(sr)<>0;
WordApp.AppClose;
WordApp:= Unassigned;
FindClose(sr);
end;
end.
|
Поимогите избавится от мигания при конвертировании.
Если кто знает как можно сделать другим путем, пишите ...
Добавлено @ 23:11
Есть еще у меня такая функция:
| Код |
function ConvertDoc2Rtf(var FileName: string) : Boolean;
var
oWord: OleVariant;
oDoc: OleVariant;
begin
Result := False;
try
oWord := GetActiveOleObject('Word.Application');
except
oWord := CreateOleObject('Word.Application');
end;
oWord.Documents.Open(FileName);
oDoc := oWord.ActiveDocument;
FileName := ChangeFileExt(FileName, '.rtf');
oDoc.SaveAs(FileName);
oWord.ActiveDocument.Close(EmptyParam, EmptyParam);
oWord.Quit(EmptyParam, EmptyParam, EmptyParam);
oDoc := VarNull;
oWord := VarNull;
Result := True;
end;
|
тоже не работает по какой-то причине .... может кому удастся исправить??? |
