Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: декабрь 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Управление игрой FreeCell

Гарри Каспаров наконец-то выиграл у компьютера, и с двумя очками и тремя жизнями перешёл на следующий уровень.

Если вы решили перепробовать ВСЕ номера игры FreeCell, вас можно квалифицировать как законченного маньяка. В этом случае вас, возможно, заинтересует эта маленькая программка. При ее запуске она загружает FreeCell и начинает игру, следующую за той, которую вы не смогли завершить в прошлый раз. А еще она отвечает на глупые вопросы типа "Do you really want to resign the game?". После выигрыша программа изменяет счетчик таким образом, чтобы при очередном запуске номер игры изменялся на следующий автоматически.

Для создания программы расположите на новой форме таймер, установите ее свойство WindowState на wsMinimized и используйте следующий код:


 ...
 private
   { Private declarations }
   InstHandle: Word;
   WndHandle: hWnd;
   NextGame: Word;
 
   function EnumFunc(H: HWnd): Word;
   procedure WMQUERYOPEN(var Msg: TWMQueryOpen); message WM_QUERYOPEN;
 ...
 
 interface
 USES
   ShellApi, IniFiles;
 
 {$R *.DFM}
 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   H, SubH: hMenu;
   NewGameID: Word;
   FreeCellPath: string;
 begin
   with TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) do
   try
     FreeCellPath := ReadString('FreeCell', 'Path',
       'C:\WIN32APP\FREECELL\FREECELL.EXE') + #0;
     NextGame := ReadInteger('FreeCell', 'NextGame', 1);
   finally
     Free;
   end;
   InstHandle := ShellExecute(Handle, nil, @FreeCellPath[1],
     nil, nil, SW_SHOW);
   WndHandle := 0;
   if InstHandle >= 32 then
     EnumWindows(@TForm1.EnumFunc, LongInt(Self));
   if WndHandle <> 0 then
   begin
     {Вычисляем ID пункта меню "Select Game"}
     H := GetMenu(WndHandle);
     SubH := GetSubMenu(H, 0);
     NewGameID := GetMenuItemID(SubH, 1);
     Winprocs.SetFocus(WndHandle);
     {вызываем "Select Game"}
     PostMessage(WndHandle, WM_COMMAND, NewGameID, 0);
     Timer1.Enabled := True;
   end
   else
     Close;
 end;
 
 procedure TForm1.WMQUERYOPEN(var Msg: TWMQueryOpen);
 begin
   Msg.Result := 0;
 end;
 
 function TForm1.EnumFunc(H: HWnd): Word;
 begin
 
   if GetWindowWord(H, GWW_HINSTANCE) = InstHandle then
   begin
     WndHandle := H;
     Result := 0;
   end
   else
     Result := 1;
 end;
 
 procedure TForm1.Timer1Timer(Sender: TObject);
 var
   Buffer: array[0..10] of Char;
 
   DlgHandle: Word;
 begin
 
   {Если пользователь закрыл FreeCell, выходим!}
   if GetModuleUsage(InstHandle) = 0 then
   begin
     Close;
     Exit;
   end;
   {При необходимости укажите номер игры}
   DlgHandle := FindWindow('#32770', 'Game Number');
   if DlgHandle <> 0 then
   begin
     Str(NextGame, Buffer);
     SendDlgItemMessage(DlgHandle, $CB, WM_SETTEXT,
       0, LongInt(@Buffer));
     PostMessage(DlgHandle, WM_COMMAND, 1,
       MakeLong(GetDlgItem(DlgHandle, 1), BN_CLICKED));
   end;
   {Если игра окончена, увеличиваем счетчик}
   DlgHandle := FindWindow('#32770', 'Game Over');
   if DlgHandle <> 0 then
   begin
     Inc(NextGame);
     with TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) do
     try
       WriteInteger('FreeCell', 'NextGame', NextGame);
     finally Free;
     end;
     PostMessage(DlgHandle, WM_COMMAND, 6,
       MakeLong(GetDlgItem(DlgHandle, 6), BN_CLICKED));
   end;
   {Если игра спрашивает, хотите ли вы выйти, отвечем соответственно yes или OK}
   DlgHandle := FindWindow('#32770', 'FreeCell');
   if DlgHandle <> 0 then
   begin
     if (not (GetDlgItemText(DlgHandle, 6, Buffer, 10) in [0, 10]))
       and (StrComp(Buffer, '&Yes') = 0) then
       PostMessage(DlgHandle, WM_COMMAND, 6,
         MakeLong(GetDlgItem(DlgHandle, 6), BN_CLICKED))
     else if (not (GetDlgItemText(DlgHandle, 2, Buffer, 10) in [0, 10]))
       and (StrComp(Buffer, 'Cancel') = 0) then
       PostMessage(DlgHandle, WM_COMMAND, 1,
         MakeLong(GetDlgItem(DlgHandle, 1), BN_CLICKED))
   end;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS