//base.txt viewer/editor (c) 2006 S.V. Bulba
unit BV_;

interface

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

type
  TLang = (CodeWin,CodeDos,CodeTrn);
  TMyCompare = function(Index1,Index2:integer):integer;
  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;
  PBaseRecord = ^TBaseRecord;
  TBaseRecord = record
   New:boolean;
   Fixed:PBaseRecord;
   Names:array of AYFName;
   RealName:AYFRealName;
   PCName:string;
   Birthday:AYFBirthday;
   Place:AYFPlace;
   Years:AYFYears;
   Comment,LastLabel:string;
  end;
  TForm1 = class(TForm)
    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;
    Edit9: TEdit;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    DOS1: TMenuItem;
    ranslit1: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    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;
    function GetResultString(num:integer):string;
    procedure Form1KeyDown(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 ListBox2Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton14Click(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 Edit15Change(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure Edit9Change(Sender: TObject);
    procedure ShowResult;
    procedure SpeedButton1Click(Sender: TObject);
    function GetText:string;
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton18Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure DOS1Click(Sender: TObject);
    procedure ranslit1Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure SaveList(Lang:TLang);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FindString:string = '';
  FindPos:integer;
  Base:array of PBaseRecord;
  blen,currec:integer;
  BaseChanged:boolean = False;
  EngMode:boolean = True;

implementation

uses newrec;

{$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 New then s := '+';
   s := s + #9;
   if Fixed <> nil 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;
   Writeln(f,s);
  end;
CloseFile(f);
if FileExists('base.bak') then DeleteFile('base.bak');
RenameFile('base.txt','base.bak');
RenameFile('base.tmp','base.txt');
BaseChanged := False;
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
  New(Base[n]);
  with Base[n]^ do
   begin
    New := GetStr <> '';
    Fixed := nil;
    if (GetStr <> '') and (n > 0) then
     Fixed := Base[n - 1];
    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;
 s:string;
begin
blen := 0;
AssignFile(f,'base.txt');
Reset(f);
while not eof(f) do
 begin
  if blen and 1023 = 0 then SetLength(Base,blen + 1024);
  Readln(f,s);
  InterpLine(s,blen);
  inc(blen);
 end;
CloseFile(f);
SetLength(Base,blen);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 i:integer;
begin
LoadBases;
StringGrid1.RowCount := blen + 1;
StringGrid1.Cells[0,0] := 'Num';StringGrid1.Cells[1,0] := 'Result string';
for i := 1 to blen do
 begin
  StringGrid1.Cells[0,i] := IntToStr(i);
  StringGrid1.Cells[1,i] := GetResultString(i - 1);
 end;
ShowRecord(0);
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 - (SpeedButton14.Top + SpeedButton14.Height + 8);
StringGrid1.ColWidths[1] := StringGrid1.ClientWidth - StringGrid1.ColWidths[0] -
 StringGrid1.GridLineWidth*3;
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 := GetText;
if CheckEmpty(s) then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  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
if not Edit3.Modified then exit;
sel := GetLBSel(ListBox1);
if sel <= 0 then exit;
s1 := Edit3.Text;
s := Trim(s1);
with Base[currec].Names[sel] do
 begin
  if Intro <> s then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    Intro := s;
   end;
  if PrefSpace <> ((s <> '') and (s1[Length(s1)] = ' ')) then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    PrefSpace := not PrefSpace;
   end;
  ShowResult;
 end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel <= 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 with Base[currec].Names[sel] do
  if Intro = '' then
   Beep
  else
   begin
    BaseChanged := True;
    Base[currec].New := True;
    PrefSpace := not PrefSpace;
    ShowResult;
   end;
end;

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

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel <= 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 with Base[currec].Names[sel] do
  if Outro = '' then
   Beep
  else
   begin
    BaseChanged := True;
    Base[currec].New := True;
    SufSpace := not SufSpace;
    ShowResult;
   end;
end;

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

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
 sel:integer;
begin
sel := GetLBSel(ListBox1);
if sel < 0 then
 begin
  Beep;
  exit
 end;
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 with Base[currec].Names[sel] do
  begin
   BaseChanged := True;
   Base[currec].New := True;
   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 := GetText;
if CheckEmpty(s) then
 with Base[currec].Names[sel] do
  begin
   BaseChanged := True;
   Base[currec].New := True;
   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;
if Base[currec].Names[sel].Groups[sel2].Comment <> Edit6.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].Names[sel].Groups[sel2].Comment := Edit6.Text;
 end;
ShowResult;
end;


procedure TForm1.SpeedButton6Click(Sender: TObject);
var
 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
 with Base[currec].Names[sel].Groups[sel2] do
  begin
   BaseChanged := True;
   Base[currec].New := True;
   Question := not Question;
   ShowResult;
  end;
end;

procedure TForm1.Edit7Change(Sender: TObject);
begin
if Base[currec].RealName.FLastName <> Edit7.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].RealName.FLastName := Edit7.Text;
 end;
ShowResult;
end;

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

procedure TForm1.Edit8Change(Sender: TObject);
begin
if Base[currec].RealName.F1stName <> Edit8.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].RealName.F1stName := Edit8.Text;
 end;
ShowResult;
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
var
 s:string;
 i:integer;
begin
s := GetText;
if CheckEmpty(s) then
 with Base[currec].RealName do
  begin
   BaseChanged := True;
   Base[currec].New := True;
   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
if Base[currec].Birthday.Body <> Edit10.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].Birthday.Body := Edit10.Text;
 end;
ShowResult;
end;

procedure TForm1.SpeedButton11Click(Sender: TObject);
begin
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 with Base[currec].Birthday do
  if Body <> '' then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    Question := not Question;
    ShowResult;
   end
  else
   Beep
end;

procedure TForm1.Edit11Change(Sender: TObject);
begin
if Base[currec].Place.Body <> Edit11.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].Place.Body := Edit11.Text;
 end;
ShowResult;
end;

procedure TForm1.SpeedButton12Click(Sender: TObject);
begin
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 with Base[currec].Place do
  if Body <> '' then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    Question := not Question;
    ShowResult;
   end
  else
   Beep
end;

procedure TForm1.Edit12Change(Sender: TObject);
begin
if Base[currec].Place.Comment <> Edit12.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].Place.Comment := Edit12.Text;
 end;
ShowResult
end;

procedure TForm1.Edit13Change(Sender: TObject);
begin
if Base[currec].Years.Body <> Edit13.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].Years.Body := Edit13.Text;
 end;
ShowResult
end;

procedure TForm1.SpeedButton14Click(Sender: TObject);
begin
if GetKeyState(VK_CONTROL) and 128 <> 0 then
 with Base[currec].Years do
  if Body <> '' then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    Question := not Question;
    ShowResult;
   end
  else
   Beep
end;

procedure TForm1.Edit14Change(Sender: TObject);
begin
if Base[currec].Comment <> Edit14.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].Comment := Edit14.Text;
 end;
ShowResult;
end;

procedure TForm1.Edit15Change(Sender: TObject);
begin
if Base[currec].LastLabel <> Edit15.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].LastLabel := Edit15.Text;
 end;
ShowResult;
end;

procedure TForm1.Edit9Change(Sender: TObject);
begin
if Base[currec].PCName <> Edit9.Text then
 begin
  BaseChanged := True;
  Base[currec].New := True;
  Base[currec].PCName := Edit9.Text;
 end;
ShowResult;
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.Form1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if ssAlt in Shift then exit;
case Key of
VK_F1:SpeedButton1.Click;
VK_F2:SpeedButton2.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:
 ShowRecord(currec + 1);
VK_ADD:
 begin
  if Base[currec].Fixed <> nil then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    Base[currec].Fixed := nil;
   end
  else if currec > 0 then
   begin
    BaseChanged := True;
    Base[currec].New := True;
    Base[currec].Fixed := Base[currec - 1];
   end; 
  ShowResult;
 end;
else exit;
end;
Key := 0;
end;

function GetFIO(num:integer):string;
var
 i,j,l2:integer;
 s:string;
 spc,rus:boolean;
begin
  with Base[num].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;
end;

function GetNameN(num,nn:integer):string;
begin
 with Base[num].Names[nn] do
    begin
     Result := Body;
     if PrefSpace then Result := ' ' + Result;
     if SufSpace then Result := Result + ' ';
     Result := Intro + Result + Outro;
    end;
end;

function TForm1.GetResultString(num:integer):string;
var
 i,l:integer;
 scob1,fio,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;
 begin
 Result := '';
 if nn = 0 then Result := GetFIO(num);
 with Base[num].Names[nn] do
  begin
   if nn <> 0 then Result := GetNameN(num,nn);
   if Question then Result := Result + '?';
   if Comment <> '' then
    Result := Result + '(' + Comment + ')';
   Result := Result + GetGroups(Base[num].Names[nn].Groups);
  end;
 end;

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

procedure TForm1.ShowRecord(n:integer);
var
 i:integer;
 sel:TGridRect;
begin
if n >= blen then
 begin
  Beep;
  exit;
 end;
currec := n;
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;
  BaseChanged := True;
  Base[currec].New := True;
  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;
  BaseChanged := True;
  Base[currec].New := True;
  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;
  BaseChanged := True;
  Base[currec].New := True;
  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);
var
 i:integer;
begin
CanClose := True;
if BaseChanged then
 begin
  i := MessageDlg('База была изменена. Сохранить?',mtConfirmation,[mbYes,mbNo,mbCancel],0);
  CanClose := i <> mrCancel;
  if i = mrYes then SaveBase;
 end; 
if CanClose then
 for i := 0 to blen - 1 do
  Dispose(Base[i]);
end;

procedure TForm1.ShowResult;
var
 s:string;
begin
s := GetResultString(currec);
StringGrid1.Cells[1,currec + 1] := s;
Edit2.Text := s;
end;

function TForm1.GetText:string;
var
 s:string;
begin
s := ''; Result := '';
if InputQuery('Ввод строки','Строка:',s) then Result := s;
end;

procedure TForm1.SpeedButton18Click(Sender: TObject);
begin
SaveList(CodeWin);
end;

procedure TForm1.N3Click(Sender: TObject);
var
 s:string;
begin
s := FindString;
if InputQuery('Ввод строки','Строка:',s) then
 begin
  FindString := AnsiUpperCase(s);
  FindPos := 0;
  N4Click(Sender);
 end
else
 FindString := '';
end;

procedure TForm1.N4Click(Sender: TObject);
begin
if FindString = '' then exit;
while (FindPos < blen) and (Pos(FindString,AnsiUpperCase(StringGrid1.Cells[1,FindPos + 1])) = 0) do inc(FindPos);
if FindPos < blen then
 begin
  ShowRecord(FindPos);
  inc(FindPos);
 end
else
 ShowMessage('Не найдено');
end;

procedure TForm1.N5Click(Sender: TObject);
begin
SaveBase;
end;

procedure MyQuickSort(Compare:TMyCompare);

 procedure QuickSort(L,R:Integer);
 var
   I, J, P: Integer;
   N:pointer;
 begin
   repeat
     I := L;
     J := R;
     P := (L + R) shr 1;
     repeat
       while Compare(I, P) < 0 do Inc(I);
       while Compare(J, P) > 0 do Dec(J);
       if I <= J then
       begin
         N := Base[J];
         Base[J] := Base[I];
         Base[I] := N;
         if P = I then
           P := J
         else if P = J then
           P := I;
         Inc(I);
         Dec(J);
       end;
     until I > J;
     if L < J then QuickSort(L, J);
     L := I;
   until I >= R;
 end;

procedure MoveFixed;
var
 i,lpos:integer;
 Base2:array of PBaseRecord;
 p,pf:PBaseRecord;
begin
SetLength(Base2,blen);
lpos := 0;
repeat
 while (lpos < blen) and (Base[lpos].Fixed = nil) do inc(lpos);
 if lpos < blen then
  begin
   p := Base[lpos];
   pf := p.Fixed;
   i := 0; while (i < blen) and (Base[i] <> pf) do inc(i);
   if (i >= blen) or (i = lpos) then
    begin
     Beep;
     inc(lpos);
    end
   else if lpos < i then
    begin
     Move(Base[lpos + 1],Base2[0],(i - lpos) * sizeof(pointer));
     Move(Base2[0],Base[lpos],(i - lpos) * sizeof(pointer));
     Base[i] := p;
    end
   else if lpos > i + 1 then
    begin
     Move(Base[i + 1],Base2[0],(lpos - i - 1) * sizeof(pointer));
     Move(Base2[0],Base[i + 2],(lpos - i - 1) * sizeof(pointer));
     Base[i + 1] := p;
     inc(lpos);
    end
   else
    inc(lpos);
  end;
until lpos >= blen;
end;

var
 temp,i:integer;
 cr:pointer;
begin
temp := blen - 1;
if temp > 0 then
 begin
  cr := Base[currec];
  QuickSort(0,temp);
  MoveFixed;
  for i := 0 to temp do
   begin
    Form1.StringGrid1.Cells[1,i + 1] := Form1.GetResultString(i);
    if Base[i] = cr then Form1.ShowRecord(i);
   end;
 end;
end;

function TranslateToRus(s:string):string;
var
 i:integer;
 ss:string;
begin
Result := '';
for i := 1 to Length(s) do
 begin
  case s[i] of
  'A':ss := 'А';
  'B':ss := 'Б';
  'C':ss := 'Ц';
  'D':ss := 'Д';
  'E':ss := 'Е';
  'F':ss := 'Ф';
  'G':ss := 'Г';
  'H':ss := 'Х';
  'I':ss := 'И';
  'J':ss := 'Дж';
  'K':ss := 'К';
  'L':ss := 'Л';
  'M':ss := 'М';
  'N':ss := 'Н';
  'O':ss := 'О';
  'P':ss := 'П';
  'Q':ss := 'Ку';
  'R':ss := 'Р';
  'S':ss := 'С';
  'T':ss := 'Т';
  'U':ss := 'У';
  'V':ss := 'В';
  'W':ss := 'У';
  'X':ss := 'Кс';
  'Y':ss := 'Й';
  'Z':ss := 'З';
  'a':ss := 'а';
  'b':ss := 'б';
  'c':ss := 'ц';
  'd':ss := 'д';
  'e':ss := 'е';
  'f':ss := 'ф';
  'g':ss := 'г';
  'h':ss := 'х';
  'i':ss := 'и';
  'j':ss := 'дж';
  'k':ss := 'к';
  'l':ss := 'л';
  'm':ss := 'м';
  'n':ss := 'н';
  'o':ss := 'о';
  'p':ss := 'р';
  'q':ss := 'ку';
  'r':ss := 'р';
  's':ss := 'с';
  't':ss := 'т';
  'u':ss := 'у';
  'v':ss := 'в';
  'w':ss := 'у';
  'x':ss := 'кс';
  'y':ss := 'й';
  'z':ss := 'з';
  else ss := s[i];
  end;
  Result := Result + ss;
 end;
end;

function TranslateToEng(s:string):string;
var
 i:integer;
 ss:string;
begin
Result := '';
for i := 1 to Length(s) do
 begin
  case s[i] of
  'А':ss := 'A';
  'Б':ss := 'B';
  'В':ss := 'V';
  'Г':ss := 'G';
  'Д':ss := 'D';
  'Е','Ё':ss := 'E';
  'Ж':ss := 'Zh';
  'З':ss := 'Z';
  'И':ss := 'I';
  'Й':ss := 'Y';
  'К':ss := 'K';
  'Л':ss := 'L';
  'М':ss := 'M';
  'Н':ss := 'N';
  'О':ss := 'O';
  'П':ss := 'P';
  'Р':ss := 'R';
  'С':ss := 'S';
  'Т':ss := 'T';
  'У':ss := 'U';
  'Ф':ss := 'F';
  'Х':ss := 'Kh';
  'Ц':ss := 'Ts';
  'Ч':ss := 'Ch';
  'Ш':ss := 'Sh';
  'Щ':ss := 'Sch';
  'Ъ':ss := '';
  'Ы':ss := 'Y';
  'Ь':ss := '';
  'Э':ss := 'E';
  'Ю':ss := 'U';
  'Я':ss := 'Ya';
  'а':ss := 'a';
  'б':ss := 'b';
  'в':ss := 'v';
  'г':ss := 'g';
  'д':ss := 'd';
  'е','ё':ss := 'e';
  'ж':ss := 'zh';
  'з':ss := 'z';
  'и':ss := 'i';
  'й':ss := 'y';
  'к':ss := 'k';
  'л':ss := 'l';
  'м':ss := 'm';
  'н':ss := 'n';
  'о':ss := 'o';
  'п':ss := 'p';
  'р':ss := 'r';
  'с':ss := 's';
  'т':ss := 't';
  'у':ss := 'u';
  'ф':ss := 'f';
  'х':ss := 'kh';
  'ц':ss := 'ts';
  'ч':ss := 'ch';
  'ш':ss := 'sh';
  'щ':ss := 'sch';
  'ъ':ss := '';
  'ы':ss := 'y';
  'ь':ss := '';
  'э':ss := 'e';
  'ю':ss := 'u';
  'я':ss := 'ya';
  else ss := s[i];
  end;
  Result := Result + ss;
 end;
end;

function PrepareToSort(s:string):string;
var
 i:integer;
begin
Result := '';
for i := 1 to Length(s) do
 if not (s[i] in ['/','\','!','?',',','.',' ','(','[','{','}',']',')','-']) then
  begin
   if s[i] = 'ё' then s[i] := 'е';
   Result := Result + s[i];
  end;
end;

function PrepareToSort2(s:string):string;
begin
Result := TranslateToEng(PrepareToSort(s));
end;

function CompareOnlyFIO(Index1, Index2: Integer): Integer;
var
 s1,s2:string;
begin
s1 := TranslateToRus(GetFIO(Index1));
if (s1 = '') and (Length(Base[Index1].Names) > 1) then
 s1 := TranslateToRus(PrepareToSort(Base[Index1].Names[1].Body));
s2 := TranslateToRus(GetFIO(Index2));
if (s2 = '') and (Length(Base[Index2].Names) > 1) then
 s2 := TranslateToRus(PrepareToSort(Base[Index2].Names[1].Body));
Result := AnsiCompareText(s1,s2);
end;

function CompareNames(Index1, Index2: Integer): Integer;
var
 s1,s2:string;
 i:integer;
begin
if Length(Base[Index1].Names) > 1 then
 s1 := PrepareToSort2(Base[Index1].Names[1].Body) //GetNameN(Index1,1)
else
 s1 := PrepareToSort2(GetFIO(Index1));
if Length(Base[Index2].Names) > 1 then
 s2 := PrepareToSort2(Base[Index2].Names[1].Body)
else
 s2 := PrepareToSort2(GetFIO(Index2));
Result := AnsiCompareText(s1,s2);
if Result = 0 then
 begin
  s1 := '';
  i := 0;
  if Length(Base[Index1].Names) > 1 then i := 1;
  if Length(Base[Index1].Names[i].Groups) > 0 then
   s1 := PrepareToSort2(Base[Index1].Names[i].Groups[0].Body);
  s2 := '';
  i := 0;
  if Length(Base[Index2].Names) > 1 then i := 1;
  if Length(Base[Index2].Names[i].Groups) > 0 then
   s2 := PrepareToSort2(Base[Index2].Names[i].Groups[0].Body);
  Result := AnsiCompareText(s1,s2);
  if Result = 0 then Result := CompareOnlyFIO(Index1,Index2);
 end;
end;

function CompareFIOs(Index1, Index2: Integer): Integer;
begin
Result := CompareOnlyFIO(Index1,Index2);
if Result = 0 then Result := CompareNames(Index1,Index2);
end;

procedure TForm1.N6Click(Sender: TObject);
begin
SpeedButton18Click(Sender)
end;

procedure TForm1.N7Click(Sender: TObject);
begin
EngMode := True;
MyQuickSort(CompareNames);
end;

procedure TForm1.N11Click(Sender: TObject);
begin
EngMode := False;
MyQuickSort(CompareFIOs);
end;

procedure TForm1.N9Click(Sender: TObject);
var
 s1,s2,s3:string;
 p:PBaseRecord;
 i:integer;
begin
if Form2.ShowModal = mrOk then
 begin
  s1 := Trim(Form2.Edit1.Text);
  s2 := Trim(Form2.Edit2.Text);
  s3 := Trim(Form2.Edit3.Text);
  if (s1 = '') and (s2 = '') and (s3 = '') then
   begin
    Beep;
    exit;
   end;
  BaseChanged := True;
  New(p);
  p.New := True;
  p.Fixed := nil;
  i := 1; if s1 <> '' then i := 2;
  SetLength(p.Names,i);
  for i := 0 to i - 1 do
   with p.Names[i] do
    begin
     Intro := '';
     if i = 1 then
      p.Names[i].Body := s1
     else
      p.Names[i].Body := '';
     Outro := '';
     Comment := '';
     PrefSpace := False;
     SufSpace := False;
     Question := False;
    end;
  p.RealName.FLastName := s2;
  p.RealName.F1stName := s3;
  p.PCName := '';
  p.Birthday.Body := '';
  p.Birthday.Question := False;
  p.Place.Body := '';
  p.Place.Comment := '';
  p.Place.Question := False;
  p.Years.Body := '';
  p.Years.Question := False;
  p.Comment := '';
  p.LastLabel := '';
  currec := blen;
  inc(blen);
  SetLength(Base,blen);
  Base[currec] := p;
  StringGrid1.RowCount := blen + 1;
  StringGrid1.Cells[0,blen] := IntToStr(blen);
  if s1 <> '' then
   N7Click(Sender) //сортировка по нику
  else
   N11Click(Sender); //сортировка по ФИО
 end;
end;

procedure TForm1.N10Click(Sender: TObject);
var
 Base2:array of PBaseRecord;
 i:integer;
begin
if currec < 0 then exit;
BaseChanged := True;
SetLength(Base2,blen);
if (currec < blen - 1) and (Base[currec + 1].Fixed <> nil) then
 begin
  Base[currec + 1].New := True;
  Base[currec + 1].Fixed := nil;
 end;
Dispose(Base[currec]);
if currec < blen - 1 then
 begin
  Move(Base[currec + 1],Base2[0],(blen - currec - 1) * sizeof(pointer));
  Move(Base2[0],Base[currec],(blen - currec - 1) * sizeof(pointer));
 end;
StringGrid1.RowCount := blen;
dec(blen);
SetLength(Base,blen);
if currec >= blen then currec := blen - 1;
for i := 0 to blen - 1 do
 Form1.StringGrid1.Cells[1,i + 1] := GetResultString(i);
ShowRecord(currec);
end;

procedure TForm1.DOS1Click(Sender: TObject);
begin
SaveList(CodeDos);
end;

procedure TForm1.ranslit1Click(Sender: TObject);
begin
SaveList(CodeTrn);
end;

procedure TForm1.SaveList(Lang:TLang);
var
 f,fin:TextFile;
 i:integer;
 s,lastchar:string;
 release:boolean;
begin
release := GetKeyState(VK_CONTROL) and 128 <> 0;
if not release then
 s := 'list'
else
 s := 'aycomposers';
case Lang of
CodeWin: s := s + '.txt';
CodeDos: s := s + '_dos.txt';
CodeTrn: s := s + '_lat.txt';
end;
AssignFile(f,s);
Rewrite(f);

if Release then
 begin
  AssignFile(fin,'Intro.txt');
  Reset(fin);
  while not eof(fin) do
   begin
    Readln(fin,s);
    case Lang of
    CodeDos: AnsiToOemBuff(@s[1], @s[1], Length(s));
    CodeTrn: s := TranslateToEng(s);
    end;
    Writeln(f,s);
   end;
  CloseFile(fin);
 end; 

lastchar := '';
for i := 0 to blen - 1 do
 begin
  if Base[i].Fixed = nil then
   begin
    if EngMode then
     begin
      if Length(Base[i].Names) > 1 then
       s := PrepareToSort2(Base[i].Names[1].Body)
      else
       s := PrepareToSort2(GetFIO(i));
     end
    else
     begin
      s := TranslateToRus(GetFIO(i));
      if (s = '') and (Length(Base[i].Names) > 1) then
       s := TranslateToRus(PrepareToSort(Base[i].Names[1].Body));
     end;
    if s <> '' then
     begin
      SetLength(s,1);
      if s[1] in ['0'..'9'] then s := '0';
      s := AnsiUpperCase(s);
      if lastchar <> s[1] then
       begin
        lastchar := s[1];
        writeln(f);
       end;
     end;
   end;  
  s := GetResultString(i);
  case Lang of
  CodeDos: AnsiToOemBuff(@s[1], @s[1], Length(s));
  CodeTrn: s := TranslateToEng(s);
  end;
  Writeln(f,s);
 end;

if Release then
 begin
  AssignFile(fin,'Outro.txt');
  Reset(fin);
  while not eof(fin) do
   begin
    Readln(fin,s);
    case Lang of
    CodeDos: AnsiToOemBuff(@s[1], @s[1], Length(s));
    CodeTrn: s := TranslateToEng(s);
    end;
    Writeln(f,s);
   end;
  CloseFile(fin);
 end;

CloseFile(f);
end;

procedure TForm1.N12Click(Sender: TObject);
var
 i,newcnt,bpcnt,wntcnt:integer;

begin
newcnt := 0; bpcnt := 0; wntcnt := 0;
for i := 0 to blen - 1 do
 begin
  if Base[i].New then inc(newcnt);
  if Pos('[b]',Base[i].LastLabel) <> 0 then inc(bpcnt);
  if Pos('[wanted]',Base[i].LastLabel) <> 0 then inc(wntcnt);
 end;
ShowMessage('Всего новых или обновленных записей: ' + IntToStr(newcnt) +
            '. Всего композиторов, помеченных [b]: ' + IntToStr(bpcnt) +
            '. Всего композиторов, помеченных [wanted]: ' + IntToStr(wntcnt) + '.');
end;

procedure TForm1.N13Click(Sender: TObject);
var
 i:integer;
begin
if MessageDlg('Уверены, что хотите снять все пометки "*"?',mtConfirmation,[mbYes,mbNo],0) = mrYes then
 for i := 0 to blen - 1 do
  if Base[i].New then
   begin
    BaseChanged := True;
    Base[i].New := False;
    StringGrid1.Cells[1,i + 1] := GetResultString(i);
   end;
end;

end.
