Главная
 
 
Главная
Новости
Статьи
Самоучитель по Delphi
Справочник
Поиск
Карта сайта
Контакты
Авторизация





Забыли пароль?
Вы не зарегистрированы. Регистрация

Новости
В США в продажу поступили телевизоры 3D
Летом этого года в США начнет вещание спортивный 3D-телеканал ESPN.
Wed, 10 Mar 2010 05:51:42 +0300

Антимонопольщики заподозрили "Дальсвязь" в высоких ценах на Интернет
Компания занимает лидирующее место на рынке доступа к сети интернет, и, по мнению антимонопольщиков, в разы завышает цены на эту услугу.
Wed, 10 Mar 2010 03:56:00 +0300

Суд не послушал Telenor
Директор по внешним связям Telenor Russia Анна Иванова-Галицина подтвердила, что Высший арбитражный суд России отказал в передаче дела на рассмотрение в Президиум.
Wed, 10 Mar 2010 06:00:00 +0300

картриджи для лазерных принтеров и цветные струйные принтеры в Луганске
Управление игрой FreeCell Версия для печати Отправить на e-mail

Если вы решили перепробовать ВСЕ номера игры 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;
 
< Пред.   След. >
work online