unit U_Dicmaint;
{Copyright 2000, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, UDict, Grids, ExtCtrls, ComCtrls, Menus, Buttons;

Const
Prechecked=true;
  Compressed=true;
type
TDicMaintForm = class(TForm)
    Label1: TLabel;
    FindEdt: TEdit;
    WordGrid: TStringGrid;
    FindBtn: TButton;
    Panel1: TPanel;
    Label3: TLabel;
    Label5: TLabel;
    MinLenEdit: TEdit;
    MaxLenEdit: TEdit;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    SaveDialog1: TSaveDialog;
    Dictionary1: TMenuItem;
    Load1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    GroupBox1: TGroupBox;
    Shownormal: TCheckBox;
    Showabbrevs: TCheckBox;
    Showforeign: TCheckBox;
    Label4: TLabel;
    StatusBar1: TStatusBar;
    GroupBox2: TGroupBox;
    ReSortBtn: TButton;
    ScanBtn: TButton;
    ABtn: TSpeedButton;

procedure FormActivate(Sender: TObject);
procedure FindEdtKeyPress(Sender: TObject; var Key: Char);
procedure ScanBtnClick(Sender: TObject);
procedure FindBtnClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure WordGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
procedure Load1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure checkboxclick(Sender: TObject);
procedure WordGridDblClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ReSortBtnClick(Sender: TObject);
procedure MinLenEditChange(Sender: TObject);
procedure MaxLenEditChange(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
procedure ABtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
AppPath:string;
    start,stop:char;
    min,max:integer;
    DicName:string;
    initialized:boolean;
procedure AddWord(S: string);
procedure RemoveWord(S: string);
Procedure ReBuildList(s:string);
end;

var
DicMaintForm: TDicMaintForm;
  Dic:TDic;
  heapstat:THeapStatus;

implementation

uses U_AttribEdit;
{$R *.DFM}
Const
endset=[' ',',','.','!','?',')',':',';','/','"','''',#10];
  startset=[' ','(','!','"','''',#10];


Procedure TDicMaintForm.RebuildList(s:string);
const
x:array[0..3] of string =('','(A)','(F)','(A,F)');
var
dicword:string;
  i,j:integer;
  a,f:boolean;

Begin
If not dic.dicloaded then exit;
with dic, WordGrid do
Begin
setrange(start,min,stop,max);
    Wordgrid.rowcount:=(letterindex[succ(start)]-letterindex[start]) div 10 +1;
    i:=-1;
while getnextword(dicword,a,f) do
Begin
if (a and showabbrevs.checked) then j:=1 else j:=0;
if (f and showforeign.checked) then inc(j,2);
      dicword:=dicword+x[j];
If (shownormal.checked and (not a) and (not f))
or (a and showabbrevs.checked)
or (f and showforeign.checked)
then
Begin
inc(i);
        Wordgrid.cells[i mod 10,i div 10]:=dicword;
if s=dicword then
begin
col:=i mod 10;
          row:=i div 10;
end;
End;
End;
for j:= i+1 to (WordGrid.rowcount)*10 -1 do
WordGrid.cells[j mod 10,j div 10]:='';
End;
  WordGrid.setfocus {invalidate};
if dic.dicloaded then
with statusbar1, dic do
begin
panels[0].text:=dicname;
    panels[1].text:='Normal '+ inttostr(totalcount-abbrevcount-foreigncount);
    panels[2].text:='Abbrevs '+ inttostr(abbrevcount);
    panels[3].text:='Foreign '+inttostr(foreigncount);
    panels[4].text:='Total '+inttostr(totalcount);
end;
End;

{************************ AddWord **************}
procedure TDicMaintForm.AddWord(S: string);
var
a,f:boolean;
begin
s:=lowercase(s);
If not dic.lookup(s,a,f) then
Begin
start:=s[1]; stop:=s[1];
    a:=false;
    f:=false;
if length(s)>max then max:=length(s);
if (showabbrevs.checked or showforeign.checked ) then
begin
if (editworddlg.showmodal=MROK) then
with editworddlg do
begin
a:=checkbox1.checked;
        f:=checkbox2.checked;
end;
end;
If dic.addword(s,a,f) then Rebuildlist(s)
else showmessage('Word '+s+ ' not added (too long?)');
End
else showmessage('Word ' + s +' already exists.');
end;

{****************** FindBtnClick ***************}
procedure TDicMaintForm.FindBtnClick(Sender: TObject);
var
a,f:boolean;
  s:string;
begin
s:=lowercase(FindEdt.text);
if dic.IsValidword (s) then
If dic.lookup(s,a,f) then
Begin
start:=s[1]; stop:=s[1];
If min>length(s) then min:=length(s);
If max<length(s) then max:=length(s);
      rebuildlist(s);
with WordGrid do
If (row<toprow) or (row>=toprow+visiblerowcount)
then WordGrid.toprow:=WordGrid.row;
End
else showmessage(Findedt.text +' not found')
else showmessage(FindEdt.text +'is not a valid word');
end;


{******************** FormActivate ****************}
procedure TDicMaintForm.FormActivate(Sender: TObject);
var
btn:TSpeedButton;
  c:char;
begin
Dic:=TDic.Create(prechecked);
  Apppath:=ExtractFilePath(Application.ExeName);
for c:='b' to 'z' do
with btn do
begin
btn:=TSpeedButton.create(self);
    parent:=abtn.parent;
    font:=abtn.font;
    left:=abtn.left+(ord(c)-ord('a'))*abtn.width;
    top:=abtn.top;
    width:=abtn.width;
    height:=abtn.height;
    groupindex:=abtn.groupindex;
    caption:=c;
    onclick:=abtnclick;
end;
  load1click(sender);
  initialized:=true;
end;

{****************   FindEdtKeyPress *****************}
procedure TDicMaintForm.FindEdtKeyPress(Sender: TObject; var Key: Char);
{treat Enter as a click }
begin
if key=#13 then
Begin
FindBtnclick(sender);
   key:=#00;
End;
end;

function getword(var w:string):string;
var
i:integer;
Begin
i:=1;
      result:='';
If length(w)=0 then exit;
if w[length(w)]<>',' then w:=w+',';
while (i<=length(w)) and  (w[i]in startset) do inc(i);
If w[i]=' ' then getword:=''
else
Begin
If i>1 then w:=copy(w,i,length(w)-i+1);
        i:=1;
while (i<=length(w)) and  (not (w[i] in endset)) do inc(i);
        getword:=copy(w,1,i-1);
        system.delete(w,1,i);
End;
End;

{********************* ScanBrnClick ******************}
procedure TDicMaintForm.ScanBtnClick(Sender: TObject);
{Scan a text file for new words}

function processline(line:string):boolean;
{process a line during scanline}
{return true if user says quit}
var
quit:boolean;
      dicword:string;
      r:word;
      a,fo:boolean;
begin
quit:=false;
repeat
dicword:=getword(line);
if (dicword[1] in ['a'..'z']) then
if (dic.IsValidword(dicword)) and (length(dicword)>0)
and (not dic.lookup(dicword,a,fo)) then
Begin
r:= messagedlg('Add '+dicword,
                          mtconfirmation, mbyesnocancel,0);
if r = mryes then
Begin
if editworddlg.showmodal=MROK then
Begin
with editworddlg do dic.addword(dicword,checkbox1.checked,checkbox2.checked);
                start:=dicword[1]; stop:=dicword[1];
If min>length(dicword) then min:=length(dicword);
If max<length(dicword) then max:=length(dicword);
                rebuildlist(dicword);
                dic.setrange('a',1,'z',dic.maxwordlength);
End;
End
else if r=mrcancel then quit := true;
end;
until (length(line)=0) or (quit);
        result:=quit;
End;


var
f:textfile;
  quit:boolean;
  savemin,savemax:integer;
  savestart,savestop:char;
  saveword:string;
  line:string;
begin
with Dicform.opendialog1 do
begin
if execute and fileexists(filename) then
Begin
assignfile(f,filename);
      reset(f);
      quit:=false;
      savemin:=min;
      savemax:=max;
      savestart:=start;
      savestop:=stop;
with wordgrid do saveword:=cells[col,row];
      dic.setrange('a',1,'z',dic.maxwordlength);
      readln(f,line);
      closefile(f);
if length(line)<255 then {normal file}
begin
reset(f);
while (not eof(f)) and (not quit) do
Begin
readln(f,line);
          line:=lowercase(line);
          quit:=processline(line);
end;
        closefile(f);
end
else {long lines - use blockread}
showmessage('Lines too long -'+
                  #13+'Reformat file so lines are less than 25 characters');
{restore range settings}
start:=savestart;
      stop:=savestop;
      min:=savemin;
      max:=savemax;
      dic.setrange(start,min,stop,max);
      rebuildlist(saveword);
end;

end;
end;

{****************** WordGrid1DblClick **************}
procedure TDicMaintForm.WordGridDblClick(Sender: TObject);
var
w,rest:string;
  rowsave:integer;
  p:integer;
begin
with WordGrid do
Begin
w:=cells[col,row];
If w[length(w)]=')' then
begin
p:=pos('(',w);
if p>0 then
Begin
rest:=copy(w,p,length(w)-p);
        w:=copy(w,1,p-1);
End
else showmessage('Error in word - no ''(''');
end;
with editworddlg do
Begin
label1.caption:=w;
if showmodal=mrOK then
Begin
dic.removeword(w);
        dic.addword(w,checkbox1.checked,checkbox2.checked);
End;
End;
    rowsave:=row
end;
  rebuildlist(w);
  WordGrid.toprow:=rowsave;
end;

{************************ RemoveWord ****************}
procedure TDicMaintForm.RemoveWord(S:string);
var
a,f:boolean;
  n:integer;
  saverow,savecol:integer;
begin
with dic do
Begin
n:= pos('(',s);
if n>0 then s:=copy(s,1,n-1);
    s:=lowercase(s);
If lookup(s,a,f) then
if messagedlg('Remove '+s+'?',mtconfirmation, [mbyes,mbno],0)=mryes
then
with WordGrid do
Begin
saverow:=row;
        savecol:=col;
        dic.removeword(s);
        rebuildlist('');
        col:=savecol;
        row:=saverow;
End;
End;
end;

{********************* FormClose *******************}
procedure TDicMaintForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if dic.dicdirty then dic.checksave;
end;

{******************* WordGridKeyDown ********************}
procedure TDicMaintForm.WordGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
s:string;
begin
If key=vk_delete then
begin
with WordGrid do removeword(cells[col,row]);
end
else If key=vk_insert then
with WordGrid do
begin
s:=lowercase(inputbox('Add a word','Enter a new word and press enter',''));
if length(s)>0 then
begin
addword(s);
end;
end;
end;

{**************** Load1Click ******************}
procedure TDicMaintForm.Load1Click(Sender: TObject);
begin
with dicform.opendialog1 do
begin
if execute then
begin
cursor:=crHourGlass;
      refresh;
      Dic.loadDicfromfile(filename);
      dicname:=filename;
      start:='a'; stop:='a';
      min:=1; max:=31;
      abtn.down:=true;
      abtnclick(abtn);
      cursor:=crDefault;
end;
end;
end;

{********************** Save1Click ******************}
procedure TDicMaintForm.Save1Click(Sender: TObject);
{If extension is txtthe save umcompressed file
 otherwise save compressed format}
begin
if lowercase(extractfileExt(dicname))='.txt'
then Dic.SaveDicToTextFile(dicname)
else Dic.SaveDicToFile(dicname);
end;

{***************** CheckBoxClick ****************}
procedure TDicMaintForm.checkboxclick(Sender: TObject);
{User changed a display option radio button}
begin
with WordGrid do rebuildlist(cells[row,col]);
end;

{******************** FormCloseQuery ***************}
procedure TDicMaintForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
mr:integer;
begin
canclose:=true;
if dic.dicdirty then
begin
mr:=dic.checksave;
if mr=mrcancel then canclose:=false;
end;
end;

{**************** ReSortBtnClick *******************}
procedure TDicMaintForm.ReSortBtnClick(Sender: TObject);
var
saveword:string;
begin
with WordGrid do
begin
saveword:=cells[col,row];
    dic.resortrange;
    rebuildlist(saveword);
end;
end;

{********************* MinLenEditChnage ******************}
procedure TDicMaintForm.MinLenEditChange(Sender: TObject);
begin
if not initialized then exit;
  min:=strtointdef(minlenedit.text,1);
{if initialized then} {exit is called during creation - before we're ready}
with WordGrid do
rebuildlist(cells[col,row]);

end;

{*************************  MaxLenEditChnage ***************}
procedure TDicMaintForm.MaxLenEditChange(Sender: TObject);
begin
if not initialized then exit;
  max:=strtointdef(maxlenedit.text,dic.maxwordlength);
with WordGrid do
rebuildlist(cells[col,row]);
end;

procedure TDicMaintForm.SaveAs1Click(Sender: TObject);
begin
with savedialog1 do
begin
initialdir:=extractfilepath(dicname);
    filename:=extractfilename(dicname);
if execute then
begin
if lowercase(extractfileExt(filename))='.txt'
then Dic.SaveDicToTextFile(filename)
else Dic.SaveDicToFile(filename);
end;
end;
end;


procedure TDicMaintForm.ABtnClick(Sender: TObject);
begin
start:=  TSpeedButton(sender).caption[1];
  stop:=start;
  rebuildlist('');

end;

end.