Colegas montei esse exemplo de corretor com códigos do site Torry's
Está meio bagunçado más está funcionando
Só que se tiver mais de uma palavra para corrigir aparece um caractere estranho tipo quebra de linha onde está atribuindo esse caractere
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Word2000, Psapi, tlhelp32, OleServer, WordXP;
type
TForm1 = class(TForm)
Button1: TButton;
WordApp: TWordApplication;
WordDoc: TWordDocument;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
function IsSatzZeichen(c: CHAR): Boolean;
procedure CheckText(Memo: TMemo);
function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
function KillTask(ExeFileName: string): Integer;
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
procedure GetProcessList(var List: TstringList);
procedure CreateWin9xProcessList(List: TstringList);
procedure CreateWinNTProcessList(List: TstringList);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.CheckText(Memo: TMemo);
var
i: Integer;
MySelStart: INTEGER;
Token: string;
Line: string;
ReplaceStr: string;
WordList: TStrings;
varFalse: OleVariant;
begin
// Läuft Word?
if EXE_Running('WINWORD.EXE', False) then
begin
if mrYes = MessageDlg('Word ist geöffnet.' + #13 + #10 +
'Für die Rechtschreibprüfung muss Word beendet werden.' + #13 + #10 +
'' + #13 + #10 + 'Word abschiessen?', mtWarning, [mbYes, mbNo], 0) then
begin
KillTask('WINWORD.EXE');
end;
end
else
begin
// Startwerte
i := 1;
Line := Memo.Text;
WordList := TStringList.Create;
// Memo traviersieren und einzelne Wörter (Token) rausholen
while not (Line[i] = #0) do
begin
Token := '';
// Tokem zusammenstellen
while not IsSatzZeichen(Line[i]) do
begin
Token := Token + Line[i];
Inc(i);
end;
if Token <> '' then
begin
// Token speichern
WordList.Add(Token);
end;
if IsSatzZeichen(Line[i]) then
begin
// "Token" speichern
WordList.Add(Line[i]);
Inc(i);
end;
end;
// Verbindung zu Word aufbauen
WordApp.Disconnect;
WordDoc.Disconnect;
WordApp.Connect;
WordApp.Visible := False;
// Leeres Dokument erzeugen
WordDoc.ConnectTo(WordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam));
MySelStart := 0;
// WordList traversieren und auf Rechschreibung prüfen
for i := 0 to WordList.Count - 1 do
begin
if not IsSatzzeichen(Wordlist[i][1]) then
begin
WordApp.Visible := False;
// WordDokumentinhalt löschen
WordDoc.Range.Delete(EmptyParam, EmptyParam);
// Token in Word einfügen
WordDoc.Range.Set_Text(WordList[i]);
// Rechtschreibprüfung aufrufen
WordApp.Visible := False;
WordDoc.CheckSpelling;
WordApp.Visible := False;
// Resultat von der Rechtschreibprüfung holen und aufbereiten
ReplaceStr := WordDoc.Range.Get_Text;
WordApp.Visible := False;
//--- ReplaceStr := ReplaceString(ReplaceStr, #$D, '');
// Neues Wort in Memo einfügen
Memo.SetFocus;
Memo.SelStart := MySelStart;
Memo.SelLength := Length(WordList[i]);
Memo.SelText := ReplaceStr;
WordList[i] := ReplaceStr;
end;
MySelStart := MySelStart + Length(WordList[i]);
end;
MessageDlg('Correção Ortográfica concluída', mtInformation, [mbOK], 0);
// Verbindung zu Word abbrechen und Word schliessen ohne zu speichern
WordDoc.Disconnect;
WordApp.Disconnect;
varFalse := False;
WordApp.Quit(varFalse);
end;
end;
function TForm1.IsSatzZeichen(c: CHAR): Boolean;
begin
case c of
'(': Result := True;
')': Result := True;
' ': Result := True;
'.': Result := True;
',': Result := True;
'!': Result := True;
'?': Result := True;
'-': Result := True;
':': Result := True;
';': Result := True;
#$D: Result := True;
#$A: Result := True;
else
Result := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CheckText(Memo1);
end;
function TForm1.EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
Result := False;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
begin
if not bFullpath then
begin
if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
Result := True
end
else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
if Result then Break;
end;
finally
MyProcList.Free;
end;
end;
function TForm1.KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure TForm1.GetProcessList(var List: TstringList);
var
ovi: TOSVersionInfo;
begin
if List = nil then Exit;
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(ovi);
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
end
end;
function TForm1.ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
begin
while Pos(SearchStr, Str) <> 0 do
begin
Insert(ReplaceStr, Str, Pos(SearchStr, Str));
Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
end;
Result := Str;
end;
procedure TForm1.CreateWin9xProcessList(List: TstringList);
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
if List = nil then Exit;
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
begin
List.Add(ProcInfo.szExeFile);
while (Process32Next(hSnapShot, ProcInfo)) do
List.Add(ProcInfo.szExeFile);
end;
CloseHandle(hSnapShot);
end;
end;
procedure TForm1.CreateWinNTProcessList(List: TstringList);
var
PIDArray: array [0..1023] of DWORD;
cb: DWORD;
I: Integer;
ProcCount: Integer;
hMod: HMODULE;
hProcess: THandle;
ModuleName: array [0..300] of Char;
begin
if List = nil then Exit;
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
ProcCount := cb div SizeOf(DWORD);
for I := 0 to ProcCount - 1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False,
PIDArray[I]);
if (hProcess <> 0) then
begin
EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
List.Add(ModuleName);
CloseHandle(hProcess);
end;
end;
end;
end.
Pergunta
Marcos Santana
Colegas montei esse exemplo de corretor com códigos do site Torry's
Está meio bagunçado más está funcionando
Só que se tiver mais de uma palavra para corrigir aparece um caractere estranho tipo quebra de linha onde está atribuindo esse caractere
Link para o comentário
Compartilhar em outros sites
1 resposta a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.