unit _fm_Word;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
Tfm_Word = class(TForm)
edWord : TEdit;
btApply : TBitBtn;
btWDir : TBitBtn;
stWWeight : TStaticText;
meHelp : TMemo;
imV : TImage;
imH : TImage;
btCancel : TSpeedButton;
procedure btApplyClick(Sender: TObject);
procedure btWDirClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure edWordChange(Sender: TObject);
procedure btCancelClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fm_Word : Tfm_Word;
implementation{================================================================}
uses _fm_Main, LangSupp, _fm_DMan;
var
LCol,LRow : integer;
{$R *.DFM}
{------------------------------------------------------------------------------}
procedure Tfm_Word.btApplyClick(Sender: TObject);
var
i : integer;
begin
{Слова менее чем из 2 букв не пропускать}
if length(edWord.Text)<2 then
exit;
sWord := AnsiLowerCase(edWord.Text);
SCol := LCol;
SRow := LRow;
if not CheckWordLayout then begin
if EMessage='*' then
MessageDlg(_W_mReplaceAst, mtWarning, [mbOk], 0)
else
if EMessage<>'' then
MessageDlg(EMessage, mtError, [mbOk], 0);
{Возможен выход без сообщений}
exit;
end
else
{синтаксис и расположение в порядке...}
{Проверка на содержание вводимого слова в словаре программы}
if SendMessage(fm_DMan.lbActive.Handle, LB_FindStringExact, 0, Longint(PChar(sWord))
)<0 then
if MessageBox(0,PChar(Format(_W_mIsAdd,
[AnsiUpperCase(sWord)])),
PChar(Application.Title),
MB_YESNO or MB_TASKMODAL or
MB_ICONQUESTION or MB_DEFBUTTON2)=IDYES then begin
fm_DMan.lbActive.Items.Add(sWord);
end
else begin
MessageDlg(_W_mAbortAdd, mtInformation, [mbOk], 0);
exit;
end;
{Проверка на предшествие ходу пользователя - подсказки компьютера}
if Suggested then
for i:=1 to FoundedWords do begin
if Drafts[i].Word=sWord then begin
if MessageBox(0,PChar(_W_mSuggested),
PChar(Application.Title),
MB_YESNO or MB_TASKMODAL or
MB_ICONQUESTION or MB_DEFBUTTON2)=IDYES then
exit
else begin
Players[PCNo].Rec.Caption :=
IntToStr(StrToInt(Players[PCNo].Rec.Caption)+SuggestionValue);
{Запись подсказки как хода в архив ходов}
inc(PlayerMoves);
PlayerMove[PlayerMoves].PlayerName := Players[PCNo].Name.Text;
PlayerMove[PlayerMoves].DirHor := WordDirHor;
PlayerMove[PlayerMoves].Pos := Point(SCol,SRow);
PlayerMove[PlayerMoves].Word := Format(_G_cHelp,[AnsiUpperCase(sWord)]);
PlayerMove[PlayerMoves].Points := SuggestionValue;
PlayerMove[PlayerMoves].Total := StrToInt(Players[PCurrent].Rec.Caption);
PlayerMove[PlayerMoves].UsedLetters := '';
PlayerMove[PlayerMoves].ReceivedLetters := '';
end;
{else}
break;
end;
{if =Word}
end;
{for i}
Close;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Word.btWDirClick(Sender: TObject);
var
i,j : byte;
k : integer;
l,l1 : string;
begin
LCol := SCol;
LRow := SRow;
edWord.OnChange := nil;
WordDirHor := not WordDirHor;
if WordDirHor then
btWDir.Glyph := imH.Picture.Bitmap
else
btWDir.Glyph := imV.Picture.Bitmap;
if WordDirHor then
btWDir.Caption := _W_WDirHor
else
btWDir.Caption := _W_WDirVer;
fm_Word.edWord.Text := '';
ActiveControl := btApply;
{Расчет правильного отображения предполагаемого слова}
if GameState=gsJustStarted then
{Пересечений точно не ожидается}
for i:=1 to Players[PCurrent].LettersObj.col+1 do
fm _Word.edWord.Text:=fm_Word.edWord.Text + Players[PCurrent].Letters[i]
else begin
{Могут быть пересечения}
j := 1;
for k:=1 to MaxWordLength do begin
l1 := FieldNextCell(k+1).Letter;
l := FieldNextCell(k).Letter;
if l=' ' then begin
fm_Word.edWord.Text := fm_Word.edWord.Text + AnsiLowerCase(Players[PCurrent
].Letters[j]);
inc(j);
end
else
fm_Word.edWord.Text := fm_Word.edWord.Text + AnsiUpperCase(l);
if (j>Players[PCurrent].LettersObj.Col+1) and (l1=' ') then
break;
if WordDirHor and (LCol+k>=fm_Main.sg.ColCount) then
break;
if not WordDirHor and (LRow+k>=fm_Main.sg.ColCount) then
break;
end;
{for}
end;
{else}
{Если перед буквой стоит слово, то также его включить}
if WordDirHor and (LCol>0) then
for i:=LCol-1 downto 0 do begin
if Field[i,LRow].Letter=' ' then
break;
fm_Word.edWord.Text := AnsiUpperCase(Field[i,LRow].Letter) + fm_Word.edWord.Text;
dec(LCol);
end;
if not WordDirHor and (LRow>0) then
for i:=LRow-1 downto 0 do begin
if Field[LCol,i].Letter=' ' then
break;
fm_Word.edWord.Text := AnsiUpperCase(Field[LCol,i].Letter) + fm_Word.edWord.Text;
dec(LRow);
end;
ActiveControl := edWord;
{Если среди букв есть зведочка, то ее выделить. Иначе - выделить все слово}
if Pos('*',edWord.Text)>0 then begin
edWord.SelStart := Pos('*',edWord.Text)-1;
edWord.SelLength := 1;
end
else begin
edWord.SelStart := 0;
edWord.SelLength := length(edWord.Text);
end;
edWord.OnChange := edWordChange;
edWordChange(Sender);
end;
{------------------------------------------------------------------------------}
procedure Tfm_Word.FormActivate(Sender: TObject);
begin
Left := fm_Main.Left + fm_Main.sg.Left + fm_Main.sg.Width + 16;
Top := fm_Main.Top + Players[PCurrent].LettersObj.Top + 140;
if ShowTips then
fm_Word.Height := 202
else
fm_Word.Height := 131;
EMessage := 'Cancelled';
{Must be non empty!}
fm_Word.Caption := _W_cCaption + ' - ' + _H_LPName + ': ' + Players[PCurrent].Name.Text
;
fm_Word.meHelp.Lines.Text := Players[PCurrent].Name.Text + ', ' + _W_mHelp;
fm_Word.btWDirClick(Self);
end;
procedure Tfm_Word.edWordChange(Sender: TObject);
var
i,j : byte;
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(edWord.Text) do
Field[LCol+i-1,LRow].JustSet:=true
else for i:=1 to length(edWord.Text) do
Field[LCol,LRow+i-1].JustSet:=true;
fm_Main.sg.Repaint;
{Расчет веса слова}
sWord := AnsiLowerCase(edWord.Text);
WWeight := WordWeight;
{Указываем количество очков слова}
stWWeight.Caption := Format(_W_mWWeight, [WWeight, Ending(WWeight)]);
if pos('*',edWord.Text)<>0 then
stWWeight.Caption := stWWeight.Caption + ' + *'
end;
procedure Tfm_Word.btCancelClick(Sender: TObject);
begin
Close
end;
procedure Tfm_Word.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#27 then
Close
end;
end.