//aycomposers_v3.6.txt -> base.txt (c) 2006 S.V. Bulba
unit Ch2b_;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Buttons;

type
  AYFYears = record
   Body:string;
   Question:boolean;
  end;
  AYFPlace = record
   Body,Comment:string;
   Question:boolean;
  end;
  AYFBirthday = record
   Body:string;
   Question:boolean;
  end;
  AYFGroup = record
   Body,Comment:string;
   Question:boolean;
  end;
  AYFGroups = array of AYFGroup;
  AYFName = record
   Intro,Body,Outro,Comment:string;
   PrefSpace,SufSpace,Question:boolean;
   Groups:AYFGroups;
  end;
  AYFRealName = record
   F1stName,FLastName:string;
   F2ndNames:array of string;
  end;
  TForm1 = class(TForm)
    Edit1: TEdit;
    StringGrid1: TStringGrid;
    ListBox1: TListBox;
    SpeedButton1: TSpeedButton;
    Edit2: TEdit;
    SpeedButton2: TSpeedButton;
    Edit3: TEdit;
    SpeedButton3: TSpeedButton;
    Edit4: TEdit;
    Edit5: TEdit;
    SpeedButton4: TSpeedButton;
    ListBox2: TListBox;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    Edit6: TEdit;
    Edit7: TEdit;
    SpeedButton7: TSpeedButton;
    Edit8: TEdit;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    ListBox3: TListBox;
    Edit10: TEdit;
    SpeedButton11: TSpeedButton;
    Edit11: TEdit;
    SpeedButton12: TSpeedButton;
    Edit12: TEdit;
    SpeedButton13: TSpeedButton;
    Edit13: TEdit;
    SpeedButton14: TSpeedButton;
    Edit14: TEdit;
    SpeedButton15: TSpeedButton;
    Label1: TLabel;
    Edit15: TEdit;
    SpeedButton16: TSpeedButton;
    SpeedButton10: TSpeedButton;
    Label2: TLabel;
    Label3: TLabel;
    Edit9: TEdit;
    SpeedButton17: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SaveBase;
    procedure LoadBases;
    procedure ShowRecord(n:integer);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure FormResize(Sender: TObject);
    function CheckEmpty(var s:string):boolean;
    function LineEmpty:boolean;
    procedure ShowResult;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    function GetLBSel(LB:TListBox):integer;
    procedure ListBox1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure SpeedButton15Click(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit5Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit6Change(Sender: TObject);
    procedure Edit7Change(Sender: TObject);
    procedure Edit8Change(Sender: TObject);
    procedure Edit10Change(Sender: TObject);
    procedure Edit11Change(Sender: TObject);
    procedure Edit12Change(Sender: TObject);
    procedure Edit13Change(Sender: TObject);
    procedure Edit14Change(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedButton16Click(Sender: TObject);
    procedure Edit15Change(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    function GetSelText:string;
    procedure SpeedButton17Click(Sender: TObject);
    procedure Edit9Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Base:array of record
     OldRecord:string;
     New,Fixed:boolean;
     Names:array of AYFName;
     RealName:AYFRealName;
     PCName:string;
     Birthday:AYFBirthday;
     Place:AYFPlace;
     Years:AYFYears;
     Comment,LastLabel:string;
    end;
    blen,currec:integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SaveBase;
var
 f:TextFile;
 i,j,k,l:integer;
 s:string;
begin
AssignFile(f,'base.tmp');
Rewrite(f);
for i := 0 to blen - 1 do
 with Base[i] do
  begin
   s := '';
   if OldRecord <> '' then
    begin
     s := '';
     if New then s := '+';
     s := s + #9;
     if Fixed then s := s + '+';
     s := s + #9;
     l := Length(Names);
     s := s + IntToStr(l) + #9;
     for j := 0 to l - 1 do
      with Names[j] do
       begin
        s := s + Intro + #9;
        if PrefSpace then s := s + ' ';
        s := s + #9 + Body + #9;
        if SufSpace then s := s + ' ';
        s := s + #9 + Outro + #9;
        if Question then s := s + '?';
        s := s + #9 + Comment + #9;
        l := Length(Groups);
        s := s + IntToStr(l) + #9;
        for k := 0 to l - 1 do
         with Groups[k] do
          begin
           s := s + Body + #9;
           if Question then s := s + '?';
           s := s + #9 + Comment + #9;
          end;
       end;
     with RealName do
      begin
       s := s + FLastName + #9 + F1stName + #9;
       l := Length(F2ndNames);
       s := s + IntToStr(l) + #9;
       for j := 0 to l - 1 do s := s + F2ndNames[j] + #9;
      end;
     s := s + PCName + #9;
     with Birthday do
      begin
       s := s + Body + #9;
       if Question then s := s + '?';
       s := s + #9;
      end;
     with Place do
      begin
       s := s + Body + #9;
       if Question then s := s + '?';
       s := s + #9 + Comment + #9;
      end;
     s := s + Comment + #9;
     with Years do
      begin
       s := s + Body + #9;
       if Question then s := s + '?';
      end;
     s := s + #9 + LastLabel;
    end;
   Writeln(f,s);
  end;
CloseFile(f);
if FileExists('base.bak') then DeleteFile('base.bak');
RenameFile('base.txt','base.bak');
RenameFile('base.tmp','base.txt');
end;

procedure TForm1.LoadBases;

 procedure InterpLine(s:string;n:integer);

  function GetStr:string;
  var
   i,l:integer;
  begin
  i := Pos(#9,s);
  if i = 0 then
   begin
    Result := s;
    s := '';
   end
  else
   begin
    if i > 1 then
     Result := Copy(s,1,i - 1)
    else
     Result := '';
    l := Length(s);
    if i < l then
     s := Copy(s,i + 1,l - i)
    else
     s := '';
   end;
  end;

 var
  l,i,j:integer;
 begin
  with Base[n] do
   begin
    New := GetStr <> '';
    Fixed := GetStr <> '';
    l := StrToInt(GetStr);
    SetLength(Names,l);
    for i := 0 to l - 1 do
     with Names[i] do
      begin
       Intro := GetStr;
       PrefSpace := GetStr <> '';
       Body := GetStr;
       SufSpace := GetStr <> '';
       Outro := GetStr;
       Question := GetStr <> '';
       Comment := GetStr;
       l := StrToInt(GetStr);
       SetLength(Groups,l);
       for j := 0 to l - 1 do
       with Groups[j] do
        begin
         Body := GetStr;
         Question := GetStr <> '';
         Comment := GetStr;
        end;
      end;
    with RealName do
     begin
      FLastName := GetStr;
      F1stName := GetStr;
      l :=  StrToInt(GetStr);
      SetLength(F2ndNames,l);
      for i := 0 to l - 1 do
       F2ndNames[i] := GetStr;
     end;
    PCName := GetStr;
    with Birthday do
     begin
      Body := GetStr;
      Question := GetStr <> '';
     end;
    with Place do
     begin
      Body := GetStr;
      Question := GetStr <> '';
      Comment := GetStr;
     end;
    Comment := GetStr;
    with Years do
     begin
      Body := GetStr;
      Question := GetStr <> '';
     end;
    LastLabel := GetStr;
   end;
 end;

var
 f:TextFile;
 i:integer;
 s:string;
begin
blen := 0;
AssignFile(f,'aycomposers_v3.6.txt');
Reset(f);
while not eof(f) do
 begin
  if blen and 1023 = 0 then SetLength(Base,blen + 1024);
  readln(f,Base[blen].OldRecord);
  Base[blen].Fixed := False;
  Base[blen].New := False;
  SetLength(Base[blen].Names,1);
  with Base[blen].Names[0] do
   begin
    Intro := ''; Body := ''; Outro := '';
    PrefSpace := False; SufSpace := False; Question := False;
   end;
  with Base[blen].RealName do
   begin
    F1stName := ''; FLastName := '';
   end;
  Base[blen].PCName := '';
  with Base[blen].Birthday do
   begin
    Body := '';
    Question := False;
   end;
  with Base[blen].Place do
   begin
    Body := ''; Comment := '';
    Question := False;
   end;
  with Base[blen].Years do
   begin
    Body := '';
    Question := False;
   end;
  Base[blen].Comment := '';
  Base[blen].LastLabel := '';
  inc(blen);
 end;
CloseFile(f);
SetLength(Base,blen);
AssignFile(f,'base.txt');
Reset(f);
for i := 0 to blen - 1 do
 begin
  if eof(f) then break;
  Readln(f,s);
  if s <> '' then InterpLine(s,i);
 end;
CloseFile(f);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 i:integer;
begin
LoadBases;
StringGrid1.RowCount := blen + 1;
StringGrid1.Cells[0,0] := 'Num';StringGrid1.Cells[1,0] := 'Original line';
for i := 1 to blen do
 begin
  StringGrid1.Cells[0,i] := IntToStr(i);
  StringGrid1.Cells[1,i] := Base[i - 1].OldRecord
 end;
currec := 0;
repeat
 if (Base[currec].OldRecord <> '') and LineEmpty then break;
 inc(currec)
until currec >= blen - 1;
ShowRecord(currec);
Form1.WindowState := wsMaximized; 
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
ShowRecord(ARow - 1)
end;

procedure TForm1.FormResize(Sender: TObject);
begin
StringGrid1.Height := ClientHeight - (Edit1.Top + Edit1.Height + 8);
StringGrid1.ColWidths[1] := StringGrid1.ClientWidth - StringGrid1.ColWidths[0] -
 StringGrid1.GridLineWidth*3;
Edit1.Width := ClientWidth;
Edit2.Width := ClientWidth;
end;

function TForm1.CheckEmpty(var s:string):boolean;
begin
s := Trim(s);
Result := s <> '';
if not Result then
 Beep
end;

function TForm1.LineEmpty:boolean;
begin
Result := (Length(Base[currec].Names) > 1) or
          (Base[currec].RealName.F1stName <> '') or
          (Base[currec].RealName.FLastName <> '') or
          (Length(Base[currec].RealName.F2ndNames) <> 0);
Result := not Result;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
 s:string;
 i:integer;
begin
s := GetSelText;
if CheckEmpty(s) then
 begin
  i := Length(Base[currec].Names);
  SetLength(Base[currec].Names,i + 1);
  with Base[currec].Names[i] do
   begin
    Body := s;
    Outro := ''; Intro := ''; Comment := '';
    SufSpace := False; PrefSpace := False; Question := False;
   end;
  i := ListBox1.Items.Add(s);
  ListBox1.Selected[i] := True;
  ListBox1.OnClick(nil);
  ShowResult;
 end;
end;

function TForm1.GetLBSel(LB:TListBox):integer;
var
 i:integer;
begin
Result := -1;
for i := 0 to LB.Count - 1 do
 if LB.Selected[i] then
  begin
   Result := i;
   break
  end;
end;

procedure TForm1.Edit3Change(Sender: TObject);
var
 s,s1:string;
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel <= 0 then exit;
s1 := Edit3.Text;
s := Trim(s1);
with Base[currec].Names[sel] do
 begin
  Intro := s;
  PrefSpace := (s <> '') and (s1[Length(s1)] = ' ');
  ShowResult;
 end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
 s,s1:string;
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel <= 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  s1 := s;
  if CheckEmpty(s) then
   with Base[currec].Names[sel] do
    begin
     PrefSpace := s1[Length(s1)] = ' ';
     if PrefSpace then s := s + ' ';
     Intro := s;
     Edit3.Text := s;
     ShowResult;
    end;
 end
else with Base[currec].Names[sel] do
 if Intro = '' then
  Beep
 else
  begin
   PrefSpace := not PrefSpace;
   ShowResult;
  end;
end;

procedure TForm1.Edit4Change(Sender: TObject);
var
 s,s1:string;
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel <= 0 then exit;
s1 := Edit4.Text;
s := Trim(s1);
with Base[currec].Names[sel] do
 begin
  Outro := s;
  SufSpace := (s <> '') and (s1[1] = ' ');
  ShowResult;
 end;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
 s,s1:string;
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel <= 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  s1 := s;
  if CheckEmpty(s) then
   with Base[currec].Names[sel] do
    begin
     SufSpace := s1[1] = ' ';
     if SufSpace then s := ' ' + s;
     Outro := s;
     Edit4.Text := s;
     ShowResult;
    end;
 end
else with Base[currec].Names[sel] do
 if Outro = '' then
  Beep
 else
  begin
   SufSpace := not SufSpace;
   ShowResult;
  end;
end;

procedure TForm1.Edit5Change(Sender: TObject);
var
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel < 0 then exit;
Base[currec].Names[sel].Comment := Edit5.Text;
ShowResult;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
 s:string;
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel < 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  if CheckEmpty(s) then
   with Base[currec].Names[sel] do
    begin
     Comment := s;
     Edit5.Text := s;
     ShowResult;
    end;
 end
else with Base[currec].Names[sel] do
  begin
   Question := not Question;
   ShowResult;
  end;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
 s:string;
 sel,i:integer;
begin
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 begin
  ListBox1.Selected[0] := True;
  ListBox1.OnClick(nil);
 end;
sel := GetLBSel(ListBox1);
if sel < 0 then
 begin
  Beep;
  exit
 end;
s := GetSelText;
if CheckEmpty(s) then
 with Base[currec].Names[sel] do
  begin
   i := Length(Groups);
   SetLength(Groups,i + 1);
   with Groups[i] do
    begin
     Body := s;
     Comment := '';
     Question := False;
    end;
   i := ListBox2.Items.Add(s);
   ListBox2.Selected[i] := True;
   ListBox2.OnClick(nil);
   ShowResult
  end;
end;

procedure TForm1.Edit6Change(Sender: TObject);
var
 sel,sel2:integer;
begin
sel := GetLBSel(ListBox1);
if sel < 0 then exit;
sel2 := GetLBSel(ListBox2);
if sel2 < 0 then exit;
Base[currec].Names[sel].Groups[sel2].Comment := Edit6.Text;
ShowResult;
end;


procedure TForm1.SpeedButton6Click(Sender: TObject);
var
 s:string;
 sel,sel2:integer;
begin
sel := GetLBSel(ListBox1);
if sel < 0 then
 begin
  Beep;
  exit
 end;
sel2 := GetLBSel(ListBox2);
if sel2 < 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  if CheckEmpty(s) then
   with Base[currec].Names[sel].Groups[sel2] do
    begin
     Comment := s;
     Edit6.Text := s;
     ShowResult;
    end;
 end
else with Base[currec].Names[sel].Groups[sel2] do
  begin
   Question := not Question;
   ShowResult;
  end;
end;

procedure TForm1.Edit7Change(Sender: TObject);
begin
Base[currec].RealName.FLastName := Edit7.Text;
ShowResult;
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
var
 s:string;
begin
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  if CheckEmpty(s) then
   begin
    Base[currec].RealName.FLastName := s;
    Edit7.Text := s;
    ShowResult
   end;
 end
else with Base[currec].RealName do
 if (F1stName <> '') or (FLastName <> '') or (Length(F2ndNames) <> 0) then
  begin
   Base[currec].Names[0].Question := not Base[currec].Names[0].Question;
   ShowResult;
  end
 else
  Beep
end;

procedure TForm1.Edit8Change(Sender: TObject);
begin
Base[currec].RealName.F1stName := Edit8.Text;
ShowResult;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
var
 s:string;
begin
s := GetSelText;
if CheckEmpty(s) then
 begin
  Base[currec].RealName.F1stName := s;
  Edit8.Text := s;
  ShowResult
 end;
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
var
 s:string;
 i:integer;
begin
s := GetSelText;
if CheckEmpty(s) then
 with Base[currec].RealName do
  begin
   i := Length(F2ndNames);
   SetLength(F2ndNames,i + 1);
   F2ndNames[i] := s;
   ListBox3.Items.Add(s);
   ShowResult
  end;
end;

procedure TForm1.SpeedButton10Click(Sender: TObject);
begin
with Base[currec].RealName do
 if (F1stName = '') and (FLastName = '') and (Length(F2ndNames) = 0) then
  begin
   Beep;
   exit;
  end;
ListBox1.Selected[0] := True;
ListBox1.OnClick(nil);
SpeedButton4.Click
end;

procedure TForm1.Edit10Change(Sender: TObject);
begin
Base[currec].Birthday.Body := Edit10.Text;
ShowResult;
end;

procedure TForm1.SpeedButton11Click(Sender: TObject);
var
 s:string;
begin
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  if CheckEmpty(s) then
   begin
    Base[currec].Birthday.Body := s;
    Edit10.Text := s;
    ShowResult
   end;
 end
else with Base[currec].Birthday do
 if Body <> '' then
  begin
   Question := not Question;
   ShowResult;
  end
 else
  Beep
end;

procedure TForm1.Edit11Change(Sender: TObject);
begin
Base[currec].Place.Body := Edit11.Text;
ShowResult;
end;

procedure TForm1.SpeedButton12Click(Sender: TObject);
var
 s:string;
begin
if GetKeyState(VK_SHIFT) and 128 <> 0 then
 begin
  SpeedButton13Click(Sender);
  exit;
 end;
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  if CheckEmpty(s) then
   begin
    Base[currec].Place.Body := s;
    Edit11.Text := s;
    ShowResult
   end;
 end
else with Base[currec].Place do
 if Body <> '' then
  begin
   Question := not Question;
   ShowResult;
  end
 else
  Beep
end;

procedure TForm1.Edit12Change(Sender: TObject);
begin
Base[currec].Place.Comment := Edit12.Text;
ShowResult
end;

procedure TForm1.SpeedButton13Click(Sender: TObject);
var
 s:string;
begin
s := GetSelText;
if CheckEmpty(s) then
 begin
  Base[currec].Place.Comment := s;
  Edit12.Text := s;
  ShowResult
 end;
end;

procedure TForm1.Edit13Change(Sender: TObject);
begin
Base[currec].Years.Body := Edit13.Text;
ShowResult
end;

procedure TForm1.SpeedButton14Click(Sender: TObject);
var
 s:string;
begin
if GetKeyState(VK_CONTROL) and 128 = 0 then
 begin
  s := GetSelText;
  if CheckEmpty(s) then
   begin
    Base[currec].Years.Body := s;
    Edit13.Text := s;
    ShowResult
   end;
 end
else with Base[currec].Years do
 if Body <> '' then
  begin
   Question := not Question;
   ShowResult;
  end
 else
  Beep
end;

procedure TForm1.Edit14Change(Sender: TObject);
begin
Base[currec].Comment := Edit14.Text;
ShowResult;
end;

procedure TForm1.SpeedButton15Click(Sender: TObject);
var
 s:string;
begin
s := GetSelText;
if CheckEmpty(s) then
 begin
  Base[currec].Comment := s;
  Edit14.Text := s;
  ShowResult
 end;
end;

procedure TForm1.Edit15Change(Sender: TObject);
begin
Base[currec].LastLabel := Edit15.Text;
ShowResult;
end;

procedure TForm1.SpeedButton16Click(Sender: TObject);
var
 s:string;
begin
s := GetSelText;
if CheckEmpty(s) then
 begin
  Base[currec].LastLabel := s;
  Edit15.Text := s;
  ShowResult
 end;
end;

procedure TForm1.Edit9Change(Sender: TObject);
begin
Base[currec].PCName := Edit9.Text;
ShowResult;
end;

procedure TForm1.SpeedButton17Click(Sender: TObject);
var
 s:string;
begin
s := GetSelText;
if CheckEmpty(s) then
 begin
  Base[currec].PCName := s;
  Edit9.Text := s;
  ShowResult
 end;
end;


procedure TForm1.ListBox1Click(Sender: TObject);
var
 sel,i:integer;
begin
ListBox2.Clear;
sel := GetLBSel(ListBox1);
if sel < 0 then
 begin
  Edit3.Clear; Edit4.Clear; Edit5.Clear; Edit6.Clear;
  exit;
 end;
with Base[currec].Names[sel] do
 begin
  Edit3.Text := Intro;
  Edit4.Text := Outro;
  Edit5.Text := Comment;
  for i := 0 to Length(Groups) - 1 do
   ListBox2.Items.Add(Groups[i].Body);
  if ListBox2.Count <> 0 then
   begin
    ListBox2.Selected[0] := True;
    ListBox2.OnClick(nil)
   end;
 end;
end;

procedure TForm1.ListBox2Click(Sender: TObject);
var
 sel,sel2:integer;
begin
sel := GetLBSel(ListBox1);
if sel < 0 then
 begin
  Edit6.Clear;
  exit;
 end;
sel2 := GetLBSel(ListBox2);
if sel2 < 0 then
 begin
  Edit6.Clear;
  exit;
 end;
with Base[currec].Names[sel].Groups[sel2] do
 Edit6.Text := Comment;
end;

function SepChar(c:char):boolean;
begin
Result := c in [' ','/',',','(',')','.','?','[',']'];
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
 i:integer;
 s:string;
begin
if ssAlt in Shift then exit;
case Key of
VK_F1:SpeedButton1.Click;
VK_F2:SpeedButton2.Click;
VK_F3:SpeedButton3.Click;
VK_F4:SpeedButton4.Click;
VK_F5:SpeedButton5.Click;
VK_F6:SpeedButton6.Click;
VK_F7:SpeedButton7.Click;
VK_F8:SpeedButton8.Click;
VK_F9:SpeedButton9.Click;
VK_F10:SpeedButton10.Click;
VK_F11:SpeedButton11.Click;
VK_F12:SpeedButton12.Click;
Ord('Y'):SpeedButton14.Click;
Ord('R'):SpeedButton15.Click;
Ord('L'):SpeedButton16.Click;
Ord('P'):SpeedButton17.Click;
VK_RETURN:
 begin
  SaveBase;
  ShowRecord(currec + 1);
 end;
VK_ADD:
 begin
  if Base[currec].OldRecord <> '' then
   begin
    Base[currec].Fixed := not Base[currec].Fixed;
    ShowResult;
   end;
 end;
Ord('Q'):
 begin
  s := Edit1.Text;
  i := Edit1.SelStart + Edit1.SelLength + 1;
  if (i <= Length(s)) and not (s[i] in [']']) then inc(i);
  while (i <= Length(s)) and not SepChar(s[i]) do inc(i);
  if (i <= Length(s)) and not (s[i] in [' ','.',']']) then dec(i);
  Edit1.SelLength := i - Edit1.SelStart;
 end;
else exit;
end;
Key := 0;
end;

function TForm1.GetSelText:string;
var
 i:integer;
 s:string;
begin
Result := Edit1.SelText;
i := Edit1.SelLength; Edit1.SelLength := 0;
Edit1.SelStart := Edit1.SelStart + i;
s := Edit1.Text;
i := Edit1.SelStart + 1;
while (i < Length(s)) and SepChar(s[i]) do
 begin
  Edit1.SelStart := Edit1.SelStart + 1;
  inc(i);
 end;
end;

procedure TForm1.ShowResult;
var
 i,l,l2:integer;
 s1:string;
 scob1,fio,rus,birth:boolean;

 function GetGroups(G:AYFGroups):string;
 var
  i,l:integer;
 begin
 Result := '';
 l := Length(G) - 1;
 if l < 0 then exit;
 Result := '/';
 for i := 0 to l do
  with G[i] do
   begin
    Result := Result + Body;
    if Question then Result := Result + '?';
    if Comment <> '' then
     Result := Result + ' (' + Comment + ')';
    if i < l then Result := Result + ',';
   end;
 end;

 function GetName(nn:integer):string;
 var
  s:string;
  spc:boolean;
  i,j:integer;
 begin
 Result := '';
 if nn = 0 then
  with Base[currec].RealName do
   begin
    i := 1; s := FLastName; l2 := Length(s);
    while (i <= l2) and (s[i] < #128) do inc(i);
    rus := i <= l2;
    if not rus then
     begin
      i := 1; s := F1stName; l2 := Length(s);
      while (i <= l2) and (s[i] < #128) do inc(i);
      rus := i <= l2;
      if not rus then
       for j := 0 to Length(F2ndNames) - 1 do
        begin
         i := 1; s := F2ndNames[j]; l2 := Length(s);
         while (i <= l2) and (s[i] < #128) do inc(i);
         rus := i <= l2;
         if rus then break;
        end;
     end;
    if not rus then
      Result := F1stName
    else
      Result := FLastName;
    spc := Result = '';
    if rus and (F1stName <> '') then
     begin
      if not spc then Result := Result + ' ';
      Result := Result + F1stName;
      spc := False;
     end;
    for i := 0 to Length(F2ndNames) - 1 do
     begin
      if not spc then Result := Result + ' ';
      Result := Result + F2ndNames[i];
      spc := False;
     end;
    if not rus and (FLastName <> '') then
     begin
      if not spc then Result := Result + ' ';
      Result := Result + FLastName;
     end;
   end;
 with Base[currec].Names[nn] do
  begin
   if nn <> 0 then
    begin
     Result := Body;
     if PrefSpace then Result := ' ' + Result;
     if SufSpace then Result := Result + ' ';
     Result := Intro + Result + Outro;
    end; 
   if Question then Result := Result + '?';
   if Comment <> '' then
    Result := Result + ' (' + Comment + ')';
   Result := Result + GetGroups(Base[currec].Names[nn].Groups);
  end;
 end;

begin
s1 := ''; if Base[currec].Fixed then s1 := ' ';
birth := Base[currec].Birthday.Body <> '';
l := Length(Base[currec].Names);
scob1 := birth and (l <> 1);
fio := (Base[currec].RealName.F1stName <> '') or
       (Base[currec].RealName.FLastName <> '') or
       (Length(Base[currec].RealName.F2ndNames) <> 0);
if l > 1 then
 begin
  scob1 := birth or (l > 2) or fio;
  s1 := s1 + GetName(1);
 end;
if scob1 then s1 := s1 + ' (';
for i := 2 to l - 1 do
 begin
  s1 := s1 + GetName(i);
  if i < l - 1 then s1 := s1 + ', ';
 end;
if fio and (l > 2) then s1 := s1 + ', ';
if fio then s1 := s1 + GetName(0);
if Base[currec].PCName <> '' then s1 := s1 + '=' + Base[currec].PCName;  
if birth then
 with Base[currec].Birthday do
  begin
   if (l > 1) or ((l > 0) and fio) then s1 := s1 + ' ';
   s1 := s1 + Body;
   if Question then s1 := s1 + '?';
  end;
if scob1 then s1 := s1 + ')';
with Base[currec].Place do
 if Body <> '' then
  begin
   s1 := s1 + ', ' + Body;
   if Question then s1 := s1 + '?';
   if Comment <> '' then s1 := s1 + ' (' + Comment + ')';
  end;
if Base[currec].Comment <> '' then s1 := s1 + ' (' + Base[currec].Comment + ')';
with Base[currec].Years do
 if Body <> '' then
  begin
   s1 := s1 + ' ' + Body;
   if Question then s1 := s1 + '?';
  end;
if Base[currec].LastLabel <> '' then s1 := s1 + ' ' + Base[currec].LastLabel;
Edit2.Text := s1;
end;

procedure TForm1.ShowRecord(n:integer);
var
 s:string;
 i:integer;
 sel:TGridRect;
begin
if n >= blen then
 begin
  Beep;
  exit;
 end;
currec := n;
SetLength(s,Length(Base[n].OldRecord));
OemToAnsiBuff(@Base[n].OldRecord[1], @s[1], Length(s));
Edit1.Text := s;
ListBox1.Clear; Edit3.Clear; Edit4.Clear; Edit5.Clear; ListBox2.Clear;
Edit6.Clear; ListBox3.Clear;
for i := 0 to Length(Base[n].Names) - 1 do
 ListBox1.Items.Add(Base[n].Names[i].Body);
if ListBox1.Count <> 0 then
 begin
  ListBox1.Selected[0] := True;
  ListBox1.OnClick(nil)
 end;
Edit7.Text := Base[n].RealName.FLastName;
for i := 0 to Length(Base[n].RealName.F2ndNames) - 1 do
 ListBox3.Items.Add(Base[n].RealName.F2ndNames[i]);
Edit8.Text := Base[n].RealName.F1stName;
Edit10.Text := Base[n].Birthday.Body;
Edit11.Text := Base[n].Place.Body;
Edit12.Text := Base[n].Place.Comment;
Edit13.Text := Base[n].Years.Body;
Edit14.Text := Base[n].Comment;
Edit15.Text := Base[n].LastLabel;
Edit9.Text := Base[n].PCName; 
inc(n);
if StringGrid1.Selection.Top <> n then
 begin
  if n >= StringGrid1.TopRow + StringGrid1.VisibleRowCount then
   StringGrid1.TopRow := n + 1 - StringGrid1.VisibleRowCount
  else if n < StringGrid1.TopRow then StringGrid1.TopRow := n;
  sel.Left := 1;
  sel.Right := 1;
  sel.Top := n;
  sel.Bottom := n;
  StringGrid1.Selection := Sel;
 end;
ShowResult
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
 sel,l,i:integer;
begin
if Key = VK_DELETE then
 begin
  sel := GetLBSel(ListBox1);
  if sel <= 0 then exit;
  with Base[currec] do
   begin
    l := Length(Names) - 1;
    for i := sel + 1 to l do
     Names[i - 1] := Names[i];
    SetLength(Names,l);
   end;
  ShowRecord(currec)
 end;
end;

procedure TForm1.ListBox2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
 sel,sel2,l,i:integer;
begin
if Key = VK_DELETE then
 begin
  sel := GetLBSel(ListBox1);
  if sel < 0 then exit;
  sel2 := GetLBSel(ListBox2);
  if sel2 < 0 then exit;
  with Base[currec].Names[sel] do
   begin
    l := Length(Groups) - 1;
    for i := sel + 1 to l do
     Groups[i - 1] := Groups[i];
    SetLength(Groups,l);
   end;
  ShowRecord(currec)
 end;
end;

procedure TForm1.ListBox3KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
 sel,l,i:integer;
begin
if Key = VK_DELETE then
 begin
  sel := GetLBSel(ListBox3);
  if sel < 0 then exit;
  with Base[currec].RealName do
   begin
    l := Length(F2ndNames) - 1;
    for i := sel + 1 to l do
     F2ndNames[i - 1] := F2ndNames[i];
    SetLength(F2ndNames,l);
   end;
  ShowRecord(currec)
 end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
SaveBase;
end;

end.
