пятница, 14 марта 2014 г.

Пишем простейшую игру (головоломку) для детей

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

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










Не будем создавать кучу форм для отображения разной информации. Вместо этого создадим на форме один TTabControl с нужным количеством вкладок.
Для начала определяем вкладки:
  1. Меню
  2. Играть
  3. Статистика
  4. Правила
0. Основа.
В приложении будет 4 окошка. Для их реализации воспользуемся TTabControl, добавив в него 4 вкладки. Приложение разрабатывается для мобильных девайсов (телефонов) с размером экрана не менее 3.2 дюйма и не более 4.5 дюйма, хотя работать будет и на планшетах тоже.

1. Создаём окно с меню.
Нам понадобится:
  1. Два Label – для вывода названия приложения и вывода поздравления
  2. Два TLayout – для позиционирования элементов относительно формы
  3. Четыре кнопки TSpeedButton – для создания меню, каждая кнопка ссылается на определённую вкладку TTabControl
  4. Один 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» нам понадобятся:
  1. Один TToolBar1, на него положим одну кнопку TSpeedButton (возвращаемся в меню) и один TLabel (будем выводить номер ребуса)
  2. Один TLayout, на него кладём один TImage – в него будем подгружать картинку из ресурсов
  3. Один TLabel – выводим подсказку
  4. Один TLayout, на него положим один TClearingEdit, две кнопки TSpeedButton (Проверить и Правила)
2.3. Загружаем картинки в ресурсы приложения.
Картинок у меня 19 штук (общий вес 234 КБ).

Хранить их можно где угодно:
  1. В ресурсах приложения «Resources and Images…»
  2. В файле базы данных, используя BLOB
  3. В папке с проектом, т.е. задеплоить все картинки
  4. В архиве, который лежит в папке с проектом 
Я решил, что в этом примере, буду хранить картинки, используя первый пункт.

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

Примечание: Если вы разработчик 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» нам понадобятся:
  1. Один TToolBar1, на него положим одну кнопку TSpeedButton (возвращаемся в меню) и один TLabel
  2. Три Label
  3. Одну кнопку 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.


Видео:


Исходный код (Delphi XE5 Update 2): Скачать с Google Drive
Исходный код (Delphi XE6): Скачать с Google Drive


Спасибо за внимание.

p.s. Надеюсь, статья кому-то пригодится.
p.s.2. Благодарю Бровина Ярослава и Рощина Сергея, за советы по некоторым вопросам.
p.s.3. Если вы нашли неточность или ошибку, то прошу вас сообщить мне на почту infocean @ gmail . com

25 комментариев:

  1. Спасибо, статья несомненно пригодиться, читаю вас постоянно.

    ОтветитьУдалить
  2. Это хорошо, но не могли бы расписать в новой статье насчет работы с SQL базой? К примеру, мне сейчас сложно понять как обращаться с ней на ты.

    ОтветитьУдалить
    Ответы
    1. А что именно не понятно, синтаксис запросов или как работать с компонентами dbExpress или ещё что-то?

      Удалить
    2. синтаксис немного остался загадкой, а вот с компонентами я такими еще не работал, не понятно как они устроены. К примеру не понимаю как обратиться к базе, к нужной таблице, взять значение и вынести допустим в label. И у компонентов есть свойство SQL тоже не понятно, что делается в результате.

      Удалить
    3. Андрей, может быть Вы поможете.

      В базе создается новая запись посредством sql^
      query.SQL.Text:='INSERT INTO ....
      query.ExecSQL;
      query.Close;

      Запись создается, но при попытке её отобразить. (при помощи компонента TBindSourceDBX, связанного со StringGrid) получаю ошибку Exception class Bus error (10), если запись создать через SQLiteStudio, то всё нормально, при компиляции под Windows тоже нет таких проблем, только если компилировать непосредственно на android.

      Удалить
    4. В общем проблема была несколько в другом - ошибка выпадала при попытке отобразить более двух записей, если хотя бы одно поле имело тип integer или boolean. Проблема решилась использованием TBindSourceDB в связке с TSQLDataSet, вместо TBindSourceDBX.

      Удалить
    5. Спасибо, что поделились решением. Возможно, пригодится ещё кому-нибудь.

      Удалить
  3. На Android 2.3 вылетает и на устройстве и на эмуляторе, пытался сам найти и устранить проблему, так и не получилось, выше Android 4.0 работает прекрасно, где копать, не ясно. D:

    ОтветитьУдалить
    Ответы
    1. Хм.. странно, постараюсь проверить на 2.3.3. К слову, версия 2.3 - 2.3.2 не поддерживается Delphi, поддержка осуществляется, начиная с версии 2.3.3. О поддерживаемых версиях можно почитать тут http://delphifmandroid.blogspot.ru/2013/11/blog-post.html

      Удалить
    2. Подтверждаю, на 2.3.6 не работает. Даже и не знаю, как теперь протестить нормально, устройство дали на 2 минуты...

      Удалить
    3. Похоже этот баг пофиксили в XE6 (http://qc.embarcadero.com/wc/qcmain.aspx?d=119856)

      Удалить
    4. Ну что же, придется ждать XE6

      Удалить
    5. В Delphi XE6 на Android 2.3 они просто теперь вывели "приложение не поддерживается". D:

      Удалить
    6. Если не сложно, проверьте "Samples\Object Pascal\Mobile Snippets\SQLite" на 2.3, пожалуйста.

      Удалить
    7. В общем, на некоторых устройствах с андрюшей 2.3.x вылазит "application does not support this device", на некоторых запускается нормально, странновато..

      Удалить
    8. Это вы про демку или моё приложение? Спасибо за проверку.

      Удалить
    9. Про ваше приложение, демку увы не смог проверить, сам у друзей таскаю телефоны на Android 2.3. Это может быть что-то с телефоном, или же с прошивкой/версией Android 2.3. Запускал на Samsung Galaxy Ace Duos GT-S6802 - вылетает, на Samsung Galaxy mini 2 GT-S6500D - прекрасно запускается/работает. Также и на эмуляторе пробовал запускать, там тоже вылетает, но ошибка другая. (но на эмуляторах запускать не вижу смысла). В общем пока что загадки..

      Удалить
  4. Этот комментарий был удален автором.

    ОтветитьУдалить
  5. Добрый день! скажите, пожалуйста, а "2.3. Загружаем картинки в ресурсы приложения" - есть ли способ не пользоваться ресурсом. Если нужно просто загрузить фото с флешки в image. Свойства image.picture в андройде нет. как загрузить файл с /mnt/sdcard/1.bmp ???

    ОтветитьУдалить
    Ответы
    1. Есть метод LoadFromFile, используйте его.

      Удалить
  6. так вот и проблема. пробовал по всякому:
    image1.MultiResBitmap.Bitmaps[0].LoadFromFile(имя_файла);- не работает
    image1.MultiResBitmap[0].Bitmaps.LoadFromFile(имя_файла);- не работает
    image1.Bitmaps.LoadFromFile(имя_файла);- не работает
    image1.repaint; - не помогает
    если не трудно, можно примерчик. Спасибо

    ОтветитьУдалить
    Ответы
    1. Image1.Bitmap.LoadFromFile('Путь до картинки');

      Удалить
  7. пишу приложение под Android (среда разработки XE7)
    имеется база данных SQLite, в одной из таблиц есть Blob поле, где находятся png-файлы
    вот такой простой код по извлечению значения из Blob и отрисовки на TImage
    BlobStream := FDTable.CreateBlobStream(FDTable.FieldByName('FramePng'), TBlobStreamMode.bmRead);
    bmp := TBitmap.CreateFromStream(BlobStream);
    ImagePage.Bitmap.Canvas.DrawBitmap(bmp, RectF(0, 0, bmp.Width - 1, bmp.Height - 1), r, 1);
    bmp.Free;
    BlobStream.Free;

    при запуске приложения под Windosw - все работает четко, а под Android получаю ошибку
    ---------------------------
    Project Project1.apk raised exception class EBitmapLoadingFailed with message 'Loading bitmap failed.'.
    ---------------------------
    в строке
    bmp := TBitmap.CreateFromStream(BlobStream);

    пробовал в базу загонять и jpg и bmp - ошибка одинакова
    подскажите как правильно преобразовать Blob TBitmap под Android

    ОтветитьУдалить
    Ответы
    1. нашел решение, может кому пригодится
      под Android получилось только через сохранение файла на "диск"
      может подскажите более лучшее решение?

      var
      {$IFDEF MSWINDOWS}
      BlobStream: TStream;
      {$ENDIF}
      {$IFDEF ANDROID}
      BlobStream: TMemoryStream;
      fn: string;
      {$ENDIF}
      bmp: TBitmap;
      r: TRectF;

      .................

      {$IFDEF MSWINDOWS}
      BlobStream := FDTable.CreateBlobStream(FDTable.FieldByName('FramePng'), TBlobStreamMode.bmRead);
      bmp := TBitmap.CreateFromStream(BlobStream);
      {$ENDIF}
      {$IFDEF ANDROID}
      fn := TPath.Combine(TPath.GetDocumentsPath, '1.png');
      BlobStream := TMemoryStream.Create;
      TBlobField(FDTable.FieldByName('FramePng')).SaveToStream(BlobStream);
      BlobStream.Position := 0;
      BlobStream.SaveToFile(fn);
      bmp := TBitmap.CreateFromFile(fn);
      TFile.Delete(fn);
      {$ENDIF}
      ImagePage.Bitmap.Canvas.DrawBitmap(bmp, RectF(0, 0, bmp.Width - 1, bmp.Height - 1), r, 1);
      bmp.Free;
      BlobStream.Free;

      Удалить