CD Direkt 1995 #1/Image.iso/cdd/winanw2/spelmate/spelchek.pas

Pascal/Delphi Source File | 1993-09-20 | 6KB | 239 lines

{***************************************************}
{                                                   }
{   SpelChek.Pas                                        }
{                                                   }
{   Copyright (c) 1993 by Aciran Software Systems   }
{                                                   }
{***************************************************}


program SpelChek;


uses WinTypes,
     WinProcs,
     WinDos,
     Strings,
     Objects,
     OWindows,
     ODialogs,
     OStdDlgs,
     CommDlg,
     Spell; {Use am Import Unit to Load DLL on startup}

{$R spelfile}

const
  MaxWordLen = 20;

{ Resource IDs }

  id_Menu       = 100;
  id_About      = 100;


{ Menu command IDs }

  cm_FileOpen   = 101;
  cm_HelpAbout  = 106;

{ Other Constants }


{ Filename string }
  type
  TFileName = array [0..255] of char;


{ Application main window }

  type

  PScanTextWindow = ^TScanTextWindow;
  TScanTextWindow = Object(TWindow)

    FileName : TFileName;

    constructor Init(AParent: PWindowsObject; AName: PChar);
    destructor  Done; virtual;

    procedure SetupWindow; virtual;

    procedure CMFileOpen(var Msg: TMessage);
      virtual cm_First + cm_FileOpen;
    procedure CMHelpAbout(var Msg: TMessage);
      virtual cm_First + cm_HelpAbout;
    procedure ScanTextFile(AFileName:Pchar);
    function GetWord(S: PChar; var F : Text): PChar;
 end;

{ Application object }
type
  TScanTextApp = Object(TApplication)
  procedure InitMainWindow; virtual;
end;

{ Initialized globals }

const
  ProgramTitle: PChar = 'Text File Spell Checker for Windows';

{ Global variables }

var
  App: TScanTextApp;
  WordRead: array[0..MaxWordLen] of Char;
  Abort : Boolean;



{ TScanTextWindow Methods }

constructor TScanTextWindow.Init(AParent: PWindowsObject; AName: PChar);
var result :integer;
begin
  TWindow.Init(AParent, AName);
  Attr.Menu:= LoadMenu(HInstance, PChar(id_Menu));
  StrCopy(FileName, '');
  result := SpelmateInit;
  if result >=0 then
  begin
    MessageBox(HWindow,'Spell Checker Failed to load successfully','Application error',MB_OK);
    Halt;
  end;
end;

destructor TScanTextWindow.Done;
begin
  TWindow.Done;
 end;

procedure TScanTextWindow.SetUpWindow;
begin
  TWindow.SetupWindow;
end;

{ Displays the "Open File Dialog" from Common dialogs and permit the user
  to select from among the available ascii files.
}
procedure TScanTextWindow.CMFileOpen(var Msg: TMessage);
const
  DefExt = 'txt';
var
  OpenFN      : TOpenFileName;
  Filter      : array [0..100] of Char;
  FullFileName: TFilename;
begin
  StrCopy(FullFileName, '');

{ Set up a filter buffer to look for Doc & Text files only.  Recall that filter
  buffer is a set of string pairs, with the last one terminated by a
  double-null.
}
  FillChar(Filter, SizeOf(Filter), #0);  { Set up for double null at end }
  StrCopy(Filter, 'ASCII Files');
  StrCopy(@Filter[StrLen(Filter)+1], '*.doc;*.txt');

  FillChar(OpenFN, SizeOf(TOpenFileName), #0);
  with OpenFN do
  begin
    hInstance     := HInstance;
    hwndOwner     := HWindow;
    lpstrDefExt   := DefExt;
    lpstrFile     := FullFileName;
    lpstrFilter   := Filter;
    lpstrFileTitle:= FileName;
    flags         := ofn_FileMustExist;
    lStructSize   := sizeof(TOpenFileName);
    nFilterIndex  := 1;       {Index into Filter String in lpstrFilter}
    nMaxFile      := SizeOf(FullFileName);
  end;
  if GetOpenFileName(OpenFN) then
    ScanTextFile(FullFileName);
end;

{ Displays the program's About Box dialog.
}
procedure TScanTextWindow.CMHelpAbout(var Msg: TMessage);
begin
  Application^.ExecDialog(New(PDialog, Init(@Self, 'About')));
end;


{ TScanTextApp Methods }

procedure TScanTextApp.InitMainWindow;
begin
  MainWindow := New(PScanTextWindow, Init(nil, 'Text File Spell Checker for Windows'));
end;

{ Given an open text file, read it and return the next word }

function TScanTextWindow.GetWord(S: PChar; var F : Text): PChar;
var
  C : Char;
  I: Integer;
begin
  I := 0;
  C := #0;
  { find first letter }
  while not Eof(F) and not (UpCase(C) in ['A'..'Z','''']) do
    Read(F, C);
  { special test in case end of file }
  if Eof(F) and (UpCase(C) in ['A'..'Z','''']) then
  begin
    if (I < MaxWordLen) then S[I] := C;
  end
  else
    { read chars from file, append to S }
    while (UpCase(C) in ['A'..'Z','''']) and not Eof(F) do
    begin
      if I < MaxWordLen then
      begin
        S[I] := C;
        Inc(I);
      end;
      Read(F, C);
    end;
  S[I] := #0;
  if I >= 1 then
  if S[I-1] = '''' then {get rid of trailing apostrophies}
  S[I-1] := #0;
  if S[0] = '''' then {and leading ones}
  Move(S,S[1],Strlen(S) -1);
  GetWord := S;
end;

procedure TScanTextWindow.ScanTextFile(AFileName:Pchar);
var
 WordFile:Text;
 result:PChar;
begin
 Abort := false;
 Assign(WordFile,AFileName);        {Assign Handle to External file}
 ReSet(WordFile);                              {Open for Read Only}
  repeat
    if GetWord(WordRead, WordFile)^ <> #0 then
      if not Spellcheck(WordRead) then
      begin
        MessageBeep(0);
        result := suggestword(WordRead);
        if result[0] <> #0 then
        MessageBox(HWindow,result,'Word Selected',MB_OK)
      else
        Abort := true;
      end;
  until (WordRead[0] = #0) or Abort;
  Close(WordFile);
  MessageBeep(0);
  MessageBox(0,'Spell Check Complete','All Done',MB_OK);
end;

{ Main program }

begin
  App.Init(ProgramTitle);
  App.Run;
  App.Done;
end.