Delphi разработка под Android: Пишем простейшую игру (головоломку) для детей

Новые технологии настолько вошли в нашу жизнь, что даже у пятилетнего ребёнка есть мощный смартфон или (и) планшет. Поэтому открылась новая ниша «Игры для детей». Конечно же, я взял эту тему для примера работы с SQLite.

Upd (20.04.14). Проверил код на Delphi XE6 и добавил исходники для новой версии IDE.

Не будем создавать кучу форм для отображения разной информации. Вместо этого создадим на форме один TTabControl с нужным количеством вкладок.

Для начала определяем вкладки:

Меню
Играть
Статистика
Правила

0. Основа.

В приложении будет 4 окошка. Для их реализации воспользуемся TTabControl, добавив в него 4 вкладки. Приложение разрабатывается для мобильных девайсов (телефонов) с размером экрана не менее 3.2 дюйма и не более 4.5 дюйма, хотя работать будет и на планшетах тоже.

1. Создаём окно с меню.

Нам понадобится:

Два Label – для вывода названия приложения и вывода поздравления
Два TLayout – для позиционирования элементов относительно формы
Четыре кнопки TSpeedButton – для создания меню, каждая кнопка ссылается на определённую вкладку TTabControl
Один TActionList – для перемещения между вкладками TTabControl

Как это выглядит в Delphi XE5 Update 2:

Структура на стадии «Создание меню»:

2. Вкладка «Играть» - Создание.

Этот пункт самый большой, т.к. мы создадим файл базы, заполним его, подключим к проекту. Решим, какие элементы нужны на форме, и как лучше расположить их. Загрузим картинки в ресурсы приложения. Напишем код для работы с файлом базы, добавим элементы для работы с базой на форму.

2.1. Начнём с создания файла базы, заполнения и подключения к проекту

В приложении будем использовать локалькую базу данных(SQLite). Файл назовём «rebusy.db». Сами ребусы будут в виде картинок (хранятся в ресурсах), а подсказки и ответы будут в текстовом виде храниться в базе.

Структура таблицы «list_rebusy»:

CREATE TABLE list_rebusy (

Id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,

answer TEXT,

hint TEXT,

resolved INTEGER DEFAULT ( 0 )

);

Т.к. картинки и ответы на ребусы связаны, то идентификатор (id, начинается с единицы) из базы будет браться в качестве имени картинки. Формат картинок «.png». Как вы наверно уже догадались, самое нудное – это заполнить базу, поэтому я не стал добавлять в неё 100-500 записей. В базе 19 записей.

Примечание: Все ребусы (картинки, подсказки, ответы) взяты из интернета, я ни чего не изменял. Базу создавал в программе «SQLiteStudio».

После создания базы её необходимо подключить к проекту:

Незабываем задеплоить файл базы в папку «.\assets\internal\».

2.2. Решаем, какие элементы нужны нам на форме.

На форме, во вкладке «Play Game» нам понадобятся:

Один TToolBar1, на него положим одну кнопку TSpeedButton (возвращаемся в меню) и один TLabel (будем выводить номер ребуса)
Один TLayout, на него кладём один TImage – в него будем подгружать картинку из ресурсов
Один TLabel – выводим подсказку
Один TLayout, на него положим один TClearingEdit, две кнопки TSpeedButton (Проверить и Правила)

2.3. Загружаем картинки в ресурсы приложения.

Картинок у меня 19 штук (общий вес 234 КБ).

Хранить их можно где угодно:

В ресурсах приложения «Resources and Images…»
В файле базы данных, используя BLOB
В папке с проектом, т.е. задеплоить все картинки
В архиве, который лежит в папке с проектом

Я решил, что в этом примере, буду хранить картинки, используя первый пункт.

Добавляем картинки:

Примечание: Если вы разработчик Firemonkey, то прошу вас: Сделайте, пожалуйста, человеческую сортировку в этом окне и чтобы сохранялись размеры/положение этого окна (если мы их изменили) при следующем открытии.

2.3. Пишем код для работы с базой

Нам необходимо читать из базы по одной записи (рандомно). Забегая вперёд: ещё будет необходимо собирать/сбрасывать статистику. Но это всё впереди, на данном этапе нам необходимо выводить по одной записи и обновлять запись в случае совпадения ответа.

Чтобы наше приложение умело подключаться к базе, необходимо перейти в «Data Explorer», зажать левую кнопку мышки на базе и перетащить её на форму. На форме появится компонент «TSQLConnection».

Остаётся добавить на форму компонент «TSQLQuery» со свойствами:

Name: SQLQSelectRand
SQLConnection: RebusyDB
SQL: «SELECT * FROM `list_rebusy` WHERE `resolved`='0' ORDER BY RANDOM() LIMIT 1» (без начальной и последней кавычек) – рандомно извлекаем одну запись

И добавить ещё один компонент «TSQLQuery» для обновления записей:

Name: SQLQUpdate
Params:
Id - DataType: ftInteger; Name: id; ParamType: ptInput
SQL: «UPDATE `list_rebusy` SET `resolved`='1' WHERE `id`= (:id)»
SQLConnection: RebusyDB

Теперь пишем код:

Для извлечения создадим отдельную процедуру «SQLSelect», в ней будем проверять, остались ли ещё не разгаданные ребусы и если они остались, то выводим ребус, если не остались то выводим поздравление.

Как это выглядит:

Структура вкладки:

3. Вкладка «Статистика»

На форме, во вкладке «Statistics» нам понадобятся:

Один TToolBar1, на него положим одну кнопку TSpeedButton (возвращаемся в меню) и один TLabel
Три Label
Одну кнопку TSpeedButton, для сброса статистики

Остаётся добавить на форму компонент «TSQLQuery» со свойствами:

Name: SQLQCount
SQLConnection: RebusyDB
SQL: «SELECT COUNT ( * ) FROM `list_rebusy` UNION SELECT COUNT ( * ) FROM `list_rebusy` WHERE `resolved` = '1'»

И ещё один:

Name: SQLQClear
SQL: « UPDATE `list_rebusy` SET `resolved`='0' »
SQLConnection: RebusyDB

Как это выглядит:

Структура:

Теперь код:

Для подсчёта статистики используем процедуру «SQLCount».

4. Вкладка «Правила»

Тут всё просто, я скопировал правила разгадывания ребусов с первого попавшегося сайта.

Скриншоты приложения:

Код приложения:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
  FMX.Layouts, FMX.StdCtrls, System.Actions, FMX.ActnList, FMX.Objects, FMX.Edit,
  Data.DbxSqlite, Data.FMTBcd, Data.DB, Data.SqlExpr;

type
  TForm1 = class(TForm)
    VertScrollBox1: TVertScrollBox;
    TabControl1: TTabControl;
    tiMenu: TTabItem;
    tiPlayGame: TTabItem;
    tiRules: TTabItem;
    tiStatistics: TTabItem;
    lAppName: TLabel;
    Layout1: TLayout;
    Layout2: TLayout;
    sbPlay: TSpeedButton;
    sbStatistics: TSpeedButton;
    sbRules: TSpeedButton;
    sbExit: TSpeedButton;
    ActionList1: TActionList;
    ChangeTabPlayGame: TChangeTabAction;
    ChangeTabStatistics: TChangeTabAction;
    ChangeTabRules: TChangeTabAction;
    ToolBar1: TToolBar;
    sbMenu: TSpeedButton;
    lRebusNum: TLabel;
    ChangeTabMenu: TChangeTabAction;
    Image1: TImage;
    Layout3: TLayout;
    sbCheck: TSpeedButton;
    sbRules2: TSpeedButton;
    ceAnswer: TClearingEdit;
    RebusyDB: TSQLConnection;
    SQLQSelectRand: TSQLQuery;
    lHint: TLabel;
    Layout4: TLayout;
    SQLQUpdate: TSQLQuery;
    lResultWin: TLabel;
    ToolBar2: TToolBar;
    sbMenu2: TSpeedButton;
    lStatistics: TLabel;
    lCountAll: TLabel;
    lCountResolved: TLabel;
    lCountNotSolved: TLabel;
    SQLQCount: TSQLQuery;
    sbClearStatistics: TSpeedButton;
    SQLQClear: TSQLQuery;
    ToolBar3: TToolBar;
    sbMenu3: TSpeedButton;
    lRules: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Layout5: TLayout;
    Image2: TImage;
    ScrollBox1: TScrollBox;
    Layout6: TLayout;
    Image3: TImage;
    Layout7: TLayout;
    Image4: TImage;
    Layout8: TLayout;
    Image5: TImage;
    Layout9: TLayout;
    Image6: TImage;
    procedure sbCheckClick(Sender: TObject);
    procedure RebusyDBBeforeConnect(Sender: TObject);
    procedure sbExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure sbClearStatisticsClick(Sender: TObject);
    procedure sbPlayClick(Sender: TObject);
    procedure FormFocusChanged(Sender: TObject);
    procedure FormVirtualKeyboardHidden(Sender: TObject;
      KeyboardVisible: Boolean; const Bounds: TRect);
    procedure FormVirtualKeyboardShown(Sender: TObject;
      KeyboardVisible: Boolean; const Bounds: TRect);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
  private
    { Private declarations }
    FKBBounds: TRectF;
    FNeedOffset: Boolean;
    IdSql: integer; // идентификатор ребуса
    CorrectAnswer, Hint: string;
    ImageWidthDef, ImageHeightDef: single;

    procedure CalcContentBoundsProc(Sender: TObject;
                                    var ContentBounds: TRectF);
    procedure RestorePosition;
    procedure UpdateKBBounds;
  public
    { Public declarations }
    procedure SQLSelect;
    procedure SQLCount;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  System.IOUtils, System.Math, FMX.Platform.Android;

procedure TForm1.CalcContentBoundsProc(Sender: TObject;
  var ContentBounds: TRectF);
begin
  if FNeedOffset and (FKBBounds.Top > 0) then
  begin
    ContentBounds.Bottom := Max(ContentBounds.Bottom,
                                2 * ClientHeight - FKBBounds.Top);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  TabControl1.ActiveTab := tiMenu;

  VertScrollBox1.OnCalcContentBounds := CalcContentBoundsProc;

  // Сохраняем размеры Image1
  ImageWidthDef := Image1.Width;
  ImageHeightDef := Image1.Height;

  RebusyDB.Connected := True;

  // Get Rebus
  SQLSelect;

  // Get Statistics
  SQLCount;

end;

procedure TForm1.FormFocusChanged(Sender: TObject);
begin
  UpdateKBBounds;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if ceAnswer.IsFocused then
  begin
    if Key = 13 then
      sbCheckClick(Self);
  end
  else
  begin
    if (Key = vkHardwareBack) AND (TabControl1.ActiveTab <> tiMenu) then
    begin
      TabControl1.ActiveTab := tiMenu;
      Key := 0;
    end;
  end;
end;

procedure TForm1.FormVirtualKeyboardHidden(Sender: TObject;
  KeyboardVisible: Boolean; const Bounds: TRect);
begin
  FKBBounds.Create(0, 0, 0, 0);
  FNeedOffset := False;
  RestorePosition;
end;

procedure TForm1.FormVirtualKeyboardShown(Sender: TObject;
  KeyboardVisible: Boolean; const Bounds: TRect);
begin
  FKBBounds := TRectF.Create(Bounds);
  FKBBounds.TopLeft := ScreenToClient(FKBBounds.TopLeft);
  FKBBounds.BottomRight := ScreenToClient(FKBBounds.BottomRight);
  UpdateKBBounds;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
  lHint.Visible := True;
end;

procedure TForm1.RebusyDBBeforeConnect(Sender: TObject);
begin
  RebusyDB.Params.Values['Database'] := TPath.Combine(TPath.GetDocumentsPath, 'rebusy.db');
end;

procedure TForm1.RestorePosition;
begin
  VertScrollBox1.ViewportPosition := PointF(VertScrollBox1.ViewportPosition.X, 0);
  TabControl1.Align := TAlignLayout.alClient;
  VertScrollBox1.RealignContent;
end;

procedure TForm1.sbCheckClick(Sender: TObject);
var
  UserAnswer: string;
begin
  UserAnswer := AnsiLowerCase(Trim(ceAnswer.Text));

  if (UserAnswer <> '') AND (UserAnswer = CorrectAnswer) then
  begin
    showmessage('Это правильный ответ!');
    try
      lHint.Visible := False;
      ceAnswer.Text := '';

      // Update rebus
      SQLQUpdate.ParamByName('id').AsInteger := IdSql;
      SQLQUpdate.ExecSQL();

      // Select new rebus
      SQLSelect;

      // Update Statistics
      SQLCount;
    except
      on e: Exception do
      begin
        ShowMessage(e.Message);
      end;
    end;
  end
  else
    ShowMessage('Это НЕ правильный ответ!');
end;

procedure TForm1.sbClearStatisticsClick(Sender: TObject);
begin
  try

    SQLQClear.ExecSQL();

    // Select new rebus
    SQLSelect;

    // Update Statistics
    SQLCount;

  except
    on e: Exception do
    begin
      ShowMessage(e.Message);
    end;
  end;
end;

procedure TForm1.sbExitClick(Sender: TObject);
begin
  RebusyDB.Connected := False;
  MainActivity.finish;
end;

procedure TForm1.sbPlayClick(Sender: TObject);
begin
  TabControl1.ActiveTab := tiPlayGame;
  //ChangeTabPlayGame.Tab := tiPlayGame;
  //ChangeTabPlayGame.Execute;
end;

procedure TForm1.SQLCount;
var
  CountResolved, CountAll: integer;
begin

  try
    // Statistics
    SQLQCount.Active := True;
    SQLQCount.Open;

    SQLQCount.First;
    CountResolved := SQLQCount.Fields.Fields[0].AsInteger;

    SQLQCount.Next;
    if SQLQCount.Fields.Fields[0].AsInteger <> 0 then
      CountAll := SQLQCount.Fields.Fields[0].AsInteger
    else
      CountAll := CountResolved;

    lCountAll.Text := 'Всего ребусов: ' + CountAll.ToString;
    lCountResolved.Text := 'Разгадано: ' + CountResolved.ToString;
    lCountNotSolved.Text := 'Осталось: ' + IntToStr(CountAll-CountResolved);

    SQLQCount.Close;
    SQLQCount.Active := False;
  except
    on e: Exception do
    begin
      ShowMessage(e.Message);
    end;
  end;

end;

procedure TForm1.SQLSelect;
var
  InStream: TResourceStream;
  ImageRatio, BitmapRatio: single; // Соотношение сторон Image1 и Bitmap
  Ratio, MaxImageWidth, MaxImageHeight: Single; // Соотношение; Возможная Ширина; Возможная Высота
begin

  try
    SQLQSelectRand.Active := True;
    SQLQSelectRand.Open;

    if not SQLQSelectRand.IsEmpty then
    begin

      sbPlay.Enabled := True;

      IdSql := SQLQSelectRand.FieldByName('id').AsInteger;
      CorrectAnswer := AnsiLowerCase(Trim(SQLQSelectRand.FieldByName('answer').AsString));
      Hint := SQLQSelectRand.FieldByName('hint').AsString;

      lRebusNum.Text := 'Ребус № ' + IntToStr(IdSql);
      lHint.Text := 'Подсказка: ' + hint;

      // Load image
      InStream := TResourceStream.Create(HInstance, 'PngImage_' + IntToStr(IdSql), RT_RCDATA);
      try
        Image1.Bitmap.LoadFromStream(InStream);
      finally
        InStream.Free;
      end;

      Image1.Width := ImageWidthDef;
      Image1.Height := ImageHeightDef;

      ImageRatio := Image1.Width/Image1.Height;
      BitmapRatio := Image1.Bitmap.Width/Image1.Bitmap.Height;

      if ImageRatio > BitmapRatio then
      begin
        Ratio := BitmapRatio;
        MaxImageWidth := Image1.Height * Ratio;

        if MaxImageWidth > Image1.Width then
          Image1.Width := Image1.Height * (ImageRatio - (Ratio - ImageRatio))
        else
          Image1.Width := MaxImageWidth;

      end
      else
      begin
        if ImageRatio <= BitmapRatio then
        begin
          Ratio := Image1.Bitmap.Height/Image1.Bitmap.Width;
          MaxImageHeight := Image1.Width * Ratio;

          if MaxImageHeight > Image1.Height then
            Image1.Height := Image1.Width * (Image1.Height/Image1.Width) - (Ratio - (Image1.Height/Image1.Width))
          else
            Image1.Height := MaxImageHeight;

        end;
      end;

    end
    else
    begin
      lResultWin.Text := 'Поздравляем!' + #13#10 + 'Вы разгадали все ребусы!';
      lResultWin.Visible := True;
      TabControl1.ActiveTab := tiMenu;
      sbPlay.Enabled := False;
    end;

    SQLQSelectRand.Close;
    SQLQSelectRand.Active := False;

  except
    on e: Exception do
    begin
      ShowMessage(e.Message);
    end;
  end;
end;

procedure TForm1.UpdateKBBounds;
var
  LFocused : TControl;
  LFocusRect: TRectF;
begin
  FNeedOffset := False;
  if Assigned(Focused) then
  begin
    LFocused := TControl(Focused.GetObject);
    LFocusRect := LFocused.AbsoluteRect;
    LFocusRect.Offset(VertScrollBox1.ViewportPosition);
    if (LFocusRect.IntersectsWith(TRectF.Create(FKBBounds))) and
       (LFocusRect.Bottom > FKBBounds.Top) then
    begin
      FNeedOffset := True;
      TabControl1.Align := TAlignLayout.alHorizontal;
      VertScrollBox1.RealignContent;
      Application.ProcessMessages;
      VertScrollBox1.ViewportPosition :=
        PointF(VertScrollBox1.ViewportPosition.X,
               LFocusRect.Bottom - FKBBounds.Top);
    end;
  end;
  if not FNeedOffset then
    RestorePosition;
end;

end.

Видео: