unit _fm_Main;


interface

uses
Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
ExtCtrls, Grids, Buttons, SysUtils, ComCtrls, Menus, ImgList, IniFiles,
FMXUtils, ToolWin, JPEG, Registry;



type
   
   Tfm_Main       = class(TForm)
                    Panel1     : TPanel;
   
   sg         : TStringGrid;
   
   Timer1     : TTimer;
   
   ilMainActive: TImageList;
   
   ilPlayers  : TImageList;
   
   ilMainHot  : TImageList;
   
   ilAddHot   : TImageList;
   
   CoolBar1   : TCoolBar;
   
   ToolBar1   : TToolBar;
   
   tbDic      : TToolButton;
   
   tbSetup    : TToolButton;
   
   ToolButton02: TToolButton;
   
   tbSaveGame: TToolButton;
   
   tbLoadGame: TToolButton;
   
   tbAbout    : TToolButton;
   
   tbHelp     : TToolButton;
   
   ToolButton04: TToolButton;
   
   sd         : TSaveDialog;
   
   ToolButton01: TToolButton;
   
   tbLang     : TToolButton;
   
   Panel3     : TPanel;
   
   stTime     : TStaticText;
   
   Panel4     : TPanel;
   
   sb1        : TSpeedButton;
   
   sb2        : TSpeedButton;
   
   sb3        : TSpeedButton;
   
   sb4        : TSpeedButton;
   
   sb5        : TSpeedButton;
   
   cb1        : TComboBox;
   
   sg1        : TStringGrid;
   
   sg2        : TStringGrid;
   
   st2        : TStaticText;
   
   cb2        : TComboBox;
   
   cb3        : TComboBox;
   
   st3        : TStaticText;
   
   sg3        : TStringGrid;
   
   sg4        : TStringGrid;
   
   st4        : TStaticText;
   
   cb4        : TComboBox;
   
   cb5        : TComboBox;
   
   st5        : TStaticText;
   
   sg5        : TStringGrid;
   
   st1        : TStaticText;
   
   pa2        : TPanel;
   
   I2         : TImage;
   
   pa1        : TPanel;
   
   I1         : TImage;
   
   laPlayers  : TLabel;
   
   laNetMsg   : TStaticText;
   
   tmGame     : TTimer;
   
   pmLang     : TPopupMenu;
   
   English    : TMenuItem;
   
   Deutsch    : TMenuItem;
   
   Russian    : TMenuItem;
   
   ilPopupMenu: TImageList;
   
   tmNetMsg   : TTimer;
   
   od         : TOpenDialog;
   
   ilAddActive: TImageList;
   
   Image1     : TImage;
   
   Image2     : TImage;
   
   ToolButton05: TToolButton;
   
   meAphor    : TLabel;
   
   Image3     : TImage;
   
   ToolButton03: TToolButton;
   
   ToolButton06: TToolButton;
   
   ToolBar2   : TToolBar;
   
   ToolBar3   : TToolBar;
   
   tbPlay     : TToolButton;
   
   ToolButton1: TToolButton;
   
   tbNet      : TToolButton;
   
   ToolButton7: TToolButton;
   
   tbSkip     : TToolButton;
   
   ToolButton2: TToolButton;
   
   tbSuggest  : TToolButton;
   
   ToolButton3: TToolButton;
   
   tbBack     : TToolButton;
   
   ToolButton4: TToolButton;
   
   tbHistory  : TToolButton;
   
   ToolButton5: TToolButton;
   
   tbExit     : TToolButton;
   
   laPoints   : TLabel;
   
   btTop      : TSpeedButton;
   
   laLetters  : TLabel;
   
   anComp     : TAnimate;
   
   pmPlayers  : TPopupMenu;
   
   N11        : TMenuItem;
   
   N21        : TMenuItem;
   
   N31        : TMenuItem;
   
   N41        : TMenuItem;
   

procedure btRefreshClick(Sender: TObject);
   

   procedure sgSelectCell(Sender: TObject; ACol, ARow: Integer;
     var CanSelect: Boolean);
      

      procedure FormCreate(Sender: TObject);
         

         procedure sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
           State: TGridDrawState);
            

            procedure sb345Click(Sender: TObject);
               

               procedure tbBackClick(Sender: TObject);
                  

                  procedure sg1DrawCell(Sender: TObject; ACol, ARow: Integer;
                    Rect: TRect; State: TGridDrawState);
                     

                     procedure sg1DragOver(Sender, Source: TObject; X, Y: Integer;
                       State: TDragState; var Accept: Boolean);
                        

                        procedure sg1DragDrop(Sender, Source: TObject; X, Y: Integer);
                           

                           procedure sg1MouseDown(Sender: TObject; Button: TMouseButton;
                             Shift: TShiftState; X, Y: Integer);
                              

                              procedure tbPlayClick(Sender: TObject);
                                 

                                 procedure Timer1Timer(Sender: TObject);
                                    

                                    procedure tbExitClick(Sender: TObject);
                                       

                                       procedure tbSkipClick(Sender: TObject);
                                          

                                          procedure btSuggestClick(Sender: TObject);
                                             

                                             procedure btDicClick(Sender: TObject);
                                                

                                                procedure tbAboutClick(Sender: TObject);
                                                   

                                                   procedure tbHistoryClick(Sender:
                                                    TObject);
                                                    

                                                    procedure tbSaveGameClick(Sender:
                                                     TObject);
                                                     

                                                     procedure tbLoadGameClick(Sender:
                                                      TObject);
                                                      

                                                      procedure tbHelpClick(Sender:
                                                       TObject);
                                                       

                                                       procedure tbSetupClick(Sender:
                                                        TObject);
                                                        

                                                        procedure cb2Change(Sender:
                                                         TObject);
                                                         

                                                         procedure tbLangClick(Sender:
                                                          TObject);
                                                          

                                                          procedure tmGameTimer(Sender:
                                                           TObject);
                                                           

                                                           procedure FormActivate(Sender:
                                                            TObject);
                                                            

                                                            procedure SetLangClick(Sender:
                                                             TObject);
                                                             

                                                             procedure FormClose(Sender:
                                                              TObject; var Action:
                                                              TCloseAction);
                                                              

                                                              procedure btTopMouseMove(
                                                               Sender: TObject; Shift:
                                                               TShiftState; X,
                                                                Y: Integer);
                                                               

                                                               procedure btTopMouseDown(
                                                                Sender: TObject; Button:
                                                                TMouseButton;
                                                                 Shift: TShiftState; X, Y:
                                                                Integer);
                                                                

                                                                procedure btTopClick(
                                                                 Sender: TObject);
                                                                 

                                                                 procedure sb12Click(
                                                                  Sender: TObject);
                                                                  

                                                                  procedure cb1DrawItem(
                                                                   Control: TWinControl;
                                                                   Index: Integer;
                                                                    Rect: TRect; State:
                                                                   TOwnerDrawState);
                                                                   

                                                                   procedure cbDropDown(
                                                                    Sender: TObject);
                                                                    

                                                                    procedure tbNetClick(
                                                                     Sender: TObject);
                                                                     

                                                                     procedure FormDestroy
                                                                      (Sender: TObject);
                                                                      

                                                                      procedure 
                                                                      FormKeyDown(Sender:
                                                                      TObject; var Key:
                                                                      Word;
                                                              Shift   : TShiftState);
                                                                      

                                                                      procedure 
                                                                      laPlayersClick(
                                                                      Sender: TObject);
                                                                      
                                                                      private

                                                                  { Private declarations }
                                                                      
                                                                      public

                                                                   { Public declarations }
                                                                      

                                                                      procedure 
                                                                      ShowSuggestion(
                                                                      Sender: TObject);
                                                                      

                                                                      procedure 
                                                                      ShowComputerStep(
                                                                      Sender: TObject);
                                                                      

                                                                      procedure 
                                                                      RegisterExtension(
                                                                      Ext:string;
                                                                      DoRegister:boolean);
                                                                      

                                                                      procedure 
                                                                      LoadAVIfromEXE;
                                                                      
end;


Tgs = (gsNoGame, gsJustStarted, gsGame);


Tcell = record
           
           Letter: char;
           
           Color: byte;
           
           Weight: byte;
           
           JustSet: boolean;
           
           end;


TPlayer = record
             
             Button: TSpeedButton;
             
             Name: TComboBox;
             
             Rec: TStaticText;
             
             Letters: array[1..7] of char;
             
             LettersObj: TDrawGrid;
             
             IP: string[15];
             
             end;


TPattern = record
              
              DirHor: boolean;
              
              FixPos: TPoint;
              
              MaxL,MaxR: integer;
              
              Pattern: ShortString;
              
              end;


TPlayerMove = record
                 
                 PlayerName: string;
                 
                 DirHor: boolean;
                 
                 Pos: TPoint;
                 
                 Word: ShortString;
                 
                 Points: integer;
                 
                 Total: integer;
                 
                 UsedLetters: ShortString;
                 
                 ReceivedLetters: ShortString;
                 
                 end;


TLanguage = (lgNone, lgENU, lgDEU, lgRUS);


TName = record
           
           Name,
           Points,
           CoolWord: string;
           
           end;


TTopAction = (taNone, taShow, taHide);


TDraft = record
            
            Word: string;
            
            PattNo,
            WCol,
            WRow: integer;
            
            end;



const
      {-------------------------------------------------------------------------}
   _ProductVersion = '3.0';
   
   _ProductVerDate = '21.04.2003';
   
   _ProductOwner = '';
   
   _ProductID  = 'The Erudite Saved Game';
   
   MaxWordLength = 15;
   
   MaxPlayers = 5;
   
   MaxLetters = 7;
   
   MaxPatterns = 10240;
   // Макс количество возможно найденных шаблонов или слов
   // (с двойным запасом).
   // Тестированием удалось достигнуть макс.: 5500 слов.
                                              // При этом игрок имел на руках только звезд
                                              очки.
                                              MaxMoves   = 255;
   
   SuggestionValue = 3;
   
   All7Bonus  = 7;
   
   
   myRed      = $004F4FFF;
   
   myBlue     = $00FF9240;
   
   myYellow   = $0080FFFF;
   
   myGreen    = $0040FF40;
   
   myGray     = $007F7F7F;
   
   myWindow   = $00C0C0C0;
   
   myWhite    = clWhite;
   
   myJustSet  = $00532E2B;
   
   myLetterBk = $00000000;
   
   myLetter   = $00FFFFFF;
   
   myOffset   = $00808080;
   
   myActiveP  = $007FFFFF;
   
   

var
      {---------------------------------------------------------------------------}
   fm_Main       : Tfm_Main;
   
   
   Field,Field2     : array[0..MaxWordLength,0..MaxWordLength] of Tcell;
   
   Players,Players2   : array[1..MaxPlayers] of TPlayer;
      {Players array}
   PCurrent   : byte;
      {Current Player}
   PCNo       : byte;
   
   sWord      : string;
      {Current Word}
   WordCross  : array[1..MaxWordLength] of Boolean;
      {Array of Crossing}
   SCol,SRow       : integer;
      {Current Word: Position}
   WordDirHor: boolean;
      {Current Word: Direction }
   WordIllegal: boolean;
      {Current Word: Status}
   WWeight    : integer;
      {Last Word Weight}
   GameState  : Tgs;
      {Current Game State: gsGame / gsNoGame}
   EMessage   : string;
   
   
   Patterns   : array[1..MaxPatterns] of TPattern;
   
   PatternsCount: Integer;
   
   Suggested  : boolean;
   
   UserSkip   : boolean;
   
   UserTime   : Single;
   
   FoundedWords,
   TheBestWordNo: integer;
   
   Drafts     : array[1..MaxPatterns] of TDraft;
   
   
   PlayerMove:  array[1..MaxMoves] of TPlayerMove;
   
   PlayerMoves: integer;
   
   
   TopNames   :    array[0..9] of TName;
   
   TopAction  :  TTopAction;
   
   
   f1         : textfile;
   
   FileName   : shortstring;
   
   CurrDir    : string;
   
   
   FacesCount: byte;
   
   FacesUsed  : array[1..255] of boolean;
   
   AnimNow    : boolean;
   
   AnimDir    : Integer;
   
   AnimLetters: string;
   
   
      {Setups}
   ShowTips,
   Animation  : boolean;
   
   Difficulty: byte;
   
   TimeLimit  : integer;
   
   AutoSave   : boolean;
   
   AutoLoad   : boolean;
   
   Network    : boolean;
   
   CurrentLanguage: TLanguage;
   
   UserName   : string;
   
   
      {Network}
   NetRes     : array[1..200] of string[20];
   
   NetResCount: integer;
   
   NetPlayerName,
   NetPlayerIP: string[20];
   
   _NetSelfName: array [0..MAX_COMPUTERNAME_LENGTH] of char;
   
   NetSelfName: string;
   
   HeadMaster: string[MAX_COMPUTERNAME_LENGTH+1];
   //Name of Head Computer in NW Game
   NetStartTime: TDateTime;
   
   
      {Alfa channel effects----------------------------------------------------------}

   const
      
      WS_EX_LAYERED    = $80000;
      
      LWA_ALPHA      = 2;
      
      

   type
      
      TSetLayeredWindowAttributes = 


                                    function (
                 hwnd                  : HWND;         // handle to the layered window
                 crKey                 : TColor;      // specifies the color key
                 bAlpha                : byte;       // value for the blend function
                 dwFlags               : DWORD       // action
                                       ): BOOL;
                                       stdcall;
                                       
                                       

                                    var
                                       
                                       SetLayeredWindowAttributes: 
                                                               TSetLayeredWindowAttributes
                                       ;
                                       
                                       _iWindowExStyle: cardinal;
                                       

                                    procedure SetOpacity(hwnd: THandle; Value:integer);
                                       
                                       

          {------------------------------------------------------------------------------}
                                       

                                       function LWeight(Letter:char): integer;
                                          

                                          function CheckWordLayout: boolean;
                                             

                                             function WordWeight: integer;
                                                {Расчет веса слова}

                                                function FieldNextCell(Index:integer): 
                                                                                     Tcell
                                                   ;
                                                   

                                                   function SeaCheck(SCol,SRow:integer;
                                                    DirHor:boolean): boolean;
                                                    

                                                    function Ending(Num:integer): string;
                                                     

                                                     procedure WriteWord;
                                                      

                                                      procedure CheckForUnique;
                                                       

                                                       procedure NextPlayer;
                                                        

                                                        procedure RepaintAll;
                                                         

                                                         procedure LoadDictionary(OldLang:
                                                          TLanguage);
                                                          

                                                          procedure LoadJPEGfromEXE;
                                                           
                                                           
                                                           implementation
                        {================================================================}
                                                           
                                                           
                                                           uses _fm_Top, _fm_Word, _fm_
                                                           WordC, Computer, _fm_DMan, _fm_
                                                           PMoves,
                                                           _fm_Sugg, _fm_Skip, _fm_Setup,
                                                           LangSupp, _fm_Net, _fm_About;
                                                           
                                                           

                                    var

             {---------------------------------------------------------------------------}
                                       
                                       Multiply   : integer;
                                          {Multiply Weight}
                                       StartDragX: Integer;
                                          {for Dragging in Player's Letters}
                                       DestCol,DestRow    : LongInt;
                                       
                                       
                                       AnimLeftA,AnimLeftB  : Integer;
                                       
                                       AWidth,AHeight,BWidth,BHeight    : Integer;
                                       
                                       PCurrentMov: byte;
                                       
                                       
                                          {$R *.DFM}
                                          {$R ADDON.RES}
                                       

          {------------------------------------------------------------------------------}
                                       

                                    function RandomLetter: char;
                                       

                                    var
                                       
                                       lr         : array['а'..'я'] of integer;
                                       
                                       le         : array['a'..'z'] of integer;
                                       
                                       ld         : array['a'..'z'] of integer;
                                       
                                       lt         : integer;
                                       
                                       r          : real;
                                       
                                       i          : char;
                                       

                                    begin
                                       
                                       lt := 0;
                                       r := 0;
                                       i := ' ';
                                       
                                       

           {Для каждой буквы записана величина, пропорциональная вероятности ее появления}
                                       
                                       case CurrentLanguage of
                                       
                                       lgRUS: begin
                                          
                                          lr['а'] := 100;
                                          
                                          lr['б'] := 20;
                                          
                                          lr['в'] := 30;
                                          
                                          lr['г'] := 20;
                                          
                                          lr['д'] := 20;
                                          
                                          lr['е'] := 50;
                                          
                                          lr['ж'] :=  7;
                                          
                                          lr['з'] := 20;
                                          
                                          lr['и'] := 60;
                                          
                                          lr['й'] :=  3;
                                          
                                          lr['к'] := 60;
                                          
                                          lr['л'] := 50;
                                          
                                          lr['м'] := 20;
                                          
                                          lr['н'] := 50;
                                          
                                          lr['о'] := 100;
                                          
                                          lr['п'] := 40;
                                          
                                          lr['р'] := 60;
                                          
                                          lr['с'] := 60;
                                          
                                          lr['т'] := 60;
                                          
                                          lr['у'] := 30;
                                          
                                          lr['ф'] :=  5;
                                          
                                          lr['х'] := 10;
                                          
                                          lr['ц'] :=  5;
                                          
                                          lr['ч'] := 14;
                                          
                                          lr['ш'] := 10;
                                          
                                          lr['щ'] :=  2;
                                          
                                          lr['ъ'] :=  1;
                                          
                                          lr['ы'] := 10;
                                          
                                          lr['ь'] := 20;
                                          
                                          lr['э'] :=  1;
                                          
                                          lr['ю'] :=  4;
                                          
                                          lr['я'] := 30;
                                          
                                          lt := 30;
                                          // ['*']
                                          
                                          for i:='а' to 'я' do
                                             lt:=lt + lr[i];
                                          
                                          
                                          r := Random(lt);
                                          
                                          lt := 0;
                                          
                                          for i:='а' to 'я' do begin
                                             
                                             lt := lt + lr[i];
                                             
                                             if lt > r then
                                                break;
                                             
                                             end;
                                          
                                          end;
                                       
                                       
                                       lgENU: begin
                                          
                                          le['a'] := 250;
                                          
                                          le['b'] :=  50;
                                          
                                          le['c'] := 120;
                                          
                                          le['d'] := 140;
                                          
                                          le['e'] := 450;
                                          
                                          le['f'] :=  80;
                                          
                                          le['g'] :=  70;
                                          
                                          le['h'] := 170;
                                          
                                          le['i'] := 260;
                                          
                                          le['j'] :=   4;
                                          
                                          le['k'] :=  25;
                                          
                                          le['l'] := 170;
                                          
                                          le['m'] :=  90;
                                          
                                          le['n'] := 240;
                                          
                                          le['o'] := 300;
                                          
                                          le['p'] :=  90;
                                          
                                          le['q'] :=   6;
                                          
                                          le['r'] := 230;
                                          
                                          le['s'] := 250;
                                          
                                          le['t'] := 360;
                                          
                                          le['u'] := 100;
                                          
                                          le['v'] :=  35;
                                          
                                          le['w'] :=  60;
                                          
                                          le['x'] :=  15;
                                          
                                          le['y'] :=  60;
                                          
                                          le['z'] :=   5;
                                          
                                          lt := 100;
                                          // ['*']
                                          
                                          for i:='a' to 'z' do
                                             lt:=lt + le[i];
                                          
                                          
                                          r := Random(lt);
                                          
                                          lt := 0;
                                          
                                          for i:='a' to 'z' do begin
                                             
                                             lt := lt + le[i];
                                             
                                             if lt > r then
                                                break;
                                             
                                             end;
                                          
                                          end;
                                       
                                       lgDEU: begin
                                          
                                          ld['a'] := 250;
                                          
                                          ld['b'] :=  50;
                                          
                                          ld['c'] := 120;
                                          
                                          ld['d'] := 140;
                                          
                                          ld['e'] := 450;
                                          
                                          ld['f'] :=  80;
                                          
                                          ld['g'] :=  70;
                                          
                                          ld['h'] := 170;
                                          
                                          ld['i'] := 260;
                                          
                                          ld['j'] :=   4;
                                          
                                          ld['k'] :=  25;
                                          
                                          ld['l'] := 170;
                                          
                                          ld['m'] :=  90;
                                          
                                          ld['n'] := 240;
                                          
                                          ld['o'] := 300;
                                          
                                          ld['p'] :=  90;
                                          
                                          ld['q'] :=   6;
                                          
                                          ld['r'] := 230;
                                          
                                          ld['s'] := 250;
                                          
                                          ld['t'] := 360;
                                          
                                          ld['u'] := 100;
                                          
                                          ld['v'] :=  35;
                                          
                                          ld['w'] :=  60;
                                          
                                          ld['x'] :=  15;
                                          
                                          ld['y'] :=   5;
                                          
                                          ld['z'] :=  60;
                                          
                                          lt := 100;
                                          // ['*']
                                          
                                          for i:='a' to 'z' do
                                             lt:=lt + ld[i];
                                          
                                          
                                          r := Random(lt);
                                          
                                          lt := 0;
                                          
                                          for i:='a' to 'z' do begin
                                             
                                             lt := lt + ld[i];
                                             
                                             if lt > r then
                                                break;
                                             
                                             end;
                                          
                                          end;
                                       
                                       
                                       end;
                                       {CASE}
                                       
                                       if lt > r then
                                          Result := i
                                       else
                                          Result := '*';
                                       
                                       end;
      
      
      {------------------------------------------------------------------------------}

function Ending(Num:integer): string;
   
begin
   
   Result := '';
   
   case CurrentLanguage of
   
   lgRUS:
      
      case Num of
      
      1, 21, 31, 41, 51, 61, 71, 81, 91:
         Result := 'о';
      
      2..4, 22..24, 32..34, 42..44, 52..54, 62..64, 72..74, 82..84, 92..94:
         Result := 'а';
      
      else
         Result := 'ов';
      
      end;
   
   lgENU:
      if Num>1 then
         Result := 's';
   
   lgDEU:
      if Num>1 then
         Result := 'e';
   
   end;
   
   end;


{------------------------------------------------------------------------------}

function LWeight(Letter:char): integer;
   
begin
   
   Result := 0;
   
   case CurrentLanguage of
   
   lgRUS: begin
      
      if not (Letter in ['а'..'я','*']) then begin
         
         MessageDlg(Format(_M_mLNotReg,[Letter]), mtError, [mbOk], 0);
         
         Result := -1;
         
         exit;
         
         end;
      
      if Letter in ['а','е','и','н','о'] then
         Result := 1;
      
      if Letter in ['в','д','й','к','л','м','п','р','с','т'] then
         Result := 2;
      
      if Letter in ['б','г','у','я'] then
         Result := 3;
      
      if Letter in ['ж','з','х','ч','ы','ь'] then
         Result := 5;
      
      if Letter in ['ф','ц','ш','щ','ъ','э','ю'] then
         Result := 10;
      
      end;
   
   lgENU: begin
      
      if not (Letter in ['a'..'z','*']) then begin
         
         MessageDlg(Format(_M_mLNotReg,[Letter]), mtError, [mbOk], 0);
         
         Result := -1;
         
         exit;
         
         end;
      
      if Letter in ['a','e','i','n','o','r','s','t'] then
         Result := 1;
      
      if Letter in ['c','d','h','l','m','p','u','k'] then
         Result := 2;
      
      if Letter in ['b','f','g','y'] then
         Result := 3;
      
      if Letter in ['x','v','w'] then
         Result := 5;
      
      if Letter in ['j','q','z'] then
         Result := 10;
      
      end;
   
   lgDEU: begin
      
      if not (Letter in ['a'..'z','*']) then begin
         
         MessageDlg(Format(_M_mLNotReg,[Letter]), mtError, [mbOk], 0);
         
         Result := -1;
         
         exit;
         
         end;
      
      if Letter in ['a','e','i','n','o','r','s','t'] then
         Result := 1;
      
      if Letter in ['c','d','h','l','m','p','u','k'] then
         Result := 2;
      
      if Letter in ['b','f','g','z'] then
         Result := 3;
      
      if Letter in ['x','v','w'] then
         Result := 5;
      
      if Letter in ['j','q','y'] then
         Result := 10;
      
      end;
   
   end;
   {CASE}
   
   end;


{------------------------------------------------------------------------------}

procedure CheckForUnique;
   

var
   i          : integer;
   
   WordUC     : string;
   

begin
   
   EMessage := '';
   
   WordUC := '"' + AnsiUpperCase(sWord) + '"';
   
   for i:=1 to PlayerMoves do
      
      if Trim(PlayerMove[i].Word)=WordUC then
         
         EMessage := Format(_M_mWUsed,[WordUC]);
   
   end;


{------------------------------------------------------------------------------}

procedure RepaintAll;
   
begin
   
   fm_Main.sg.Repaint;
   
   fm_Main.sg1.Repaint;
   fm_Main.sg2.Repaint;
   fm_Main.sg3.Repaint;
   
   fm_Main.sg4.Repaint;
   fm_Main.sg5.Repaint;
   
   
   fm_Main.ToolBar1.Repaint;
   
   end;


{ $ I Computer.pas}

{------------------------------------------------------------------------------}

procedure Tfm_Main.ShowComputerStep;
   

var
   i          : integer;
   

begin
   
   WordIllegal := true;
   
   //?
   while (FoundedWords>0) and (WordIllegal) do begin
      
      SearchBestWord;
      
      
      if not UserSkip then
         fm_WordC.ShowModal;
      
      end;
   {while}
   
   fm_Main.anComp.Active := false;
   
   Screen.Cursor := crDefault;
   
   
   {Компьютер подумал!}
   
   {Остановить время}
   fm_Main.tmGame.Enabled := false;
   
   
   if WordIllegal then begin
      
      MessageDlg(_M_mISkip, mtInformation, [mbOk], 0);
      
      UserSkip := true;
      
      sWord := '';
      
      for i:=1 to 7 do
         
         if (Difficulty<3) or (Players[PCurrent].Letters[i]<>'*') then
            sWord := sWord + Players[PCurrent].Letters[i];
      
      
      {Переход хода}
      NextPlayer;
      
      exit
      end;
   
   
   {Все в порядке; Компьютер благополучно сходил----------------------------------}
   GameState := gsGame;
   
   
   {Сохранение предыдущего состояния поля}
   //  Field2 := Field;
   
   
   {Заполение массива поля новым словом}
   WriteWord;
   
   
   {Запись счета}
   MessageDlg(Format(_M_mIPoints,[WWeight,Ending(WWeight)]), mtInformation, [mbOk], 0);
   
   Players[PCurrent].Rec.Caption := IntToStr(StrToInt(Players[PCurrent].Rec.Caption)+
   WWeight);
   
   //  Players[PCurrent].Points := Players[PCurrent].Points + WWeight;
   
   
   {Переход хода}
   NextPlayer;
   
   end;


{------------------------------------------------------------------------------}

procedure ComputerStep;
   
begin
   
   RepaintAll;
   
   
   {Компьютер думает ...}
   fm_Main.anComp.Active := true;
   
   Screen.Cursor := crAppStart;
   
   
   if GameState=gsGame then
      SearchPatterns
   else
      SearchPatternsFirst;
   
   
   FindMultiPatterns;
   
   
   with fm_Main do
      
with         TGetListOfWords.Create do
OnTerminate:=ShowComputerStep;
   
   end;


{------------------------------------------------------------------------------}

procedure NextPlayer;
   

var
   i          : byte;
   
   s          : string;
   
   c          : char;
   

begin
   
   EMessage := '';
   
   fm_Main.tbBack.Enabled := true;
   
   
   {Отмена выделения цветом текущего игрока}
   Players[PCurrent].Name.Color := clWindow;
   
   Players[PCurrent].Rec.Color := clWindow;
   
   
   {Отмена флага о подсказке}
   Suggested := false;
   
   
   {Сохранение предыдущих букв игрока}
   if Trim(Players[PCurrent].Name.Text)<>_M_sPPCName then
      Players2 := Players;
   
   
   {Запись хода в архив ходов}
   inc(PlayerMoves);
   
   PlayerMove[PlayerMoves].PlayerName := Players[PCurrent].Name.Text;
   
   PlayerMove[PlayerMoves].DirHor := WordDirHor;
   
   PlayerMove[PlayerMoves].Pos := Point(SCol,SRow);
   
   if not UserSkip then
      PlayerMove[PlayerMoves].Word := '"' + AnsiUpperCase(sWord) + '"'
   else
      PlayerMove[PlayerMoves].Word := _M_sSkip;
   
   PlayerMove[PlayerMoves].Points := WWeight;
   
   PlayerMove[PlayerMoves].Total := StrToInt(Players[PCurrent].Rec.Caption);
   
   PlayerMove[PlayerMoves].UsedLetters := '';
   {Заполняется чуть ниже}
   PlayerMove[PlayerMoves].ReceivedLetters := '';
   {Заполняется чуть ниже}
   
   
   {Удаление у игрока букв, выложенных на поле}
   s := '';
   
   for i:=1 to 7 do
      s:=s + Players[PCurrent].Letters[i];
   
   
   for i:=1 to length(sWord) do begin
      
      
      if not WordCross[i] then
         
         if (Pos(sWord[i],s)<>0) then begin
            
            Delete(s,Pos(sWord[i],s),1);
            
            PlayerMove[PlayerMoves].UsedLetters := PlayerMove[PlayerMoves].UsedLetters +
                                                  ' ,' + AnsiUpperCase(sWord[i]);
            
            end
         
      else if (Pos('*',s)<>0) then begin
         
         Delete(s,Pos('*',s),1);
         
         PlayerMove[PlayerMoves].UsedLetters := PlayerMove[PlayerMoves].UsedLetters +
                                               ' ,' + '*';
         
         end
      
      else begin
         
         MessageDlg(Format(_M_mLNotPC,[sWord[i]]), mtWarning, [mbOk], 0);
         
         end;
      
      end;
   
   if not UserSkip then
      Delete(PlayerMove[PlayerMoves].UsedLetters,1,2);
   
   
   {В "s" мы получили список оставшихся букв}
   if (s='') and (not UserSkip) then begin
      
      MessageDlg(Format(_M_mBonus, [MaxPlayers, All7Bonus]), mtInformation, [mbOk], 0);
      
      Players[PCurrent].Rec.Caption := 
                        IntToStr(StrToInt(Players[PCurrent].Rec.Caption) + 15);
      
      PlayerMove[PlayerMoves].Points := WWeight + 15;
      
      PlayerMove[PlayerMoves].Total := StrToInt(Players[PCurrent].Rec.Caption);
      
      end;
   
   
   
   {Группировка оставшихся букв и добавление новых букв}
   for i:=1 to Length(s) do
      Players[PCurrent].Letters[i]:=s[i];
   
   for i:=Length(s)+1 to 7 do begin
      
      c := RandomLetter;
      
      Players[PCurrent].Letters[i] := c;
      
      PlayerMove[PlayerMoves].ReceivedLetters := PlayerMove[PlayerMoves].ReceivedLetters +
      
                                                ' ,' + AnsiUpperCase(c);
      
      end;
   
   Delete(PlayerMove[PlayerMoves].ReceivedLetters,1,2);
   
   if sWord<>'' then
      Players[PCurrent].LettersObj.Col := Length(s);
   
   Players[PCurrent].LettersObj.Repaint;
   
   
   {Расчет номера следующего игрока}
   repeat
      inc(PCurrent)
   until (PCurrent>MaxPlayers) or (Players[PCurrent].Name.Visible);
   
   if PCurrent>MaxPlayers then
      PCurrent := 1;
   
   
   {Выделения цветом текущего игрока}
   Players[PCurrent].Name.Color := myActiveP;
   
   Players[PCurrent].Rec.Color := myActiveP;
   
   
   {Перерисовали экран}
   RepaintAll;
   
   
   UserSkip := false;
   
   UserTime := 0;
   
   fm_Main.tmGame.Enabled := Boolean(TimeLimit);
   
   fm_Main.stTime.Color := clBtnFace;
   
   fm_Main.stTime.Caption := '0:00:00';
   
   
   if Trim(Players[PCurrent].Name.Text)=_M_sPPCName then
      ComputerStep;
   
   end;


{------------------------------------------------------------------------------}

procedure PrevPlayer;
   
begin
   
   (*
   Players[PCurrent].Name.Color:=clWindow;
   Players[PCurrent].Rec.Color:=clWindow;
   *)
   repeat
      dec(PCurrent)
   until (PCurrent<1) or (Players[PCurrent].Name.Visible);
   
   if PCurrent<1 then
      PCurrent := MaxPlayers;
   
   while not Players[PCurrent].Name.Visible do
      dec(PCurrent);
   
   (*
   Players[PCurrent].Name.Color:=myActiveP;
   Players[PCurrent].Rec.Color:=myActiveP;
   *)
   
   //  Players[PCurrent].Rec.Caption := IntToStr(StrToInt(Players[PCurrent].Rec.Caption) -
   WWeight);
   
   Players[PCurrent].Rec.Caption := IntToStr(StrToInt(Players[PCurrent].Rec.Caption)
                                   - PlayerMove[PlayerMoves].Points);
   
   
   PlayerMove[PlayerMoves].Word := '';
   
   dec(PlayerMoves);
   
   
   if Trim(Players[PCurrent].Name.Text)=_M_sPPCName then
      PrevPlayer;
   //ComputerStep;
   
   
   {Reset timer}
   UserTime := 0;
   
   fm_Main.tmGame.Enabled := Boolean(TimeLimit);
   
   fm_Main.stTime.Color := clBtnFace;
   
   fm_Main.stTime.Caption := '0:00:00';
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.btRefreshClick(Sender: TObject);
   
begin
   
   RepaintAll
   end;


{------------------------------------------------------------------------------}

procedure ClearField;
   

var
   i,j          : byte;
   

begin
   
   WordDirHor := false;
   
   AnimNow := false;
   
   AnimLetters := '';
   
   PlayerMoves := 0;
   
   EMessage := '';
   
   PCurrent := 1;
   { Sets Player #1 as Current }
   PCNo := 0;
   { Sets PC_Palyer_No as 0}
   
   for i:=1 to MaxPlayers do
      Players[i].Rec.Caption:='0';
   
   
   with fm_Main do begin
      
      { Cleaning Field---------------------------------------------------------------}
      for i:=0 to sg.ColCount do
         
         for j:=0 to sg.RowCount do begin
            
            Field[i,j].Letter := ' ';
            
            Field[i,j].Weight := 0;
            
            Field[i,j].Color := 0;
            
            Field[i,j].JustSet := false;
            
            end;
      
      
      { Set Cells Colors weight =====================================================}
      {Center}
      Field[(sg.ColCount-1) div 2,(sg.RowCount-1) div 2].Color := 5;
      
      
      {Red}
      Field[0,0].Color := 4;
      
      Field[0,sg.RowCount-1].Color := 4;
      
      Field[sg.ColCount-1,0].Color := 4;
      
      Field[sg.ColCount-1,sg.RowCount-1].Color := 4;
      
      
      Field[0,(sg.RowCount-1) div 2].Color := 4;
      
      Field[(sg.ColCount-1) div 2,0].Color := 4;
      
      Field[sg.ColCount-1,(sg.RowCount-1) div 2].Color := 4;
      
      Field[(sg.ColCount-1) div 2,sg.RowCount-1].Color := 4;
      
      
      {Blue}
      for i:=1 to 4 do
         Field[i,i].Color:=3;
      
      for i:=1 to 4 do
         Field[sg.ColCount-1-i,i].Color:=3;
      
      for i:=1 to 4 do
         Field[i,sg.RowCount-1-i].Color:=3;
      
      for i:=1 to 4 do
         Field[sg.ColCount-1-i,sg.RowCount-1-i].Color:=3;
      
      
      {Yellow}
      Field[1,(sg.RowCount-1) div 2 -2].Color := 2;
      
      Field[1,(sg.RowCount-1) div 2 +2].Color := 2;
      
      
      Field[(sg.ColCount-1) div 2 -2,1].Color := 2;
      
      Field[(sg.ColCount-1) div 2 +2,1].Color := 2;
      
      
      Field[sg.ColCount-2,(sg.RowCount-1) div 2 -2].Color := 2;
      
      Field[sg.ColCount-2,(sg.RowCount-1) div 2 +2].Color := 2;
      
      
      Field[(sg.ColCount-1) div 2 -2,sg.RowCount-2].Color := 2;
      
      Field[(sg.ColCount-1) div 2 +2,sg.RowCount-2].Color := 2;
      
      
      {Green}
      Field[0,3].Color := 1;
      
      Field[3,0].Color := 1;
      
      Field[0,sg.RowCount-4].Color := 1;
      
      Field[3,sg.RowCount-1].Color := 1;
      
      Field[sg.ColCount-1,3].Color := 1;
      
      Field[sg.ColCount-4,0].Color := 1;
      
      Field[sg.ColCount-1,sg.RowCount-4].Color := 1;
      
      Field[sg.ColCount-4,sg.RowCount-1].Color := 1;
      
      
      {----------}
      Field[2,(sg.RowCount-1) div 2 -1].Color := 1;
      
      Field[2,(sg.RowCount-1) div 2 +1].Color := 1;
      
      Field[3,(sg.RowCount-1) div 2   ].Color := 1;
      
      
      Field[(sg.ColCount-1) div 2 -1,2].Color := 1;
      
      Field[(sg.ColCount-1) div 2 +1,2].Color := 1;
      
      Field[(sg.ColCount-1) div 2   ,3].Color := 1;
      
      
      Field[sg.ColCount-3,(sg.RowCount-1) div 2 -1].Color := 1;
      
      Field[sg.ColCount-3,(sg.RowCount-1) div 2 +1].Color := 1;
      
      Field[sg.ColCount-4,(sg.RowCount-1) div 2   ].Color := 1;
      
      
      Field[(sg.ColCount-1) div 2 -1,sg.RowCount-3].Color := 1;
      
      Field[(sg.ColCount-1) div 2 +1,sg.RowCount-3].Color := 1;
      
      Field[(sg.ColCount-1) div 2   ,sg.RowCount-4].Color := 1;
      
      
      {----------}
      Field[(sg.ColCount-1) div 2 -1,(sg.RowCount-1) div 2 -1].Color := 1;
      
      Field[(sg.ColCount-1) div 2 -1,(sg.RowCount-1) div 2 +1].Color := 1;
      
      Field[(sg.ColCount-1) div 2 +1,(sg.RowCount-1) div 2 -1].Color := 1;
      
      Field[(sg.ColCount-1) div 2 +1,(sg.RowCount-1) div 2 +1].Color := 1;
      
      
      { Save first UNDO -------------------------------------------------------------}
      Field2 := Field;
      
      Players2 := Players;
      
      tbBack.Enabled := false;
      
      
      GameState := gsJustStarted;
      
      
      { Refresh Grids ---------------------------------------------------------------}
      RepaintAll;
      
      
      end;
   {with}
   end;


{------------------------------------------------------------------------------}

function FieldNextCell(Index:integer): Tcell;
   
begin
   
   
   if (SCol+Index<1) or (SRow+Index<1) then begin
      
      Result.Letter := ' ';
      
      Result.Color := 0;
      
      Result.Weight := 0;
      
      Result.JustSet := false;
      
      exit;
      
      end;
   
   
   if WordDirHor then
      Result := Field[SCol+Index-1,SRow]
   else
      Result := Field[SCol,SRow+Index-1]
   end;


{------------------------------------------------------------------------------}

function WordWeight: integer;
   {Расчет веса слова}

var
   i          : byte;
   

begin
   
   Result := 0;
   
   {*}
   Multiply := 1;
   
   for i:=1 to length(sWord) do
      

      if (FieldNextCell(i).Letter=' ') and
        ((FieldNextCell(i).Color=3) or (FieldNextCell(i).Color=4)) then
         Multiply := FieldNextCell(i).Color-1;
   
   {+}
   for i:=1 to length(sWord) do
      
      if FieldNextCell(i).Letter=' ' then
         if FieldNextCell(i).Color<3 then
            Result := Result + LWeight(sWord[i])*(FieldNextCell(i).Color+1)
      else
         Result := Result + LWeight(sWord[i])
      else
         Result := Result + (FieldNextCell(i).Weight);
   
   
   {Учет начала/продолжения существующего слова}
   
   if WordDirHor then begin
      
      {Слово может быть приставлено в конце}
      if (WordCross[1]=true) and (SCol>1) then
         
         for i:=SCol-1 downto 0 do
            
            if (Field[i,SRow].Letter<>' ') then
               Result := Result + (Field[i,SRow].Weight)
            else
               break;
      
      
      if WordCross[Length(sWord)]=true then
         {Слово может быть приставлено в начале}
         for i:=SCol+Length(sWord) to fm_Main.sg.ColCount-1 do
            
            if (Field[i,SRow].Letter<>' ') then
               Result := Result + (Field[i,SRow].Weight)
            else
               break;
      
      end
   
   else begin
      
      {Слово может быть приставлено в конце}
      if (WordCross[1]=true) and (SRow>1) then
         
         for i:=SRow-1 downto 0 do
            
            if (Field[SCol,i].Letter<>' ') then
               WWeight := WWeight + (Field[SCol,i].Weight)
            else
               break;
      
      
      if WordCross[Length(sWord)]=true then
         {Слово может быть приставлено в начале}
         for i:=SRow+Length(sWord) to fm_Main.sg.RowCount-1 do
            
            if (Field[SCol,i].Letter<>' ') then
               WWeight := WWeight + (Field[SCol,i].Weight)
            else
               break;
      
      end;
   
   
   Result := Result*Multiply;
   
   
   end;


{------------------------------------------------------------------------------}

function CheckWordLayout: boolean;
   

var
   
   i          : integer;
   
   HaveCross  : boolean;
   
   s          : string;
   

begin
   
   Result := true;
   
   EMessage := '';
   
   {$I _lg_shared.pas}   {= and |}
   
   if WordDirHor then begin
      {---------------------------------------------------}
      {$I _lg_hor.pas}    {=}
      end
   
   else begin
      
      {$I _lg_ver.pas}    {|}
      end;
   {else}
   end;


{------------------------------------------------------------------------------}

procedure WriteWord;
   

var
   i,j          : integer;
   

begin
   
   for i:=0 to MaxWordLength-1 do
      
      for j:=0 to MaxWordLength-1 do
         
Field                       [i,j].JustSet:=false;
   
   
   if WordDirHor then
      for i:=1 to length(sWord) do begin
         
         Field[SCol+i-1,SRow].Letter := sWord[i];
         
         Field[SCol+i-1,SRow].Weight := LWeight(sWord[i]);
         
         Field[SCol+i-1,SRow].JustSet := true;
         
         end
      
   else
      for i:=1 to length(sWord) do begin
         
         Field[SCol,SRow+i-1].Letter := sWord[i];
         
         Field[SCol,SRow+i-1].Weight := LWeight(sWord[i]);
         
         Field[SCol,SRow+i-1].JustSet := true;
         
         end;
   
   
   RepaintAll;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sgSelectCell(Sender: TObject; ACol,ARow: Integer; var CanSelect:
   Boolean);
   
begin
   
   SCol := ACol;
   
   SRow := ARow;
   
   
   { Ввод слова ------------------------------------------------------------------}
   fm_Word.ShowModal;
   
   if EMessage='Timeout' then begin
      
      MessageBox(0,PChar(_M_mTimeOut),
      PChar(Application.Title),
      MB_OK or MB_TASKMODAL or
      MB_ICONINFORMATION or MB_DEFBUTTON1);
      
      sWord := '';
      
      UserSkip := true;
      
      NextPlayer;
      
      exit;
      
      end;
   
   
   if EMessage<>'' then
      exit;
   
   
   {Проверка на уникальность вводимого слова}
   CheckForUnique;
   
   if EMessage<>'' then begin
      
      MessageDlg(EMessage, mtError, [mbOk], 0);
      
      exit;
      
      end;
   
   
   {Все в порядке; Игрок благополучно сходил--------------------------------------}
   GameState := gsGame;
   
   
   {Остановить время}
   fm_Main.tmGame.Enabled := false;
   
   
   {Сохранение предыдущего состояния поля}
   Field2 := Field;
   
   
   {Расчет веса слова}
   WWeight := WordWeight;
   
   
   {Заполение массива поля новым словом}
   WriteWord;
   
   
   {Запись счета}
   RepaintAll;
   
   MessageDlg(Format(_M_mPoints, [WWeight, Ending(WWeight)]), mtInformation, [mbOk], 0);
   
   Players[PCurrent].Rec.Caption := IntToStr(StrToInt(Players[PCurrent].Rec.Caption)+
   WWeight);
   
   
   {Переход хода}
   NextPlayer;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.FormCreate(Sender: TObject);
   

var
   
   i,j          : integer;
   
   c          : cardinal;
   

begin
   
   @SetLayeredWindowAttributes := GetProcAddress(LoadLibrary('user32.dll'),
   'SetLayeredWindowAttributes');
   
   //  SetOpacity(Handle, 0);
   
   //  SetOpacity(Handle, 255);
   
   
   {Install font RS Serife}
   FontLoad;
   
   LoadJPEGfromEXE;
   
   LoadAVIfromEXE;
   
   
   {Look for self name in Network}
   GetComputerName(_NetSelfName, c);
   
   NetSelfName := String(_NetSelfName);
   
   
   FileName := _M_sFNGame;
   
   CurrentLanguage := lgNone;
   
   TopAction := taNone;
   
   CurrDir := ExtractFilePath(Application.ExeName);
   
   
   Randomize;
   
   ClearField;
   
   GameState := gsNoGame;
   
   
   { Set Players Array -----------------------------------------------------------}
   Players[1].Button := sb1;
   Players[1].Name := cb1;
   Players[1].Rec := st1;
   Players[1].LettersObj := sg1;
   
   Players[2].Button := sb2;
   Players[2].Name := cb2;
   Players[2].Rec := st2;
   Players[2].LettersObj := sg2;
   
   Players[3].Button := sb3;
   Players[3].Name := cb3;
   Players[3].Rec := st3;
   Players[3].LettersObj := sg3;
   
   Players[4].Button := sb4;
   Players[4].Name := cb4;
   Players[4].Rec := st4;
   Players[4].LettersObj := sg4;
   
   Players[5].Button := sb5;
   Players[5].Name := cb5;
   Players[5].Rec := st5;
   Players[5].LettersObj := sg5;
   
   
   { Bitmap #0 - is an OK picture
   Bitmap #LAST - is a Computer picture
   }
   FacesCount := ilPlayers.Count-2;
   
   for i:=1 to FacesCount do
      FacesUsed[i]:=false;
   
   //  for i:=1 to MaxPlayers do begin
      
      //    Players[i].Face := TBitmap.Create;
      
      //    Players[i].Face.Height := 32;
      
      //    Players[i].Face.Width := 32;
      
      //
      end;
   
   
   
   (*
   { Load Buttons icons from Resource --------------------------------------------}
   ilMainActive.ResourceLoad(rtBitmap,'TB_ENABLED',clTeal);
   
   ilMainDisabled.ResourceLoad(rtBitmap,'TB_DISABLED',clTeal);
   
   ilMainHot.ResourceLoad(rtBitmap,'TB_HOT',clTeal);
   
   *)
   
   { Set Random Face1 ------------------------------------------------------------}
   for i:=1 to 2 do begin
      
      repeat
         j := Random(FacesCount)+1
      until not FacesUsed[j];
      
      ilPlayers.GetBitmap(j,Players[i].Button.Glyph);
      
      Players[i].Button.Spacing := j;
      
      FacesUsed[j] := true;
      
      end;
   
   for i:=3 to 5 do
      ilPlayers.GetBitmap(0,Players[i].Button.Glyph);
   
   
   //  for i:=1 to 5 do
      ilPlayers.Draw(Players[i].Face.Canvas,0,0,i+1);
   
   //  for i:=1 to 5 do
      ilPlayers.Draw(Players[i].Button.Glyph.Canvas,0,0,1);
   
   
   (*
   {Ставим личико игроку #1}
   i := Random(MaxPlayers)+1;
   
   Players[1].Button.Glyph := Players[i].Face;
   
   Players[i].FaceUsed := 1;
   
   
   {Ставим личико игроку #2}
   repeat
      i := Random(MaxPlayers)+1
   Until Players[i].FaceUsed=0;
   
   Players[2].Button.Glyph := Players[i].Face;
   
   Players[i].FaceUsed := 2;
   
   
   for i:=3 to MaxPlayers do
      ilPlayers.GetBitmap(0,Players[i].Button.Glyph);
   
   *)
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sgDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
   
begin
   
   with Sender as TDrawGrid do begin
      
      {Пустые клетки ------------------------------------------------------------}
      if Field[ACol,ARow].Letter=' ' then begin
         
         case Field[ACol,ARow].Color of
         
         0:
            Canvas.Brush.Color := myWindow;
         
         1:
            Canvas.Brush.Color := myGreen;
         
         2:
            Canvas.Brush.Color := myYellow;
         
         3:
            Canvas.Brush.Color := myBlue;
         
         4:
            Canvas.Brush.Color := myRed;
         
         5:
            Canvas.Brush.Color := myGray;
         
         end;
         
         if Field[ACol,ARow].JustSet then
            Canvas.Brush.Color := Canvas.Brush.Color and not myOffset;
         
         
         Canvas.FillRect(Rect);
         
         end
      
      
      {Клетки с буквами ---------------------------------------------------------}
      else begin
         
         if Field[ACol,ARow].JustSet then
            Canvas.Brush.Color := myJustSet
         else
            Canvas.Brush.Color := myLetterBk;
         
         Canvas.FillRect(Rect);
         
         
         Canvas.Font.Size := 12;
         
         Canvas.Font.Style := [fsBold];
         
         Canvas.Font.Color := myLetter;
         
         Canvas.TextRect(Rect, Rect.Left+1, Rect.Top-2,
                         AnsiUpperCase(Field[ACol,ARow].Letter));
         
         
         case Field[ACol,ARow].Color of
         
         0:
            Canvas.Font.Color := myWindow;
         
         1:
            Canvas.Font.Color := myGreen;
         
         2:
            Canvas.Font.Color := myYellow;
         
         3:
            Canvas.Font.Color := myBlue;
         
         4:
            Canvas.Font.Color := myRed;
         
         5:
            Canvas.Font.Color := myGray;
         
         end;
         
         Canvas.Font.Name := 'Small Fonts';
         
         Canvas.Font.Style := [];
         
         Canvas.Font.Size := 6;
         
         Rect.Left := Rect.Left+14;
         
         Rect.Top := Rect.Top+14;
         
         Canvas.TextRect(Rect, Rect.Left, Rect.Top, IntToStr(Field[ACol,ARow].Weight));
         
         end;
      
      end;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sb345Click(Sender: TObject);
   

var
   i,j          : byte;
   

begin
   
   if GameState<>gsNoGame then
      exit;
   
   
   i := 0;
   
   Repeat
      inc(i)
   Until Players[i].Button=Sender;
   
   
   if Players[i].Name.Visible then begin
      {----------------------- Удаляем игрока}
      
      Players[i].Button.Glyph.Canvas.Draw(5,5,Players[i].Button.Glyph);
      
      ilPlayers.GetBitmap(0,Players[i].Button.Glyph);
      
      
      FacesUsed[Players[i].Button.Spacing] := false;
      
      Players[i].Button.Spacing := 0;
      
      Players[i].Name.Visible := false;
      
      Players[i].Rec.Visible := false;
      
      Players[i].LettersObj.Visible := false;
      
      Players[i].Rec.Caption := '0';
      
      for j:=1 to 7 do
         Players[i].Letters[j]:=#0;
      
      end
   
   
   else begin
      {------------------------------------------------ Добавляем игрока}
      repeat
         j := Random(FacesCount)+1
      Until not FacesUsed[j];
      
      Players[i].Button.Glyph.Canvas.Draw(5,5,Players[i].Button.Glyph);
      
      ilPlayers.GetBitmap(j,Players[i].Button.Glyph);
      
      FacesUsed[j] := true;
      
      
      Players[i].Button.Spacing := j;
      
      Players[i].Name.Visible := true;
      
      Players[i].Rec.Visible := true;
      
      Players[i].LettersObj.Visible := true;
      
      cb2Change(Sender);
      
      end;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbBackClick(Sender: TObject);
   

var
   i,j          : byte;
   
   Empty      : boolean;
   

begin
   
   if MessageBox(0,PChar(_M_mBack),
                 PChar(Application.Title),
                 MB_YESNO or MB_TASKMODAL or
                 MB_ICONQUESTION or MB_DEFBUTTON2)=IDNO then
      exit;
   
   
   tbBack.Enabled := false;
   
   
   Field := Field2;
   
   Players := Players2;
   
   
   PrevPlayer;
   
   
   RepaintAll;
   
   
   {Проверяем - возвращаемся ли мы к началу игры}
   Empty := true;
   
   for i:=0 to sg.ColCount do
      
      for j:=0 to sg.RowCount do
         
         if Field[i,j].Letter<>' ' then begin
            
            Empty := false;
            
            break;
            
            end;
   
   if Empty then
      GameState := gsJustStarted;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sg1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
   

Var
   
   PCurrentLoc: byte;
   

begin
   
   
   with Sender as TDrawGrid do begin
      
      PCurrentLoc := Tag;
      
      
      {Пустые клетки ------------------------------------------------------------}
      if Players[PCurrentLoc].Letters[ACol+1]=#0 then begin
         
         Canvas.Brush.Color := myWindow;
         
         Canvas.FillRect(Rect);
         
         end
      
      
      {Клетки с буквами ---------------------------------------------------------}
      else begin
         
         if (ACol=Col) and (ARow=Row) and (not AnimNow) then
            Canvas.Brush.Color := clNavy
         else
            Canvas.Brush.Color := clBlack;
         
         Canvas.FillRect(Rect);
         
         
         Canvas.Font.Size := 12;
         
         Canvas.Font.Style := [fsBold];
         
         
         if Players[PCurrentLoc].Letters[ACol+1]='*' then begin
            
            Canvas.Font.Color := myYellow;
            
            Canvas.TextRect(Rect, Rect.Left+1, Rect.Top-2,
                   AnsiUpperCase(Players[PCurrentLoc].Letters[ACol+1]));
            
            end
         
         
         else begin
            
            if PCurrentLoc=PCurrent then
               Canvas.Font.Color := myWhite
            else
               Canvas.Font.Color := myGray;
            
            Canvas.TextRect(Rect, Rect.Left+1, Rect.Top-2,
                   AnsiUpperCase(Players[PCurrentLoc].Letters[ACol+1]));
            
            
            Canvas.Font.Color := myWhite;
            
            Canvas.Font.Name := 'Small Fonts';
            
            Canvas.Font.Style := [];
            
            Canvas.Font.Size := 7;
            
            Rect.Left := Rect.Left+14;
            
            Rect.Top := Rect.Top+14;
            
            Canvas.TextRect(Rect, Rect.Left, Rect.Top, IntToStr(LWeight(Players[
            PCurrentLoc].Letters[ACol+1])));
            
            end;
         
         end;
      
      end;
   
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sg1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
   

var
   i          : byte;
   

begin
   
   if Source=Sender then begin
      
      Accept := true;
      
      with Sender as TStringGrid do begin
         
         Canvas.Brush.Color := clBlack;
         
         for i:=1 to 7 do
            Canvas.FillRect(Rect(i*25-2,0,i*25,25));
         
         Canvas.Brush.Color := clBtnFace;
         
         for i:=1 to 7 do
            Canvas.FillRect(Rect(i*25-1,0,i*25,25));
         
         
         Canvas.Brush.Color := clYellow;
         
         if x>StartDragX then
            Canvas.FillRect(Rect((x+25)div 25 *25-2,0,(x+25)div 25*25,25))
         else
            Canvas.FillRect(Rect(x div 25 *25-2,0,x div 25*25,25));
         
         end;
      {with}
      end{if}
   
   else
      Accept := false;
   
   
   
   end;


{ Animation -------------------------------------------------------------------}

procedure Move2Blocks(Source:TDrawGrid; ARect,BRect:TRect);
   
begin
   
   AWidth := ARect.Right-ARect.Left;
   
   AHeight := ARect.Bottom-ARect.Top;
   
   BWidth := BRect.Right-BRect.Left;
   
   BHeight := BRect.Bottom-BRect.Top;
   
   
   {Запомнили 1й блок}
   BitBlt(fm_Main.I1.Canvas.Handle,0,0,AWidth,AHeight, Source.Canvas.Handle, ARect.Left,
   ARect.Top, SRCCOPY);
   
   {Запомнили 2й блок}
   BitBlt(fm_Main.I2.Canvas.Handle,0,0,BWidth,BHeight, Source.Canvas.Handle, BRect.Left,
   BRect.Top, SRCCOPY);
   
   
   fm_Main.pa1.Top := Players[PCurrentMov].LettersObj.Top + 1;
   
   fm_Main.pa2.Top := Players[PCurrentMov].LettersObj.Top + 2;
   
   fm_Main.pa2.Width := BWidth-1;
   
   
   with Source as TDrawGrid do begin
      
      fm_Main.pa1.Left := Players[PCurrentMov].LettersObj.Left + 25*Col + 1;
      
      if AnimDir>0 then begin
         
         fm_Main.pa2.Left := Players[PCurrentMov].LettersObj.Left + 25*(Col+1) + 2;
         
         AnimLeftA := Players[PCurrentMov].LettersObj.Left + 25*Col + fm_Main.pa2.Width +
         2;
         
         AnimLeftB := Players[PCurrentMov].LettersObj.Left + 25*Col + 2;
         
         end
      
      else begin
         
         fm_Main.pa2.Left := Players[PCurrentMov].LettersObj.Left + 25*Col - fm_Main.pa2.
         Width;
         
         AnimLeftA := fm_Main.pa2.Left;
         
         AnimLeftB := fm_Main.pa2.Left + 25;
         
         end;
      
      end;
   
   
   fm_Main.pa1.Visible := true;
   
   fm_Main.pa2.Visible := true;
   
   
   {Инициализирум таймер вместе с его событием}
   fm_Main.Timer1.Enabled := true;
   
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.Timer1Timer(Sender: TObject);
   

var
   i          : integer;
   
   SourCol    : LongInt;
   

begin
   
   with fm_Main do begin
      
      
      if not Animation then begin
         
         {сдвигаем буквы в массиве букв}
         SourCol := Players[PCurrentMov].LettersObj.Col;
         
         if DestCol>SourCol then
            
            for i:=2 to Length(AnimLetters) do
               Players[PCurrentMov].Letters[SourCol+i-1]:=AnimLetters[i]
else                                 
               for i:=2 to Length(AnimLetters) do
                  Players[PCurrentMov].Letters[DestCol+i]:=AnimLetters[i];
         
         Players[PCurrentMov].Letters[DestCol+1] := AnimLetters[1];
         
         Players[PCurrentMov].LettersObj.Repaint;
         
         
         pa1.Visible := false;
         
         pa2.Visible := false;
         
         AnimNow := false;
         
         Timer1.Enabled := false;
         
         Players[PCurrentMov].LettersObj.Col := DestCol;
         
         exit;
         
         end;
      
      
      {Создаем эффект перемещения букв двигающимися панелями}
      if AnimDir>0 then begin
         
         if (pa1.Left<AnimLeftA) and (pa1.Top>=Players[PCurrentMov].LettersObj.Top-10) 
         then
            pa1.Top := pa1.Top-2                                      {поднимаем}
         else if (pa1.Left<=AnimLeftA) or (pa1.Top>=Players[PCurrentMov].LettersObj.Top) 
         then begin
            
            if pa1.Left<=AnimLeftA then
               pa1.Left := pa1.Left+4;
            {сдвигаем}
            if pa2.Left>=AnimLeftB then
               pa2.Left := pa2.Left-2;
            
            end
         
         else
            pa1.Top := pa1.Top+2                                 {опускаем}
         end
      
      else begin
         
         if (pa1.Left>AnimLeftA) and (pa1.Top>=Players[PCurrentMov].LettersObj.Top-10) 
         then
            pa1.Top := pa1.Top-2
         else if (pa1.Left<=AnimLeftA) and (pa1.Top<=Players[PCurrentMov].LettersObj.Top)
         then
            pa1.Top := pa1.Top+2
         else begin
            
            if pa1.Left>=AnimLeftA then
               pa1.Left := pa1.Left-5;
            
            if pa2.Left<=AnimLeftB then
               pa2.Left := pa2.Left+2;
            
            end;
         
         end;
      
      SourCol := Players[PCurrentMov].LettersObj.Col;
      
      
      {Рисуем буквы на новом месте и убираем двигающиеся панели}
      if (pa1.Left*AnimDir>=AnimLeftA*AnimDir) and
         (pa2.Left*AnimDir<=AnimLeftB*AnimDir) and
         (pa1.Top>=Players[PCurrentMov].LettersObj.Top) then begin
         
         
         {сдвигаем буквы в массиве букв}
         if DestCol>SourCol then
            
            for i:=2 to Length(AnimLetters) do
               Players[PCurrentMov].Letters[SourCol+i-1]:=AnimLetters[i]
else                                 
               for i:=2 to Length(AnimLetters) do
                  Players[PCurrentMov].Letters[DestCol+i]:=AnimLetters[i];
         
         Players[PCurrentMov].Letters[DestCol+1] := AnimLetters[1];
         
         Players[PCurrentMov].LettersObj.Repaint;
         
         
         {Убираем панели}
         pa1.Visible := false;
         
         pa2.Visible := false;
         
         AnimNow := false;
         
         Timer1.Enabled := false;
         
         
         Players[PCurrentMov].LettersObj.Col := DestCol;
         
         end;
      
      
      
      end;
   {with}
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sg1DragDrop(Sender, Source: TObject; X, Y: Integer);
   

var
   i          : shortint;
   
   Cell2      : TRect;
   

begin
   
   with Sender as TDrawGrid do begin
      {Sender==Source}
      MouseToCell(x,y,DestCol,DestRow);
      
      
      if DestCol=Col then
         exit;
      
      
      if DestCol<0 then
         DestCol := 0;
      {Исключительная ситуация, когда курсор
      находится над первым пикселем (Ось Х)
      TGrid и которая вызывает ошибку,
      так как DestCol=-1 или -2             }
      PCurrentMov := Tag;
      
      
      AnimNow := true;
      
      AnimLetters := '';
      
      
      if DestCol>Col then begin
         
         for i:=Col+1 to DestCol+1 do
            AnimLetters:=AnimLetters+Players[PCurrentMov].Letters[i];
         
         for i:=Col+1 to DestCol+1 do
            Players[PCurrentMov].Letters[i]:=#0;
         
         
         AnimDir := 1;
         
         Cell2 := CellRect(Col+1,Row);
         
         Cell2.Right := CellRect(DestCol,DestRow).Right;
         
         Move2Blocks(Players[PCurrentMov].LettersObj,CellRect(Col,Row),Cell2);
         
         end
      
      else begin
         
         AnimLetters := Players[PCurrentMov].Letters[Col+1];
         
         for i:=DestCol+1 to Col do
            AnimLetters:=AnimLetters+Players[PCurrentMov].Letters[i];
         
         for i:=DestCol+1 to Col+1 do
            Players[PCurrentMov].Letters[i]:=#0;
         
         
         AnimDir := -1;
         
         Cell2 := CellRect(DestCol,Row);
         
         Cell2.Right := CellRect(Col-1,Row).Right;
         
         Move2Blocks(Players[PCurrentMov].LettersObj,CellRect(Col,Row),Cell2);
         
         end;
      
      
      end;
   {with}
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sg1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
   
begin
   
   with Sender as TStringGrid do
      BeginDrag(False);
   
   StartDragX := x;
   
   end;


{------------------------------------------------------------------------------}

procedure StartGame(Start:boolean);
   

var
   i          : integer;
   

begin
   
   for i:=1 to MaxPlayers do begin
      
      Players[i].Name.Color := clWindow;
      
      Players[i].Rec.Color := clWindow;
      
      end;
   
   
   fm_Main.stTime.Color := clBtnFace;
   
   fm_Main.stTime.Caption := '0:00:00';
   
   
   if Start then begin
      
      for i:=1 to MaxPlayers do
         Players[i].Name.Enabled:=false;
      
      fm_Main.tbHistory.Enabled := true;
      
      fm_Main.tbPlay.Caption := _M_sGStop;
      
      fm_Main.tbSaveGame.Enabled := true;
      
      fm_Main.tbSkip.Enabled := true;
      
      fm_Main.tbLang.Enabled := false;
      
      fm_Main.tbNet.Enabled := false;
      
      
      fm_Main.tbPlay.ImageIndex := 7;
      
      
      if HeadMaster='' then begin
         
         fm_Main.anComp.Visible := true;
         
         fm_Main.laNetMsg.Visible := false;
         
         Screen.Cursor := crAppStart;
         
         end
      
      else begin
         
         fm_Main.anComp.Visible := false;
         
         fm_Main.laNetMsg.Visible := true;
         
         Screen.Cursor := crDefault;
         
         end;
      
      
      fm_Main.tbSuggest.Enabled := Boolean(PCNo);
      
      
      fm_Main.sg.Enabled := true;
      
      
      for i:=1 to MaxPlayers do begin
         
         Players[i].Name.Color := clWindow;
         
         Players[i].Rec.Color := clWindow;
         
         Players[i].Name.Enabled := false;
         
         Players[i].LettersObj.Enabled := true;
         
         if not Players[i].Name.Visible then
            Players[i].Button.Enabled := false;
         
         end;
      
      Players[PCurrent].Name.Color := myActiveP;
      
      Players[PCurrent].Rec.Color := myActiveP;
      
      
      if TimeLimit>0 then
         fm_Main.tmGame.Enabled := true;
      
      UserTime := 0;
      
      end
   
   
   else begin
      {----------------------------------------------------------------}
      for i:=1 to MaxPlayers do begin
         
         Players[i].Name.Enabled := true;
         
         Players[i].Button.Enabled := true;
         
         Players[i].LettersObj.Enabled := false;
         
         end;
      
      GameState := gsNoGame;
      
      fm_Main.sg.Enabled := false;
      
      
      fm_Main.tbHistory.Enabled := false;
      
      fm_Main.tbPlay.Caption := _M_sGPlay;
      
      fm_Main.tbSaveGame.Enabled := false;
      
      fm_Main.tbSkip.Enabled := false;
      
      fm_Main.tbSuggest.Enabled := false;
      
      fm_Main.tbLang.Enabled := true;
      
      fm_Main.tbNet.Enabled := true;
      
      
      fm_Main.tbPlay.ImageIndex := 0;
      
      
      if TimeLimit>0 then
         fm_Main.tmGame.Enabled := false;
      
      
      fm_Main.anComp.Visible := false;
      
      fm_Main.laNetMsg.Visible := false;
      
      Screen.Cursor := crDefault;
      
      
      end;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbPlayClick(Sender: TObject);
   

var
   i,j,k,p          : byte;
   

begin
   
   if GameState=gsNoGame then begin
      {--------------------------------Начать игру}
      
      {Проверка ниличия имен игроков}
      for i:=1 to MaxPlayers do
         
         if (Players[i].Name.Text='') and (Players[i].Name.Visible) then begin
            
            MessageDlg(_M_mPEnter, mtError, [mbOk], 0);
            
            exit;
            
            end;
      
      
      {Проверка уникальности имен игроков}
      for i:=1 to MaxPlayers do
         
         for j:=i+1 to MaxPlayers do
            
            if (Trim(Players[i].Name.Text)=Trim(Players[j].Name.Text)) and
               (Players[i].Name.Visible) then begin
               
               MessageDlg(_M_mPUNames, mtError, [mbOk], 0);
               
               exit;
               
               end;
      
      
      {Если среди игроков есть "Компьютер", то запомнить его номер}
      for i:=1 to MaxPlayers do
         
         if (Trim(Players[i].Name.Text)=_M_sPPCName) and
            (Players[i].Name.Visible) then
            
            PCNo := i;
      
      
      {Выдача новых произвольных букв}
      for i:=1 to MaxPlayers do
         
         for j:=1 to MaxLetters do
            Players[i].Letters[j]:=RandomLetter;
      
      
      for i:=1 to MaxPlayers do
         if Players[i].Name.Text='' then
            Players[i].Button.Enabled := false;
      
      for i:=1 to MaxPlayers do
         Players[i].Name.Enabled:=false;
      
      
      {Очистка поля, завершающие стадии перед началом игры}
      GameState := gsJustStarted;
      
      StartGame(true);
      
      
      if Trim(Players[PCurrent].Name.Text)=_M_sPPCName then
         ComputerStep;
      
      end
   
   
   else begin
      {---------------------------------------------------{Окончить игру}
      tmGame.Enabled := false;
      
      if TimeLimit>0 then
         fm_Main.Visible := false;
      
      if GameState=gsGame then
         
         if MessageBox(0,PChar(_M_mGIsStop),
                       PChar(Application.Title),
                       MB_YESNO or MB_TASKMODAL or
                       MB_ICONWARNING or MB_DEFBUTTON2)=IDNO then begin
            
            tmGame.Enabled := Boolean(TimeLimit);
            
            fm_Main.Visible := true;
            
            EXIT;
            
            end;
      
      fm_Main.Visible := true;
      
      
      for i:=1 to MaxPlayers do
         Players[i].Button.Enabled:=true;
      
      for i:=1 to MaxPlayers do
         
         for j:=1 to MaxLetters do
            Players[i].Letters[j]:=#0;
      
      
      {Ввод результата игры в таблицу лидеров------------------------------------}
      j := 0;
      
      k := 1;
      
      for i:=1 to MaxPlayers do
         
         if StrToInt(Players[i].Rec.Caption)>j then begin
            
            j := StrToInt(Players[i].Rec.Caption);
            
            k := i;
            
            end;
      
      
      p := 10;
      
      for i:=0 to 9 do
         if j>StrToIntDef(TopNames[i].Points,0) then begin
            
            p := i;
            
            break;
            
            end;
      
      
      if p<10 then begin
         
         for i:=9 downto p+1 do begin
            
            TopNames[i].Name := TopNames[i-1].Name;
            
            TopNames[i].Points := TopNames[i-1].Points;
            
            TopNames[i].CoolWord := TopNames[i-1].CoolWord;
            
            end;
         
         
         TopNames[p].Name := Players[k].Name.Text;
         
         TopNames[p].Points := intToStr(j);
         
         
         fm_Top.edName.Caption := Players[k].Name.Text+':';
         
         fm_Top.edPoints.Caption := intToStr(j);
         
         
         TopAction := taShow;
         
         fm_Top.Tag := p;
         
         
         {Если Выиграл компьютер, то ввести фразу автоматически}
         if Trim(Players[k].Name.Text)=_M_sPPCName then
            fm_Top.Timer2.Tag := 1
         else
            fm_Top.Timer2.Tag := 0;
         
         fm_Top.ShowModal;
         
         end;
      
      
      
      {Блокировка поля, завершающие стадии после игры}
      ClearField;
      
      StartGame(false);
      
      end;
   
   
   RepaintAll;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbExitClick(Sender: TObject);
   
begin
   
   fm_Main.Close;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbSkipClick(Sender: TObject);
   
begin
   
   fm_Skip.sb1.Caption := AnsiUpperCase(Players[PCurrent].Letters[1]);
   
   fm_Skip.sb2.Caption := AnsiUpperCase(Players[PCurrent].Letters[2]);
   
   fm_Skip.sb3.Caption := AnsiUpperCase(Players[PCurrent].Letters[3]);
   
   fm_Skip.sb4.Caption := AnsiUpperCase(Players[PCurrent].Letters[4]);
   
   fm_Skip.sb5.Caption := AnsiUpperCase(Players[PCurrent].Letters[5]);
   
   fm_Skip.sb6.Caption := AnsiUpperCase(Players[PCurrent].Letters[6]);
   
   fm_Skip.sb7.Caption := AnsiUpperCase(Players[PCurrent].Letters[7]);
   
   
   fm_Skip.ShowModal;
   
   end;


{------------------------------------------------------------------------------}
{Проверка соприкосновения слова по правилу морского боя}

function SeaCheck;
   
begin
   
   Result := false;
   
   
   if (SRow>0) and DirHor and                       {Проверка сверху}
      (Field[SCol,SRow-1].Letter<>' ') then
      exit;
   
   
   if (SRow<14) and DirHor and                      {Проверка снизу}
      (Field[SCol,SRow+1].Letter<>' ') then
      exit;
   
   
   if (SCol>0) and not DirHor and                   {Проверка слева}
      (Field[SCol-1,SRow].Letter<>' ') then
      exit;
   
   
   if (SCol<14) and not DirHor and                  {Проверка справа}
      (Field[SCol+1,SRow].Letter<>' ') then
      exit;
   
   
   Result := true;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_Main.ShowSuggestion;
   
begin
   
   fm_Main.CoolBar1.Enabled := true;
   
   
   SearchBestWord;
   
   
   fm_Main.anComp.Active := false;
   
   Screen.Cursor := crDefault;
   
   {Компьютер подумал!}
   
   if (UserSkip) or (sWord='') then begin
      
      MessageDlg(_M_mINoWord, mtInformation, [mbOk], 0);
      
      exit;
      
      end;
   
   
   fm_Suggest.ShowModal;
   
   
   {Переход хода}
   if not Suggested then
      NextPlayer;
   
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.btSuggestClick(Sender: TObject);
   
begin
   
   if MessageBox(0,PChar(Format(_M_mHIsNeed,
                        [SuggestionValue, Ending(SuggestionValue)])),
                 PChar(Application.Title),
                 MB_YESNO or MB_TASKMODAL or
                 MB_ICONWARNING or MB_DEFBUTTON2)<>IDYES then
      EXIT;
   
   
   RepaintAll;
   
   Suggested := true;
   
   
   {Компьютер думает ...}
   fm_Main.anComp.Active := true;
   
   Screen.Cursor := crAppStart;
   
   
   if GameState=gsGame then
      SearchPatterns
   else
      SearchPatternsFirst;
   
   
   FindMultiPatterns;
   
   
   with TGetListOfWords.Create do
      
OnTerminate                 :=ShowSuggestion;
   
   end;



{------------------------------------------------------------------------------}

procedure Tfm_main.btDicClick(Sender: TObject);
   
begin
   
   fm_DMan.ShowModal;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbAboutClick(Sender: TObject);
   
begin
   
   _iWindowExStyle := GetWindowLong(fm_main.Handle, GWL_EXSTYLE);
   
   fm_About.FormRaise := true;
   
   fm_About.TranspValue := 0;
   
   fm_About.tmAppearance.Enabled := true;
   
   fm_About.ShowModal;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbHistoryClick(Sender: TObject);
   
begin
   
   fm_PMoves.ShowModal;
   
   end;


{------------------------------------------------------------------------------}

function FormatS(str:string; len:integer): string;
   
begin
   
   if len>10 then
      Result := str + StringOfChar(' ',len-length(str))
   else
      Result := StringOfChar(' ',len-length(str)) + str;
   
   
   if length(Result)>len then
      Result := Copy(Result,1,len);
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbSaveGameClick(Sender: TObject);
   

var
   i,j          : integer;
   
   GameFile   : TIniFile;
   
   s,sl         : string[30];
   

begin
   
   if Sender = fm_Main then
      
      if GameState=gsGame then
         
         sd.FileName := ExtractFilePath(Application.ExeName)+'Autosave.eru'
   else begin
      
      DeleteFile(ExtractFilePath(Application.ExeName)+'Autosave.eru');
      
      exit;
      
      end
   
   
   else begin
      
      sd.FileName := '';
      
      for i:=1 to MaxPlayers do
         
         if Players[i].Name.Visible then
            
            sd.FileName := sd.FileName + '-'  + Copy(Players[i].Name.Text,1,4);
      
      
      sd.FileName := Copy(sd.FileName,2,length(sd.FileName)-1);
      
      if not sd.Execute then
         exit;
      
      end;
   
   
   GameFile := TIniFile.Create(sd.FileName);
   
   with GameFile do begin
      
      WriteString('Common','ID',_ProductID);
      
      WriteString('Common','Version',_ProductVersion);
      
      
      case CurrentLanguage of
      
      lgENU:
         WriteString('Common','Language','English');
      
      lgDEU:
         WriteString('Common','Language','Deutsch');
      
      lgRUS:
         WriteString('Common','Language','Russian');
      
      end;
      
      
      for j:=0 to MaxWordLength-1 do begin
         
         s := '';
         
         for i:=0 to MaxWordLength-1 do
            if Field[i,j].Letter=' ' then
               s := s + '.'
            else
               s := s + Field[i,j].Letter;
         
         WriteString('Field current', 'Line'+FormatFloat('00',j), s);
         
         end;
      
      
      for j:=0 to MaxWordLength-1 do begin
         
         s := '';
         
         for i:=0 to MaxWordLength-1 do
            if Field2[i,j].Letter=' ' then
               s := s + '.'
            else
               s := s + Field2[i,j].Letter;
         
         WriteString('Field previous', 'Line'+FormatFloat('00',j), s);
         
         end;
      
      
      for j:=1 to MaxPlayers do
         
         if Players[j].Name.Visible then begin
            
            s := 'Player'+FormatFloat('0',j);
            
            WriteString(s, 'Name', Players[j].Name.Text);
            
            sl := '';
            
            for i:=1 to MaxLetters do
               sl:=sl + Players[j].Letters[i];
            
            WriteString (s, 'Letters current', sl);
            
            sl := '';
            
            for i:=1 to MaxLetters do
               sl:=sl + Players2[j].Letters[i];
            
            WriteString (s, 'Letters previous', sl);
            
            WriteString (s, 'Points', Players[j].Rec.Caption);
            
            WriteInteger(s, 'Face', Players[j].Button.Spacing);
            
            end;
      
      
      if GameState=gsGame then
         WriteString('Common', 'Game status', 'Game')
      else
         WriteString('Common', 'Game status', 'Just Started');
      
      WriteInteger('Common', 'Current Player', PCurrent);
      
      WriteInteger('Common', 'PC Player No', PCNo);
      
      WriteBool   ('Common', 'Suggested', Suggested);
      
      
      WriteInteger('History','Turns count',PlayerMoves);
      
      for i:=1 to PlayerMoves do begin
         
         WriteString('History','Turn'+FormatFloat('000',i),
         FormatS(PlayerMove[i].PlayerName,20) +
         FormatS(PlayerMove[i].Word,MaxWordLength + 15) +
         FormatS(PlayerMove[i].UsedLetters,20) +
         FormatS(PlayerMove[i].ReceivedLetters,20) +
         FormatS(IntToStr(PlayerMove[i].Points),3) +
         FormatS(IntToStr(PlayerMove[i].Total),3) +
         IntToStr(Integer(PlayerMove[i].DirHor)) +
         FormatS(IntToStr(PlayerMove[i].Pos.x),2) +
         FormatS(IntToStr(PlayerMove[i].Pos.y),2)
         );
         
         end;
      
      
      Free;
      
      end;
   {with}
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbLoadGameClick(Sender: TObject);
   

var
   i,j          : integer;
   
   GameFile   : TIniFile;
   
   s, sl         : string;
   
   ch         : char;
   

begin
   
   if FileName <> '' then
      
      if FileExists(FileName) then
         od.FileName := FileName
   else
      exit
   else begin
      
      {Если игра в процессе - предупредить}
      if (GameState=gsGame) and
         (MessageBox(0,PChar(_M_mGIsStop),
                  PChar(Application.Title),
                  MB_YESNO or MB_TASKMODAL or
                  MB_ICONQUESTION or MB_DEFBUTTON2)=IDNO) then
         EXIT;
      
      
      od.FileName := FileName;
      
      if not od.Execute then
         exit;
      
      end;
   
   
   {------------------------------------------------------------------------------}
   ClearField;
   
   
   GameFile := TIniFile.Create(od.FileName);
   
   with GameFile do begin
      
      if ReadString('Common','ID','')<>_ProductID then begin
         
         MessageDlg('This is not an Erudit savegame file.', mtError, [mbOk], 0);
         
         exit;
         
         end;
      
      
      //    ReadString('Common','Version',_ProductVersion);
      
      
      ch := ReadString('Common','Language','English')[1];
      
      case ch of
      
      'D':
         if CurrentLanguage<>lgDEU then
            SetLangClick(Deutsch);
      
      'R':
         if CurrentLanguage<>lgRUS then
            SetLangClick(Russian);
      
      else if CurrentLanguage<>lgENU then
         SetLangClick(English);
      
      end;
      
      
      
      {Чтение содержимого поля}
      for j:=0 to MaxWordLength-1 do begin
         
         s := ReadString('Field current', 'Line'+FormatFloat('00',j), StringOfChar('.',
         MaxWordLength));
         
         for i:=0 to MaxWordLength-1 do begin
            
            if s[i+1]='.' then
               Field[i,j].Letter := ' '
            else
               Field[i,j].Letter := s[i+1];
            
            if s[i+1]='.' then
               Field[i,j].Weight := 0
            else
               Field[i,j].Weight := LWeight(Field[i,j].Letter);
            
            end;
         
         end;
      
      
      {Чтение содержимого поля ход назад}
      for j:=0 to MaxWordLength-1 do begin
         
         s := ReadString('Field previous', 'Line'+FormatFloat('00',j), StringOfChar('.',
         MaxWordLength));
         
         for i:=0 to MaxWordLength-1 do begin
            
            if s[i+1]='.' then
               Field2[i,j].Letter := ' '
            else
               Field2[i,j].Letter := s[i+1];
            
            if s[i+1]='.' then
               Field2[i,j].Weight := 0
            else
               Field2[i,j].Weight := LWeight(Field2[i,j].Letter);
            
            end;
         
         end;
      
      
      {Чтение содержимого массива игроков}
      for j:=1 to MaxPlayers do begin
         
         s := 'Player'+FormatFloat('0',j);
         
         if ReadString(s, 'Name', '')<>'' then begin
            
            Players[j].Name.Text := ReadString(s, 'Name', '');
            
            
            sl := GameFile.ReadString (s, 'Letters current', StringOfChar('*',MaxLetters))
            ;
            
            if length(sl)<MaxLetters then
               sl := StringOfChar('*',MaxLetters);
            
            for i:=1 to MaxLetters do
               Players[j].Letters[i]:=sl[i];
            
            sl := ReadString (s, 'Letters previous', StringOfChar('*',MaxLetters));
            
            if length(sl)<MaxLetters then
               sl := StringOfChar('*',MaxLetters);
            
            for i:=1 to MaxLetters do
               Players2[j].Letters[i]:=sl[i];
            
            Players[j].Rec.Caption := ReadString (s, 'Points', '0');
            
            Players[j].Button.Spacing := ReadInteger(s, 'Face', 0);
            
            Players[j].Name.Visible := true;
            
            end;
         
         end;
      
      
      {Чтение главных глобальных переменных игры}
      s := ReadString('Common', 'Game status', 'Game');
      
      if s='Game' then
         GameState := gsGame
      else
         GameState := gsJustStarted;
      
      PCurrent := ReadInteger('Common', 'Current Player', 1);
      
      PCNo := ReadInteger('Common', 'PC Player No', 1);
      
      Suggested := ReadBool('Common', 'Suggested', false);
      
      
      {Чтение архива ходов}
      PlayerMoves := ReadInteger('History','Turns count',0);
      
      for i:=1 to PlayerMoves do begin
         
         s := ReadString('History','Turn'+FormatFloat('000',i),StringOfChar(' ',100));
         
         j := 0;
         
         PlayerMove[i].PlayerName :=      Copy(s, j+1, 20);
         j := j + 20;
         
         PlayerMove[i].Word :=            Copy(s, j+1, MaxWordLength + 15);
         j := j + MaxWordLength + 15;
         
         PlayerMove[i].UsedLetters :=     Copy(s, j+1, 20);
         j := j + 20;
         
         PlayerMove[i].ReceivedLetters := Copy(s, j+1, 20);
         j := j + 20;
         
         PlayerMove[i].Points := StrToInt(Copy(s, j+1, 3));
         j := j + 3;
         
         PlayerMove[i].Total :=  StrToInt(Copy(s, j+1, 3));
         j := j + 3;
         
         PlayerMove[i].DirHor :=         (Copy(s, j+1, 1)='1');
         j := j + 1;
         
         PlayerMove[i].Pos.x :=  StrToInt(Copy(s, j+1, 2));
         j := j + 2;
         
         PlayerMove[i].Pos.y :=  StrToInt(Copy(s, j+1, 2));
         
         end;
      
      
      Free;
      
      end;
   {with}
   
   {----------------------------------------------------------------------------}
   {Показываем текущих игроков}
   for i:=1 to MaxPlayers do
      
      if Players[i].Name.Visible then begin
         
         Players[i].Rec.Visible := true;
         
         Players[i].LettersObj.Visible := true;
         
         Players[i].Button.Visible := true;
         
         end
      
      else begin
         
         Players[i].Rec.Visible := false;
         
         Players[i].LettersObj.Visible := false;
         
         end;
   
   
   {... и их лица...}
   for i:=1 to MaxPlayers do
      
      if Players[i].Name.Text=_M_sPPCName then begin
         
         Players[i].Button.Glyph.Canvas.Draw(0,0,Players[i].Button.Glyph);
         
         ilPlayers.GetBitmap(ilPlayers.Count-1,Players[i].Button.Glyph)
         end
      
      else if Players[i].Button.Spacing<>0 then begin
         
         Players[i].Button.Glyph.Canvas.Draw(0,0,Players[i].Button.Glyph);
         
         ilPlayers.GetBitmap(Players[i].Button.Spacing,Players[i].Button.Glyph);
         
         FacesUsed[Players[i].Button.Spacing] := true;
         
         end;
   
   
   StartGame(true);
   
   tbBack.Enabled := true;
   
   EMessage := '';
   
   Caption := 'Erudite: '+od.FileName;
   
   
   RepaintAll;
   
   
   if Trim(Players[PCurrent].Name.Text)=_M_sPPCName then
      ComputerStep;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbHelpClick(Sender: TObject);
   
begin
   
   case CurrentLanguage of
   
   lgENU:
      ExecuteFile(ExtractFilePath(Application.EXEName) + 'help\help_e.htm','','');
   
   lgDEU:
      ExecuteFile(ExtractFilePath(Application.EXEName) + 'help\help_d.htm','','');
   
   lgRUS:
      ExecuteFile(ExtractFilePath(Application.EXEName) + 'help\help_r.htm','','');
   
   end;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbSetupClick(Sender: TObject);
   
begin
   
   fm_Setup.ShowModal;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.cb2Change(Sender: TObject);
   
begin
   
   with Sender as TComponent do begin
      
      if ShowTips then begin
         
         Players[(Sender as TComponent).Tag].LettersObj.Hint := Format(_M_hPLetters, [
         Players[Tag].Name.Text]);
         
         Players[Tag].Rec.Hint       := Format(_M_hPPoints,  [Players[Tag].Name.Text]);
         
         end;
      
      
      {Добавить компьютер}
      if (PCNo=0) and (Trim(Players[Tag].Name.Text)=_M_sPPCName) then begin
         
         Players[Tag].Button.Glyph.Canvas.Draw(0,0,Players[Tag].Button.Glyph);
         
         ilPlayers.GetBitmap(ilPlayers.Count-1,Players[Tag].Button.Glyph);
         
         end;
      
      
      {Убрать компьютер}
      if {(PCNo=1) or} (Players[Tag].Name.Text<>_M_sPPCName) then begin
         
         Players[Tag].Button.Glyph.Canvas.Draw(0,0,Players[Tag].Button.Glyph);
         
         ilPlayers.GetBitmap(Players[Tag].Button.Spacing,Players[Tag].Button.Glyph);
         
         end;
      
      end;
   
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbLangClick(Sender: TObject);
   
begin
   
   pmLang.Popup(Application.MainForm.Left + 0 , Application.MainForm.Top + 46)
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tmGameTimer(Sender: TObject);
   
begin
   
   UserTime := UserTime + tmGame.Interval/1000;
   
   stTime.Caption := TimeToStr(UserTime / (24 * 60 * 60));
   
   
   if UserTime > TimeLimit then begin
      
      tmGame.Enabled := false;
      
      stTime.Color := clRed;
      
      
      if fm_Skip.Active then
         fm_Skip.Close;
      
      if fm_About.Active then
         fm_About.Close;
      
      if fm_DMan.Active then
         fm_DMan.Close;
      
      if fm_PMoves.Active then
         fm_PMoves.Close;
      
      if fm_Setup.Active then
         fm_Setup.Close;
      
      if fm_Suggest.Active then
         fm_Suggest.Close;
      
      if fm_Top.Active then
         fm_Top.Close;
      
      
      if fm_Word.Active then begin
         
         EMessage := 'Timeout';
         {Must be non empty!}
         fm_Word.Close;
         
         end
      
      else begin
         
         MessageBox(0,PChar(_M_mTimeOut),
         PChar(Application.Title),
         MB_OK or MB_TASKMODAL or
         MB_ICONINFORMATION or MB_DEFBUTTON1);
         
         sWord := '';
         
         UserSkip := true;
         
         NextPlayer;
         
         end;
      
      end;
   
   end;


(*
procedure Test;
const
wid:byte=64;
deep:byte=16;

var i,j :integer;
pAND, PXOR:pointer;
icon:HIcon;
a1,b1: array[1..64*64*2] of byte;
hdc1:HDC;
siz:integer;
begin
{-DEBUG TEST--------------------------------------------------------------------}
{Выдача новых произвольных букв}
for i:=1 to MaxPlayers do
   for j:=1 to MaxLetters do
      Players[i].Letters[j]:=RandomLetter;

for i:=1 to MaxPlayers do
   if Players[i].Name.Text='' then
      Players[i].Button.Enabled := false;

for i:=1 to MaxPlayers do
   Players[i].Name.Enabled:=false;

RepaintAll;


siz := Integer(Trunc(wid*wid/8*deep));

for i:=1 to siz do begin
   
   a1[i] := i;
   
   b1[i] := i mod 1;
   
   end;


//  Screen.Cursors[1] := CreateCursor(HInstance,2,2,wid,wid,@a1, @b1);

//  Screen.Cursors[1] := CreateIcon(HInstance,wid,wid,1,16,@a1, @b1);

fm_Main.sg.Cursor := crHandPoint;

fm_Main.sg.Enabled := true;

end;

*)
{------------------------------------------------------------------------------}

procedure Tfm_main.FormActivate(Sender: TObject);
   

var
   
   i          : integer;
   

begin
   
   { Load Cofiguration from file -------------------------------------------------}
   LoadConfig;
   
   
   case CurrentLanguage of
   
   lgENU:
      DefineConstantsENU;
   
   lgDEU:
      DefineConstantsDEU;
   
   lgRUS:
      DefineConstantsRUS;
   
   end;
   
   
   LoadConstants;
   
   
   cb1.Text := cb1.Items[0];
   
   {Set correct Computer icon}
   for i:=1 to 2 do
      cb2Change(Players[i].Name);
   
   
   if ParamStr(1)<>'' then begin
      
      FileName := ParamStr(1);
      
      tbLoadGameClick(Sender)
      end
   
   else if AutoLoad then begin
      
      FileName := ExtractFilePath(Application.ExeName)+'Autosave.eru';
      
      tbLoadGameClick(Sender);
      
      end;
   
   FileName := '';
   
   od.InitialDir := ExtractFilePath(Application.ExeName);
   
   sd.InitialDir := ExtractFilePath(Application.ExeName);
   
   
   if ToolBar1.Top<>0 then
      CoolBar1.Height := CoolBar1.Height - 1;
   
   
   LoadDictionary(lgNone);
   
   end;


{------------------------------------------------------------------------------}

procedure LoadDictionary(OldLang:TLanguage);
   

var
   s          : string;
   

begin
   
   case OldLang of
   
   lgENU:
      SaveDic('DATA\WordsENU.txt');
   
   lgDEU:
      SaveDic('DATA\WordsDEU.txt');
   
   lgRUS:
      SaveDic('DATA\WordsRUS.txt');
   
   end;
   
   
   ActivateControls(false);
   
   fm_DMan.lbActive.Items.Clear;
   
   fm_DMan.lbDraft.Items.Clear;
   
   
   {Write-----------------------------------------------------------------}
   case CurrentLanguage of
   
   lgENU:
      FileOpenX(CurrDir+'DATA\WordsENU.txt',foReadOnly);
   
   lgDEU:
      FileOpenX(CurrDir+'DATA\WordsDEU.txt',foReadOnly);
   
   lgRUS:
      FileOpenX(CurrDir+'DATA\WordsRUS.txt',foReadOnly);
   
   end;
   
   if EMessage<>'' then begin
      
      fm_Main.Cursor := crDefault;
      
      MessageDlg(EMessage, mtError, [mbOk], 0);
      
      //      exit
      end
   
   else begin
      
      while not eof(f1) do begin
         
         Readln(f1,s);
         
         fm_DMan.lbActive.Items.Add(s);
         
         end;
      {while}
      
      CloseFile(f1);
      
      end;
   
   
   ActivateControls(true);
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.SetLangClick(Sender: TObject);
   

var
   OldLang    : TLanguage;
   
   OldPCName  : string;
   
   i          : integer;
   

begin
   
   with Sender as TComponent do
      
case                      Tag of
0                       : if CurrentLanguage=lgENU then
         exit;
   
   1: if CurrentLanguage=lgDEU then
         exit;
   
   2: if CurrentLanguage=lgRUS then
         exit;
   
   end;


fm_Main.Cursor := crHourGlass;

OldLang := CurrentLanguage;

OldPCName := _M_sPPCName;


with Sender as TComponent do begin
   
   case Tag of
   
   0:
      DefineConstantsENU;
   
   1:
      DefineConstantsDEU;
   
   2:
      DefineConstantsRUS;
   
   end;
   
   end;


LoadConstants;

LoadDictionary(OldLang);

for i:=1 to MaxPlayers do
   
   if Players[i].Name.Text=OldPCName then
      Players[i].Name.Text := _M_sPPCName;

fm_Main.Cursor := crDefault;

end;



{------------------------------------------------------------------------------}

procedure Tfm_main.FormClose(Sender: TObject; var Action: TCloseAction);
   

var
   i,j,k          : integer;
   
   p          : array[0..9] of string;
   
   Exist      : boolean;
   
   IniFile    : TIniFile;
   

begin
   
   
   {if file is ReadOnly (CD Start) then ignore}
   if  (FileExists(ExtractFilePath(Application.ExeName)+'Erudite.ini')) and
      ((FileGetAttr(ExtractFilePath(Application.ExeName)+'Erudite.ini') and SysUtils.
   faReadOnly) <> 0) then
      exit;
   
   
   {Сохраяенм словарь}
   case CurrentLanguage of
   
   lgENU:
      SaveDic('DATA\WordsENU.txt');
   
   lgDEU:
      SaveDic('DATA\WordsDEU.txt');
   
   lgRUS:
      SaveDic('DATA\WordsRUS.txt');
   
   end;
   
   
   {Сохраяенм текущие настройки игры}
   IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Erudite.ini');
   
   with IniFile do begin
      
      WriteString('Setup','ID','Configuration file for The Erudite');
      
      
      case CurrentLanguage of
      
      lgENU:
         WriteString('Setup','Language','English');
      
      lgDEU:
         WriteString('Setup','Language','Deutsch');
      
      lgRUS:
         WriteString('Setup','Language','Russian');
      
      end;
      
      
      WriteBool('Setup','ShowTips',ShowTips);
      
      WriteBool('Setup','Animation',Animation);
      
      WriteInteger('Setup','Time Limit',TimeLimit);
      
      WriteBool('Setup','AutoSave',AutoSave);
      
      WriteBool('Setup','AutoLoad',AutoLoad);
      
      
      WriteInteger('Setup','Difficulty',Difficulty);
      
      
      {Сохраняем список активных игроков}
      k := -1;
      
      for i:=1 to MaxPlayers do
         
         if (Players[i].Name.Visible) and
            (Trim(Players[i].Name.Text)<>'') and
            (Trim(Players[i].Name.Text)<>UserName) and
            (Trim(Players[i].Name.Text)<>_M_sPPCName) then begin
            
            inc(k);
            
            p[k] := Trim(Players[i].Name.Text);
            
            end;
      
      
      for i:=0 to cb1.Items.Count-1 do begin
         
         Exist := false;
         
         for j:=0 to k do
            if (Trim(cb1.Items[i])=p[j]) then
               Exist := true;
         
         
         if (Trim(cb1.Items[i])<>_M_sPPCName) and
            (Trim(cb1.Items[i])<>UserName) and
            (not Exist) then begin
            
            inc(k);
            
            p[k] := Trim(cb1.Items[i]);
            
            end;
         
         if k=10 then begin
            
            k := 9;
            
            break;
            
            end;
         
         end;
      
      
      for i:=0   to k do
         WriteString('Players','Player'+FormatFloat('0',i),p[i]);
      
      for i:=k+1 to 9 do
         DeleteKey('Players','Player'+FormatFloat('0',i));
      
      
      {10ка лучших игроков}
      for i:=0 to 9 do
         
         if TopNames[i].Name<>'' then begin
            
            WriteString('Top 10','Name'+FormatFloat('0',i),FormatS(TopNames[i].Name,20) +
            FormatS(TopNames[i].Points,5) +
            TopNames[i].CoolWord);
            
            end;
      
      
      Free;
      
      end;
   {with}
   
   {Если AUTOSAVE то сохраняем и саму игру}
   if AutoSave then
      tbSaveGameClick(fm_Main);
   
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.btTopMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
   
begin
   
   btTop.Font.Color :=  (Round(230*sin(x/60))+20)*256*256
                      + (Round(230*cos(x/120))+20)*256
                      + (Round(230*sin(y/15))+20);
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.btTopMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
   
begin
   
   btTop.Font.Color := clYellow
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.btTopClick(Sender: TObject);
   
begin
   
   fm_Top.ShowModal
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.sb12Click(Sender: TObject);
   

var
   i,j          : byte;
   

begin
   
   
   if GameState<>gsNoGame then
      EXIT;
   
   
   {-------------------------------------------------------}
   i := 0;
   
   repeat
      inc(i)
   until Players[i].Button=Sender;
   
   
   repeat
      j := Random(FacesCount)+1
   Until not FacesUsed[j];
   
   Players[i].Button.Glyph.Canvas.Draw(5,5,Players[i].Button.Glyph);
   
   ilPlayers.GetBitmap(j,Players[i].Button.Glyph);
   
   FacesUsed[j] := true;
   
   
   FacesUsed[Players[i].Button.Spacing] := false;
   
   Players[i].Button.Spacing := j;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.cb1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
   
   //

var
   imWidth    : integer;
   

begin
   
   (*
   imWidth:=imNet.Width;
   
   with Control as TComboBox do begin
   if odSelected in State then
   Canvas.Font.Color:=clHighlightText
   else begin
   Canvas.Font.Color:=clWindowText;
   end;
   
   Canvas.TextRect(Rect, Rect.Left+imWidth+5, Rect.Top-2, cb1.Items[Index]);
   
   Canvas.CopyMode:=cmSrcCopy;

Canvas.CopyRect(Classes.Rect(2,Rect.Top,imWidth+2,Rect.Top+imWidth), imNet.Canvas, Classes.Rect(0,0,imWidth,imWidth));
   end
   *)
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.cbDropDown(Sender: TObject);
   
begin
   
   SendMessage((Sender as TComboBox).Handle, CB_SETDROPPEDWIDTH, 350, 0)
   end;


{------------------------------------------------------------------------------}

procedure Tfm_main.tbNetClick(Sender: TObject);
   
begin
   
   fm_Net.ShowModal;
   
   end;


{------------------------------------------------------------------------------}

procedure Tfm_Main.FormDestroy(Sender: TObject);
   
begin
   
   FontErase;
   
   end;


{------------------------------------------------------------------------------}

procedure SetOpacity(hwnd: THandle; Value:integer);
   
begin
   
   if @SetLayeredWindowAttributes <> nil then begin
      
      SetWindowLong(hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) or WS_EX_LAYERED);
      
      SetLayeredWindowAttributes(hwnd, 0, Value, LWA_ALPHA)
      end;
   
   end;


{------------------------------------------------------------------------------}

procedure LoadJPEGfromEXE;
   

var
   
   MyJPG      : TJPEGImage;
   
   ResStream  : TResourceStream;
   

begin
   
   try
   try
   MyJPG := TJPEGImage.Create;
   
   ResStream := TResourceStream.Create(HInstance, 'JPG_SPLASH', Pchar('RSDATA'));
   
   MyJPG.LoadFromStream(ResStream);
   
   
   fm_Main.Image1.Picture.Graphic := myJPG;
   
   fm_Main.Image2.Picture.Graphic := myJPG;
   
   fm_Main.Image3.Picture.Graphic := myJPG;
   
   fm_Main.CoolBar1.Bitmap.Assign(myJPG);
   
   finally
   MyJPG.Free;
   
   ResStream.Free;
   
   end;

except;

fm_Main.Caption := fm_Main.Caption+': Exception: Resource JPG not loaded';

end;

end;


{------------------------------------------------------------------------------}

procedure Tfm_Main.LoadAVIfromEXE;
   
begin
   
   {if come error 'cannot open AVI' try to reload Delphi}
   try
   fm_Main.anComp.ResHandle := 0;
   //HInstance;
   
   fm_Main.anComp.ResName  := 'AVI_FINDPC';
   
   fm_Main.anComp.Active := true;
   
   except;
   
   Caption := Caption+': Exception: Resource AVI not loaded';
   
   end;

end;


{------------------------------------------------------------------------------}

procedure Tfm_Main.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
   
begin
   
   if Key=112 then
      tbHelpClick(Self)
   end;


{------------------------------------------------------------------------------}

procedure Tfm_Main.RegisterExtension(Ext:string; DoRegister:boolean);
   

var
   
   Reg        : TRegistry;
   
   ExeName    : string;
   

begin
   
   Reg := TRegistry.Create;
   
   ExeName := ExtractFileName(Application.ExeName);
   
   
   try
   Reg.RootKey := HKEY_CLASSES_ROOT;
   
   if Reg.OpenKey    (Ext, true) then
      
      if DoRegister then
         
         Reg.WriteString('','The Erudite')
   else
      
      Reg.DeleteValue('');
   
   Reg.CloseKey;
   
   
   if Reg.OpenKey    ('The Erudite', true) then
      
      Reg.WriteString('','The Erudite file');
   
   Reg.CloseKey;
   
   
   if Reg.OpenKey    ('The Erudite\DefaultIcon', true) then
      
      Reg.WriteString('',Application.ExeName+',0');
   
   Reg.CloseKey;
   
   
   if Reg.OpenKey    ('The Erudite\shell\open\Command', true) then
      
      Reg.WriteString('','"'+Application.ExeName+'" "%1"');
   
   Reg.CloseKey;
   
   
   if Reg.OpenKey    ('Applications\'+ExeName+'\shell', true) then
      
      Reg.WriteString('','open');
   
   Reg.CloseKey;
   
   
   if Reg.OpenKey    ('Applications\'+ExeName+'\shell\open\Command', true) then
      
      Reg.WriteString('','"'+Application.ExeName+'" "%1"');
   
   Reg.CloseKey;
   
   
   Reg.RootKey := HKEY_CURRENT_USER;
   
   if DoRegister then begin
      
      if Reg.OpenKey    ('Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\'+
      Ext, true) then
         
         Reg.WriteString('Application',ExeName)
      end
   
   else
      
      Reg.DeleteKey('Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\'+Ext);
   
   Reg.CloseKey;
   
   
   finally
   Reg.CloseKey;
   
   end;


Reg.Free;

end;


{------------------------------------------------------------------------------}

procedure Tfm_Main.laPlayersClick(Sender: TObject);
   

var
   
   i          : integer;
   
   mi         : TMenuItem;
   

begin
   
   pmPlayers.Items.Clear;
   
   ilPlayers.BkColor := clNone;
   
   
   for i:=1 to 32 do begin
      
      mi := TMenuItem.Create(Self);
      
      mi.ImageIndex := i;
      
      pmPlayers.Items.Add(mi);
      
      end;
   
   
   pmPlayers.Popup(Left+475,0);
   
   ilPlayers.BkColor := clFuchsia;
   
   end;


end.