Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/spmate12/spellwnd.pa$/spellwnd.pas

Pascal/Delphi Source File | 1993-07-22 | 21.9 KB | 742 lines

{*******************************************************}
{                                                       }
{       Turbo Pascal for Windows                        }
{       Standard windows unit for ObjectWindows         }
{                                                       }
{       Copyright (c) 1991 Borland International        }
{                                                       }
{=======================================================}
{       Modifications to allows Spell Checker           }
{       SpelMate DLL to be accesses.                    }
{       Copyright (c) 1993 Aciran Software systems      }
{*******************************************************}

unit SpellWnds;

{$R SpellWNDS.RES}

interface

uses WinTypes, WinProcs, WinDos, Objects, OWindows, ODialogs,
  OMemory, OStdDlgs, Strings,Win31;

const
  cm_spell   = 101;
  MaxWordLen = 20;


{create function prototypes}
type
  TSpelmateInit = function :integer;
  TSpellCheck = function (AWord:Pchar):BOOL;
  TSuggestWord = function(AWord:PChar):PChar;
  TDisplayAtTop = procedure;


{create a new edit type so we can get a handle direct to its text buffer
 for faster scanning}
type
   PNewEdit = ^TNewEdit;
   TNewEdit = object(TEdit)
   function GetHandle:word;
end;


type

  { TSearchRec }
  TSearchRec = record
    SearchText: array[0..80] of Char;
    CaseSensitive: Bool;
    ReplaceText: array[0..80] of Char;
    ReplaceAll: Bool;
    PromptOnReplace: Bool;
    IsReplace: Boolean;
  end;

  { TEditWindow  }
  PEditWindow = ^TEditWindow;
  TEditWindow = object(TWindow)
    Editor: PNewEdit;
    SearchRec: TSearchRec;
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
    procedure WMSize(var Msg: TMessage);
      virtual wm_First + wm_Size;
    procedure WMSetFocus(var Msg: TMessage);
      virtual wm_First + wm_SetFocus;
    procedure CMEditFind(var Msg: TMessage);
      virtual cm_First + cm_EditFind;
    procedure CMEditFindNext(var Msg: TMessage);
      virtual cm_First + cm_EditFindNext;
    procedure CMEditReplace(var Msg: TMessage);
      virtual cm_First + cm_EditReplace;
    procedure CMSpell(var Msg: TMessage); {Spell check option added}
      virtual cm_First + cm_Spell;
  private
    procedure DoSearch;
  end;

  { TFileWindow }
  PFileWindow = ^TFileWindow;
  TFileWindow = object(TEditWindow)
    FileName: PChar;
    IsNewFile: Boolean;
    constructor Init(AParent: PWindowsObject; ATitle, AFileName: PChar);
    destructor Done; virtual;
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
    function CanClear: Boolean; virtual;
    function CanClose: Boolean; virtual;
    procedure NewFile;
    procedure Open;
    procedure Read;
    procedure SetFileName(AFileName: PChar);
    procedure ReplaceWith(AFileName: PChar);
    function Save: Boolean;
    function SaveAs: Boolean;
    procedure SetupWindow; virtual;
    procedure Write;
    procedure CMFileNew(var Msg: TMessage);
      virtual cm_First + cm_FileNew;
    procedure CMFileOpen(var Msg: TMessage);
      virtual cm_First + cm_FileOpen;
    procedure CMFileSave(var Msg: TMessage);
      virtual cm_First + cm_FileSave;
    procedure CMFileSaveAs(var Msg: TMessage);
      virtual cm_First + cm_FileSaveAs;
  end;

const
  REditWindow: TStreamRec = (
    ObjType: 80;
    VmtLink: Ofs(TypeOf(TEditWindow)^);
    Load:    @TEditWindow.Load;
    Store:   @TEditWindow.Store);

const
  RFileWindow: TStreamRec = (
    ObjType: 81;
    VmtLink: Ofs(TypeOf(TFileWindow)^);
    Load:    @TFileWindow.Load;
    Store:   @TFileWindow.Store);

procedure RegisterStdWnds;

implementation

{make instances of the functions from our prototypes}
var
SpelmateInit : TSpelmateInit;
SpellCheck : TSpellCheck;
SuggestWord : TSuggestWord;
DisplayAtTop : TDisplayAtTop;

{ TSearchDialog }

const
  sd_Search          = MakeIntResource($7F10);
  sd_Replace         = MakeIntResource($7F11);
  sd_BCSearch        = MakeIntResource($7F12);
  sd_BCReplace       = MakeIntResource($7F13);
  id_SearchText      = 100;
  id_CaseSensitive   = 101;
  id_ReplaceText     = 102;
  id_ReplaceAll      = 103;
  id_PromptOnReplace = 104;

type
  PSearchDialog = ^TSearchDialog;
  TSearchDialog = object(TDialog)
    constructor Init(AParent: PWindowsObject; Template: PChar;
      var SearchRec: TSearchRec);
  end;

constructor TSearchDialog.Init(AParent: PWindowsObject; Template: PChar;
  var SearchRec: TSearchRec);
var
  C: PWindowsObject;
begin
  TDialog.Init(AParent, Template);
  C := New(PEdit, InitResource(@Self, id_SearchText,
    SizeOf(SearchRec.SearchText)));
  C := New(PCheckBox, InitResource(@Self, id_CaseSensitive));
  if (Template = sd_Replace) or (Template = sd_BCReplace) then
  begin
    C := New(PEdit, InitResource(@Self, id_ReplaceText,
      SizeOf(SearchRec.ReplaceText)));
    C := New(PCheckBox, InitResource(@Self, id_ReplaceAll));
    C := New(PCheckBox, InitResource(@Self, id_PromptOnReplace));
  end;
  TransferBuffer := @SearchRec;
end;

function TNewEdit.GetHandle;
begin
  GetHandle := SendMessage(HWindow,EM_GETHANDLE,0,LongInt(0));
end;

{ TEditWindow }

{ Constructor for a TEditWindow.  Initializes its data fields using passed
  parameters and default values.  Constructs its child edit control. }
constructor TEditWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);
  {NOTE: we use our new edit type here}
  Editor := New(PNewEdit, Init(@Self, 200, nil, 0, 0, 0, 0, 0, True));
  with Editor^.Attr do
    Style := Style or es_NoHideSel;
  FillChar(SearchRec, SizeOf(SearchRec), #0);
end;

{ Load a TEditWindow from the given stream }
constructor TEditWindow.Load(var S: TStream);
begin
  TWindow.Load(S);
  GetChildPtr(S, Editor);
end;

{ Store a TEditWindow to the given stream }
procedure TEditWindow.Store(var S: TStream);
begin
  TWindow.Store(S);
  PutChildPtr(S, Editor);
end;

{ Responds to an incoming wm_Size message by resizing the child edit
  control according to the size of the TEditWindow's client area. }
procedure TEditWindow.WMSize(var Msg: TMessage);
begin
  TWindow.WMSize(Msg);
  SetWindowPos(Editor^.HWindow, 0, -1, -1, Msg.LParamLo+2, Msg.LParamHi+2,
    swp_NoZOrder);
end;

{ Responds to an incoming wm_SetFocus message by setting the focus to the
  child edit control. }
procedure TEditWindow.WMSetFocus(var Msg: TMessage);
begin
  SetFocus(Editor^.HWindow);
end;

procedure TEditWindow.DoSearch;
var
  S: array[0..80] of Char;
  P: Pointer;
  Rslt: Integer;
begin
  Rslt := 0;
  with SearchRec do
    repeat
      Rslt := Editor^.Search(-1, SearchText, CaseSensitive);
      if Rslt = -1 then
      begin
        if not IsReplace or not ReplaceAll then
        begin
          P := @SearchText;
          WVSPrintF(S, '"%0.60s" not found.', P);
          MessageBox(HWindow, S, 'Find error', mb_OK + mb_IconExclamation);
        end;
      end
      else
        if IsReplace then
          if not PromptOnReplace then Editor^.Insert(ReplaceText)
          else
          begin
            Rslt := MessageBox(HWindow, 'Replace this occurrence?',
              'Search/Replace', mb_YesNoCancel + mb_IconQuestion);
            if Rslt = id_Yes then Editor^.Insert(ReplaceText)
            else if Rslt = id_Cancel then Exit;
          end;
    until (Rslt = -1) or not ReplaceAll or not IsReplace;
end;

procedure TEditWindow.CMEditFind(var Msg: TMessage);
var
  Dialog: PChar;
begin
  if BWCCClassNames then
    Dialog := sd_BCSearch
  else
    Dialog := sd_Search;
  if Application^.ExecDialog(New(PSearchDialog, Init(@Self,
    Dialog, SearchRec))) = id_OK then
  begin
    SearchRec.IsReplace := False;
    DoSearch;
  end;
end;

procedure TEditWindow.CMEditFindNext(var Msg: TMessage);
begin
  DoSearch;
end;

procedure TEditWindow.CMEditReplace(var Msg: TMessage);
var
  Dialog: PChar;
begin
  if BWCCClassNames then
    Dialog := sd_BCReplace
  else
    Dialog := sd_Replace;
  if Application^.ExecDialog(New(PSearchDialog, Init(@Self,
    Dialog, SearchRec))) = id_OK then
  begin
    SearchRec.IsReplace := True;
    DoSearch;
  end;
end;

{ TFileWindow }

{ Constructor for a TFileWindow.  Initializes its data fields using
  passed parameters and default values. }
constructor TFileWindow.Init(AParent: PWindowsObject; ATitle,
  AFileName: PChar);
begin
  TEditWindow.Init(AParent, ATitle);
  IsNewFile := True;
  FileName := StrNew(AFileName);
end;

{ Dispose of the file name }
destructor TFileWindow.Done;
begin
  StrDispose(FileName);
  TEditWindow.Done;
end;

{ Load a TFileWindow from the stream }
constructor TFileWindow.Load(var S: TStream);
begin
  TEditWindow.Load(S);
  FileName := S.StrRead;
  IsNewFile := FileName = nil;
end;

{ Store a TFileWindow from the stream }
procedure TFileWindow.Store(var S: TStream);
begin
  TEditWindow.Store(S);
  S.StrWrite(FileName);
end;

{ Performs setup for a TFileWindow, appending 'Untitled' to its caption }
procedure TFileWindow.SetupWindow;
begin
  TEditWindow.SetupWindow;
  SetFileName(FileName);
  if FileName <> nil then Read;
end;

{ Sets the file name of the window and updates the caption.  Assumes
  that the AFileName parameter and the FileName instance variable were
  allocated by StrNew. }
procedure TFileWindow.SetFileName(AFileName: PChar);
var
  NewCaption: array[0..80] of Char;
  P: array[0..1] of PChar;
begin
  if FileName <> AFileName then
  begin
    StrDispose(FileName);
    FileName := StrNew(AFileName);
  end;
  P[0] := Attr.Title;
  if FileName = nil then P[1] := '(Untitled)'
  else P[1] := AFileName;
  if Attr.Title = nil then SetWindowText(HWindow, P[1])
  else
  begin
    WVSPrintF(NewCaption, '%0.40s - %0.37s', P[0]);
    SetWindowText(HWindow, NewCaption);
  end;
end;

{ Begins the edit of a new file, after determining that it is Ok to
  clear the TEdit's text. }
procedure TFileWindow.NewFile;
begin
  if CanClear then
  begin
    Editor^.Clear;
    InvalidateRect(Editor^.HWindow, nil, False);
    Editor^.ClearModify;
    IsNewFile := True;
    SetFileName(nil);
  end;
end;

{ Replaces the current file with the given file. }
procedure TFileWindow.ReplaceWith(AFileName: PChar);
begin
  SetFileName(AFileName);
  Read;
  InvalidateRect(Editor^.HWindow, nil, False);
end;

{ Brings up a dialog allowing the user to open a file into this
  window.  Save as selecting File|Open from the menus. }
procedure TFileWindow.Open;
var
  TmpName: array[0..fsPathName] of Char;
begin
  if CanClear and (Application^.ExecDialog(New(PFileDialog,
     Init(@Self, PChar(sd_FileOpen), StrCopy(TmpName, '*.*')))) = id_Ok) then
    ReplaceWith(TmpName);
end;

{ Reads the contents of a previously-specified file into the TEdit
  child control. }
procedure TFileWindow.Read;
const
  BufferSize = 1024;
var
  CharsToRead: LongInt;
  BlockSize: Integer;
  AStream: PDosStream;
  ABuffer: PChar;
begin
  AStream := New(PDosStream, Init(FileName, stOpen));
  ABuffer := MemAlloc(BufferSize + 1);
  CharsToRead := AStream^.GetSize;
  if ABuffer <> nil then
  begin
    Editor^.Clear;
    while CharsToRead > 0 do
    begin
      if CharsToRead > BufferSize then
        BlockSize := BufferSize
      else BlockSize := CharsToRead;
      AStream^.Read(ABuffer^, BlockSize);
      ABuffer[BlockSize] := Char(0);
      Editor^.Insert(ABuffer);
      CharsToRead := CharsToRead - BlockSize;
    end;
    IsNewFile := False;
    Editor^.ClearModify;
    Editor^.SetSelection(0, 0);
    FreeMem(ABuffer, BufferSize + 1);
  end;
  Dispose(AStream, Done);
end;

{ Saves the contents of the TEdit child control into the file currently
  being editted.  Returns true if the file was saved. }
function TFileWindow.Save: Boolean;
begin
  Save := True;
  if Editor^.IsModified then
    if IsNewFile then Save := SaveAs
    else Write;
end;

{ Saves the contents of the TEdit child control into a file whose name
  is retrieved from the user, through execution of a "Save" file
  dialog.  Returns true if the file was saved. }
function TFileWindow.SaveAs: Boolean;
var
  TmpName: array[0..fsPathName] of Char;
begin
  SaveAs := False;
  if FileName <> nil then StrCopy(TmpName, FileName)
  else TmpName[0] := #0;
  if Application^.ExecDialog(New(PFileDialog,
      Init(@Self, PChar(sd_FileSave), TmpName))) = id_Ok then
  begin
    SetFileName(TmpName);
    Write;
    SaveAs := True;
  end;
end;

{ Writes the contents of the TEdit child control to a previously-specified
  file.  If the operation will cause truncation of the text, first confirms
  (through displaying a message box) that it is OK to proceed. }
procedure TFileWindow.Write;
const
  BufferSize = 1024;
var
  CharsToWrite, CharsWritten: LongInt;
  BlockSize: Integer;
  AStream: PDosStream;
  ABuffer: pointer;
  NumLines: Integer;
begin
  NumLines := Editor^.GetNumLines;
  CharsToWrite := Editor^.GetLineIndex(NumLines-1) +
    Editor^.GetLineLength(NumLines-1);
  AStream := New(PDosStream, Init(FileName, stCreate));
  ABuffer := MemAlloc(BufferSize + 1);
  CharsWritten := 0;
  if ABuffer <> nil then
  begin
    while CharsWritten < CharsToWrite do
    begin
      if CharsToWrite - CharsWritten > BufferSize then
        BlockSize := BufferSize
      else BlockSize := CharsToWrite - CharsWritten;
      Editor^.GetSubText(ABuffer, CharsWritten, CharsWritten + BlockSize);
      AStream^.Write(ABuffer^, BlockSize);
      CharsWritten := CharsWritten + BlockSize;
    end;
    IsNewFile := False;
    Editor^.ClearModify;
    FreeMem(ABuffer, BufferSize + 1);
  end;
  Dispose(AStream, Done);
end;

{ Returns a Boolean value indicating whether or not it is Ok to clear
  the TEdit's text.  Returns True if the text has not been changed, or
  if the user Oks the clearing of the text. }
function TFileWindow.CanClear: Boolean;
var
  S: array[0..fsPathName+27] of Char;
  P: PChar;
  Rslt: Integer;
begin
  CanClear := True;
  if Editor^.IsModified then
  begin
    if FileName = nil then StrCopy(S, 'Untitled file has changed. Save?')
    else
    begin
      P := FileName;
      WVSPrintF(S, 'File "%s" has changed.  Save?', P);
    end;
    Rslt := MessageBox(HWindow, S, 'File Changed', mb_YesNoCancel or
      mb_IconQuestion);
    if Rslt = id_Yes then CanClear := Save
    else CanClear := Rslt <> id_Cancel;
  end;
end;

{ Returns a Boolean value indicating whether or not it is Ok to close
  the TEdit's text.  Returns the result of a call to Self.CanClear. }
function TFileWindow.CanClose: Boolean;
begin
  CanClose := CanClear;
end;

{ Responds to an incoming "New" command (with a cm_FileNew command
  identifier) by calling Self.New. }
procedure TFileWindow.CMFileNew(var Msg: TMessage);
begin
  NewFile;
end;

{ Responds to an incoming "Open" command (with a cm_FileOpen command
  identifier) by calling Self.Open. }
procedure TFileWindow.CMFileOpen(var Msg: TMessage);
begin
  Open;
end;

{ Responds to an incoming "Save" command (with a cm_FileSave command
  identifier) by calling Self.Save. }
procedure TFileWindow.CMFileSave(var Msg: TMessage);
begin
  Save;
end;

{ Responds to an incoming "SaveAs" command (with a cm_FileSaveAs command
  identifier) by calling Self.SaveAs. }
procedure TFileWindow.CMFileSaveAs(var Msg: TMessage);
begin
  SaveAs;
end;

procedure RegisterStdWnds;
begin
  RegisterType(REditWindow);
  RegisterType(RFileWindow);
end;

{Here is our EditWindows Spell method}
procedure TEditWindow.CMSpell;
var
startpos,endpos,i,chs,lines,origin,countoffset:integer;
chz:array[0..1] of char;
ch:char;
AWord,NewWord : array[0..30] of char;
Handle,EdHandle :THandle;
EdPnt : pointer;
nextcount,result,FirstLine,CurrentLine,NOLinesVisible,
          DistFromMenuBar,NCAHeight,TextY,ScreenHeight : integer;
Dialog : PDlgWindow;
Tm : TTextMetric;
EditDC: HDC;
W:Word;
Points :TPoint;

{ Given a text buffer, read it and return the next word }
{ We can use out Edit contol like a very long PChar string by
 getting a pointer to the text it contains, then parsing this long string
 and extacting the words one by one}

function GetWord(S,F:Pchar): PChar;
var
  C : Char;
  I: Integer;
begin
  I := 0;
  C := #0;
  { find first letter }
  while not (nextcount > Strlen(F)) and not (UpCase(C) in ['A'..'Z']) do
  begin
    C:= F[nextcount];
    inc(nextcount);
  end;
  { special test in case end of file }
  if (nextcount = Strlen(F)) and (UpCase(C) in ['A'..'Z']) then
  begin
    if (I < MaxWordLen) then
     begin
      S[I] := C;
      inc(I);
     end;
  end
  else
    { read chars from file, append to S }
    while (UpCase(C) in ['A'..'Z','''','-']) and not (nextcount > Strlen(F)) do
    begin
      if I < MaxWordLen then
      begin
        S[I] := C;
        Inc(I);
      end;
      C:= F[nextcount];
      inc(nextcount);
    end;
  S[I] := #0;
  GetWord := S;
end;

begin
  {Load Spelling DLL}
  LoadCursor(0,IDC_WAIT);
  Handle := LoadLibrary('Spelmate.Dll');
  LoadCursor(0,IDC_ARROW);
  if Handle < 32 then  {if failed to load/find DLL inform user}
  begin
   MessageBeep(0);
   MessageBox(HWindow,'Unable to Load Spelling Dll','Application Error',MB_OK or
   MB_ICONSTOP);
   Exit;
  end;
  {Set our function addresses up to those in the DLL, should check really
   that they are not nil, as this indicates an error}
  @SpelmateInit := GetProcAddress(Handle,'SpelmateInit');
  @SpellCheck := GetProcAddress(Handle,'Spellcheck');
  @SuggestWord := GetProcAddress(Handle,'SuggestWord');
  @displayAtTop := GetProcAddress(Handle,'DisplayAtTop');
  {This dialog is just to keep the user happy while the main dictionary is
   being loaded as this can take a few seconds}
  Dialog :=New(PDlgWindow,Init(nil,'LoadSpell'));
  Application^.MakeWindow(Dialog);
  {Ask the DLL to init, and get back the status information}
  result := SpelmateInit;
  {remove the dialog now DLL loaded}
  Dialog^.done;
  {if result = -1 then OK}
  if result <> -1 then
  begin
    MessageBox(HWindow,'Cannot Access Spelling Dictionary','Application Error',MB_OK or MB_ICONSTOP);
    Exit;
  { if result not -1 then an error occurred, and so do not spell check}
  { Possible error codes are }
  { 0 not enough memory }
  { 1 Main dictionary not found}
  { 2 Stream access error, main dictionary}
  { 3 Initialisation error, main dictionary}
  { 4 Read error, main dictionary}
  { 5 Corrupt file or wrong file type, error, main dictionary}
  { 6 Stream access error, private dictionary}
  { 7 Initialisation error, private dictionary}
  { 8 Read error, private dictionary}
  { 9 Corrupt file or wrong file type, error, private dictionary}
  end;
  Editor^.GetSelection(startpos,endpos); {set pointers to current cursor position}
  nextcount := startpos;
  origin := startpos;{ remember where started}
  Edhandle := Editor^.GetHandle;{ get a handle to local edit buffer}
  EdPnt := LocalLock(EdHandle); { make a pointer to editor text buffer}
  repeat
  if GetWord(AWord,EdPnt)^ <> #0 then  {while not end of editor text,scan}
  begin
  if AWord[StrLen(AWord)-1] = '''' then
  AWord[Strlen(AWord)-1] := #0;{if word was in quotes,remove end one}
  if not spellcheck(AWord) then {if word not found in main,private or IgnoreAll dictionary}
  begin
    Editor^.SetSelection(nextcount-Strlen(AWord)-1,nextcount-1); {Highlight Word not in dictionary}

    W := LoWord(GetVersion);
    if (Lo(W) = 3) and (Hi(W) >= 10) then {check Windows > 3.0 as using 3.1 call}
    begin
      {Find if text in upper half of screen (NOT trivial!)}
      FirstLine := SendMessage(Editor^.HWindow,EM_GETFIRSTVISIBLELINE,0,0);
      CurrentLine := Editor^.GetLineFromPos(-1);  {-1 gets line selected text is on}
      NoLinesVisible := CurrentLine - FirstLine + 1;

      {get the height of each line}
      EditDC := GetDC(Editor^.HWindow);
      GetTextMetrics(EditDC,Tm);
      ReleaseDC(Editor^.HWindow,EditDC);

      {Now get the distance from the text to the top of the client area}
      {The following is not 100% accurate but is good enough for our purposes}
      DistFromMenuBar := Tm.tmHeight * NoLinesVisible;

      {get height of menu bar + title + frame (SM_CYCAPTION does title & frame)}
      NCAHeight := GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CYCAPTION);


      {calculate relative Y location of text}
      TextY := NCAHeight + DistFromMenuBar;

      {convert to absolute screen coordinates}
      Points.X := 0;
      Points.Y := TextY;
      ClienttoScreen(Editor^.HWindow,Points);
      TextY := Points.Y;

      {get height of screen}
      ScreenHeight := GetSystemMetrics(SM_CYSCREEN);

      {FINALLY! if text in lower half of screen put suggest word dialog at top}
      if (TextY > (ScreenHeight div 2)) then
         DisplayAtTop;
    end;

    StrCopy(NewWord,suggestword(AWord)); {get word user chose during suggestion}
    if NewWord[0] = #0 then {if blank, cancel was selected}
    begin
    Editor^.SetSelection(origin,origin); {return to start position}
    Exit;
    end
  else
    begin
      if StrComp(Aword,NewWord) <> 0 then {if words are not the same,change}
      begin
        countoffset := Strlen(NewWord) - Strlen(AWord);
        Editor^.DeleteSubText(nextcount-Strlen(AWord)-1,nextcount-1); {remove old highlighted word}
        Editor^.Insert(NewWord); {replace with new one}
        nextcount := nextcount + countoffset; {adjust pointer in case new word was larger or smaller}
      end;
    end;
  end;
  end;
  until AWord[0] = #0;
LocalUnlock(EdHandle); {release Editor Memory Block}
FreeLibrary(Handle); {release Spelmate DLL, or you may wait until your program exits, and do it in your destructor}
MessageBox(HWindow,'Spell Checking Complete','All Done!',MB_OK);
Editor^.SetSelection(origin,origin); {return to start position}
end;

end.