Upd (20.04.14). Проверил код на Delphi XE6 и добавил исходники для новой версии IDE.
Не будем создавать кучу форм для отображения разной информации. Вместо этого создадим на форме один TTabControl с нужным количеством вкладок.
Для начала определяем вкладки:
- Меню
- Играть
- Статистика
- Правила
0. Основа.
В приложении будет 4 окошка. Для их реализации воспользуемся TTabControl, добавив в него 4 вкладки. Приложение разрабатывается для мобильных девайсов (телефонов) с размером экрана не менее 3.2 дюйма и не более 4.5 дюйма, хотя работать будет и на планшетах тоже.
1. Создаём окно с меню.
Нам понадобится:
- Два Label – для вывода названия приложения и вывода поздравления
- Два TLayout – для позиционирования элементов относительно формы
- Четыре кнопки TSpeedButton – для создания меню, каждая кнопка ссылается на определённую вкладку TTabControl
- Один TActionList – для перемещения между вкладками TTabControl
Структура на стадии «Создание меню»:
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» (без начальной и последней кавычек) – рандомно извлекаем одну запись
- 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, для сброса статистики
- 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.
Видео:
Исходный код (Delphi XE5 Update 2): Скачать с Google Drive
Исходный код (Delphi XE6): Скачать с Google Drive
Исходный код (Delphi XE6): Скачать с Google Drive
Спасибо за внимание.
p.s. Надеюсь, статья кому-то пригодится.
p.s.2. Благодарю Бровина Ярослава и Рощина Сергея, за советы по некоторым вопросам.