Недавно добавленные исходники

•  3D Designer  81

•  Sik Screen Capture  65

•  Patch Maker  62

•  Айболит (remote control)  72

•  ListBox Drag & Drop  62

•  Доска для игры Реверси  901

•  Графические эффекты  71

•  Рисование по маске  50

•  Перетаскивание изображений  57

•  Canvas Drawing  53

•  Рисование Луны  134

•  Поворот изображения  43

•  Рисование стержней  38

•  Paint on Shape  33

•  Генератор кроссвордов  49

•  Головоломка Paletto  51

•  Теорема Монжа об окружностях  98

•  Пазл Numbrix  46

•  Заборы и коммивояжеры  67

•  Игра HIP  51

•  Игра Go (Го)  45

•  Симулятор лифта  45

•  Программа укладки плитки  47

•  Генератор лабиринта  90

•  Проверка числового ввода  38

•  HEX View  93

•  Физический маятник  96

•  Задача коммивояжера  122

•  Автомобильная пробка  46

•  Квадратные сетки из слов  40

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Управление игрой 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;








Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter