Генерация QR-кода на Android

[ophion]

Всем доброго времени суток.

 

Среда: Rad Studio 10 Seattle (без Update 1)

Платформа: Android

 

Столкнулся с необходимостью генерации QR-кода для отображения на TImage.

Воспользовался информацией, взятой тут http://zarko-gajic.iz.hr/firemonkey-mobile-android-ios-qr-code-generation-using-delphi-xe-5-delphizxingqrcode/

У автора возникла проблема с опцией DisableInterpolation на платформе Android (тот же код отлично работает на Windows), а именно, на Android это не работает (изображение получается размытым)

Перепробовал всё, что приходило в голову, а так же было нагуглено.... но все попытки безуспешны.

Подскажите, как изменить размер изображения, чтобы оно не становилось мутным?

[ophion]

Поднимаю тему, поскольку вопрос генерации QR-кода на устройстве под управлением Android, не решен.

[Rusland]

Если приложите код проекта, то больше шансов что кто-то рассмотрит и поможет

[ophion]

Код проекта и дполнительньно-используемый юнит есть по ссылке, где собственно и приводится пример.

[Rusland]

Ссылку на юнит видно http://zarko-gajic.iz.hr/wp/wp-content/uploads/2013/12/FMX-DelphiZXIngQRCode.zip

А на проект нет

Изменено 11 февраля, 2016 пользователем Rusland

[ophion]

Там образец кода есть

var
  QRCode: TDelphiZXingQRCode;
  QRCodeBitmap:TBitmap;
  Row, Column: Integer;
  pixelColor : TAlphaColor;
  vBitMapData : TBitmapData;
  rSrc, rDest : TRectF;
  s : widestring;
begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := edtText.Text;
    QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
    QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4);
    QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);
    for Row := 0 to QRCode.Rows - 1 do
    begin
      for Column := 0 to QRCode.Columns - 1 do
      begin
        if (QRCode.IsBlack[Row, Column]) then
          pixelColor := TAlphaColors.Black
        else
          pixelColor := TAlphaColors.White;

        if QRCodeBitmap.Map(TMapAccess.maWrite, vBitMapData)  then
        try
          vBitMapData.SetPixel(Column, Row, pixelColor);
        finally
          QRCodeBitmap.Unmap(vBitMapData);
        end;
      end;
    end;
  finally
    QRCode.Free;
  end;

  {далее выводим битмап QRCodeBitmap на TImage}
end;

[Pax Beach]

Ophion, удалось решить вопрос?

Я уже все параметры перебрал у TImage, Bitmap, Canvas компонента TImage и Canvas битмапа, не выводится QR корректно на Android (изображение на холст либо не выводится, либо размазанное).

Ключевыми методами, влияющими на работу в Android выявил следующие: Bitmap.SetSize (от размера зависит, будет ли исходный битмап размазанным), Canvas.DrawBitmap (последний параметр const HighSpeed: Boolean), WrapMode = Original, Stretch, Fit - в зависимости от размера конечного битмапа, DisableInterpolation — вообще ни как не влияет.

Под Windows идеально работает в разных размерах конечного битмапа и параметров WrapMode.

В итоге переписал код отрисовки TImage, поточечно вывожу на канву исходный битмап — Windows идеально, в Android — вообще на канву не рисует.

Слезы текут на клавиатуру. Помогите пожалуйста победить канву и битмап в Android. Как правильно рисовать на канве в Android?

 

public

    ImageQR: TImage;
    QRCodeBitmap: TBitmap;


procedure TfmMainQRShare.ImageQRPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
  rSrc, rDest: TRectF;
  Row, Column: Integer;
  xPos, yPos, RectSize: Single;
  pixelColor: TAlphaColor;
  Img: TImage;
begin
  Img := (Sender as TImage);
  if Assigned(QRCode) and (not QRCode.Data.IsEmpty) then begin
    Img.Bitmap.SetSize(Canvas.Width, Canvas.Height);
    RectSize := min(Img.Width, Img.Height) / QRCode.Columns;
    if RectSize >  then
      if Canvas.BeginScene then
        try
          Img.Bitmap.Canvas.Clear(TAlphaColors.White);

          for Row :=  to QRCode.Rows - 1 do begin
            for Column :=  to QRCode.Columns - 1 do begin
              if (QRCode.IsBlack[Row, Column]) then
                pixelColor := TAlphaColors.Black
              else
                pixelColor := TAlphaColors.White;

              xPos := Column * RectSize + 0.5 * RectSize;
              yPos := Row * RectSize + 0.5 * RectSize;
              Canvas.StrokeThickness := RectSize + 1;
              Canvas.StrokeCap := TStrokeCap.Flat;
              Canvas.StrokeJoin := TStrokeJoin.Miter;
              Canvas.StrokeDash := TStrokeDash.Solid;
              Canvas.Stroke.Color := pixelColor;
              Canvas.DrawLine(TPointF.Create(xPos, yPos), TPointF.Create(xPos, yPos), 1);

            end;
          end;
          Canvas.EndScene;
        finally
          Canvas.EndScene;
        end;
  end;
end;

Пример моего проекта прилагаю.

MakeQRCodes.zip

[ophion]

Нет, пока пока нет времени, но стоит попробовать реализовать данную вещь через TBitmapSurface (FMX.Surfaces.TBitmapSurface)

[Pax Beach]

Подскажите пожалуйста логику, как через сурфейс сделать. Я попробую ее реализовать.

[Равиль Зарипов (ZuBy)]

Я вижу решение таким, реализуйте.

Каждый пиксель нужно отрисовать примерно 4 раза, тогда квадрат будет не 1х1, а 4х4. Картинка станет четкой т.к. увеличится холст

[Pax Beach]

 

1 час назад, ZuBy сказал:

Я вижу решение таким, реализуйте.

Каждый пиксель нужно отрисовать примерно 4 раза, тогда квадрат будет не 1х1, а 4х4. Картинка станет четкой т.к. увеличится холст

Выше я привел в пример код, который так и делает, рисует большие квадратные точки (на моем HTC ONE 17 пикселей). Только почему-то на канве в андроиде они не выводятся. А в окнах работает пример хорошо.

Изменено 25 апреля, 2016 пользователем Pax Beach

[Равиль Зарипов (ZuBy)]

9 часов назад, Pax Beach сказал:

Выше я привел в пример код, который так и делает, рисует большие квадратные точки (на моем HTC ONE 17 пикселей). Только почему-то на канве в андроиде они не выводятся. А в окнах работает пример хорошо.

немного неправильно сделали, вот так:

procedure TfmMainQRShare.ImageQRPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
  Row, Column: Integer;
  xPos, yPos, RectSize: Single;
  pixelColor: TAlphaColor;
  Img: TImage;
begin
  Img := (Sender as TImage);
  if Assigned(QRCode) and (not QRCode.Data.IsEmpty) then
  begin
    RectSize := Min(Img.Width, Img.Height) / QRCode.Columns;
    if RectSize > 0 then
    begin
      try
        Canvas.BeginScene;
        for Row := 0 to QRCode.Rows - 1 do
        begin
          for Column := 0 to QRCode.Columns - 1 do
          begin
            if (QRCode.IsBlack[Row, Column]) then
              pixelColor := TAlphaColors.Black
            else
              pixelColor := TAlphaColors.White;

            xPos := Column * RectSize + 0.5 * RectSize;
            yPos := Row * RectSize + 0.5 * RectSize;
            Canvas.Fill.Color := pixelColor;
            Canvas.FillRect(RectF(xPos, yPos, xPos + (RectSize + 1), yPos + (RectSize + 1)), 0, 0, AllCorners, 1);
          end;
        end;
      finally
        Canvas.EndScene;
      end;
    end;
    Img.Bitmap.SetSize(Canvas.Width, Canvas.Height);
    Img.Bitmap.Assign(Canvas.Bitmap);
  end;
end;

procedure TfmMainQRShare.Update;
begin
  QRCode.Free;
  QRCode := TDelphiZXingQRCode.Create;
  QRCode.Data := edtText.Text;
  QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
  QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 2);
  QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);
  ImageQR.Repaint;
end;

но проблема в другом, проблема в самом модуле, он не правильно работает со строками

[Pax Beach]

5 часов назад, ZuBy сказал:

немного неправильно сделали, вот так:

но проблема в другом, проблема в самом модуле, он не правильно работает со строками

я неправильно сделал, что не добавил строчку:

Canvas.Stroke.Kind := TBrushKind.Solid;

рисовать квадратами, тоже хорошо получилось.

 

Модуль в моей редакции (в архиве выше) под Windows хорошо с UTF8 работает, а вод под Android разбираюсь. Спасибо за указание на ошибку.
 

[Равиль Зарипов (ZuBy)]

29 минут назад, Pax Beach сказал:

Модуль в моей редакции (в архиве выше) под Windows хорошо с UTF8 работает, а вод под Android разбираюсь. Спасибо за указание на ошибку.

могу подсказать в какую сторону копать. строки в ANDROID/IOS начинаются с 0, а там не заметил чтобы это учитывалось.

Если сделаете, выложите. Всем будет полезно

[rareMax]

9 минут назад, ZuBy сказал:

могу подсказать в какую сторону копать. строки в ANDROID/IOS начинаются с 0, а там не заметил чтобы это учитывалось.

Добавьте это

{$ZEROBASEDSTRINGS ON}

Инфа: http://docwiki.embarcadero.com/RADStudio/Seattle/en/Zero-based_strings_(Delphi)

Изменено 26 апреля, 2016 пользователем Сысоев Максим

[Равиль Зарипов (ZuBy)]

Только что, Сысоев Максим сказал:

Добавьте это

{$ZEROBASEDSTRINGS ON}

 

я про это в курсе, но тогда на Windows отвалится. я не проверял, но в коде видел циклы со строками начинающиеся с 1

[rareMax]

Только что, ZuBy сказал:

я про это в курсе, но тогда на Windows отвалится. я не проверял, но в коде видел циклы со строками начинающиеся с 1

Ну ладно...

{$IFNDEF MSWINDOWS}
	{$ZEROBASEDSTRINGS OFF}
{$ENDIF}

И обращаю внимание что это только для проверки. Я код не видел - но скорее всего придется много переделывать для кроссплатформенности. 

[Равиль Зарипов (ZuBy)]

Только что, Сысоев Максим сказал:

Ну ладно...

{$IFNDEF MSWINDOWS}
	{$ZEROBASEDSTRINGS OFF}
{$ENDIF}

И обращаю внимание что это только для проверки. Я код не видел - но скорее всего придется много переделывать для кроссплатформенности. 

похоже на правду, но сейчас нет времени проверить. думаю Pax Beach примет это к сведению

[Евгений Корепов]

Можно пойти другим путем. Рисовать не на TImage, а использовать шрифты. 

На http://fontello.com/ сделал шрифт из двух символов - черный квадрат и белый квадрат. Рисовальщик из меня никудышний, не разобрался как увеличить высоту символов в SVG иконке. Шрифт подключил к проекту, отображаю на Memo, у которого установлен мой шрифт.

Код такой:

procedure TfmMainQRShare.Update;
var Row, Column, I : Integer;
    S : String;
    ChBlack, ChWhite : String;
begin
  Memo.BeginUpdate;
  Memo.Lines.Clear;
  ChBlack:=Char($e802);
  ChWhite:=Char($e803);
  QRCode.Free;
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := edtText.Text;
    QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
    QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 2);
    for Row := 0 to QRCode.Rows - 1 do
    begin
      S:='';
      for Column := 0 to QRCode.Columns - 1 do
      begin
        if (QRCode.IsBlack[Row, Column]) then
          S:=S+ChBlack
        else
          S:=S+ChWhite;
      end;
      Memo.Lines.Add(S);
    end;
  finally
  end;
  Memo.EndUpdate;
end;

На картинке видны горизонтальные пробелы между символами, в какой то момент мне удалось методом тыка (редактированием шрифта) от них избавится, но слетела ширина белого квадрата. Оставил вариант который хотя бы читается.

[Евгений Корепов]

Также можно использовать символы юникода http://www.alanwood.net/unicode/block_elements.html , но мне не удалось победить искажения. Кстати почему то считывает у меня только "llo world!", первые две буквы куда то пропадают ;-)

[Евгений Корепов]

  ChBlack:=Char($2588)+Char($2588);
  ChWhite:=Char($2591)+Char($2591);

Шрифт стандартный, выглядит не много лучше, но тоже не идеально:

Изменено 29 апреля, 2016 пользователем Евгений Корепов

[Равиль Зарипов (ZuBy)]

Цитата

Кстати почему то считывает у меня только "llo world!", первые две буквы куда то пропадают ;-)

там смысл в том и был, чтобы переделать модуль, а не отрисовку

Изменено 29 апреля, 2016 пользователем ZuBy

[Pax Beach]

32 минуты назад, ZuBy сказал:

там смысл в том и был, чтобы переделать модуль, а не отрисовку

Не удается пока переделать модуль для работы в среде {$IFDEF NEXTGEN}, да и крайне мало времени стало.

Дело в том, что модуль отлично работает с восьмибитными символами, и тот же UTF8 в Windows варианте компиляции приводится к строке с восьмибитными символами.

Пока я это не понял, пытался добиться одинаковой матрицы (изображения QR-code) на Windows и Android. Потом понял, что кодировать строки нужно по-разному, в первом случае обрабатывать 8 бит, во втором — 16, поэтому изображение для одной строки будет разное. ОК. Теперь строки я кодирую правильно, но при считывании кода, русские буквы все равно читаются неправильно. Может дело в кодировке, а может в кодировании служебной информации.

Убил 3 дня на разбор чужого кода. Понял, что автор кода не довел работу и до середины — ошибки в коде, работа только под windows и OSX, реализована 3 метода кодирования QR из заявленных 10, а мне нужно найти документацию по форматам кодирования QR и написать заново модуль.

В общем, пока откладываю работу над проектом до свободного времени.

 

Изменено 29 апреля, 2016 пользователем Pax Beach

[Pax Beach]

55 минут назад, ZuBy сказал:

там смысл в том и был, чтобы переделать модуль, а не отрисовку

На самом деле, вопрос с правильной отрисовкой на Bitmap в Android тоже не удалось решить.

Чтобы в приложении Android правильно отображался QR код, пришлось рисовать на канве TImage.Canvas, а не на канве TImage.Bimap.Canvas.

Поэтому при сохранении изображения приходится делать screenshot в TBitmap и далее resample в нужно разрешение изображения (через Canvas.DrawBitmap).

function TfmMainQRShare.getFinalBitmap(Img: TImage): TBitmap;
var
  b: TBitmap;
begin
  b := Img.MakeScreenshot;
  result := TBitmap.Create;

  result.Assign(b);
  result.SetSize(512,512);
  if result.Canvas.BeginScene() then
    try
      toast('OK');
      result.Canvas.Clear(TAlphaColors.White);
      result.Canvas.Fill.Bitmap.WrapMode := TWrapMode.TileStretch;
      result.Canvas.DrawBitmap(b, RectF(, , min(b.Width, b.Height), min(b.Width, b.Height)),
        RectF(, , 512, 512), 1, true);
      result.Canvas.EndScene;
    finally
      result.Canvas.EndScene;
    end;
end;

 

В итоге, при сохранении получаем только часть изображения (видно ниже). Почему оно искажается при ресамплинге, пока не знаю.

 

Если Canvas.DrawBitmap не делать, а сразу result := Img.MakeScreenshot, тогда все ок — но в Bitmap сохраняется вся канва TImage, а не нужная область, что не правильно.

 

Изменено 29 апреля, 2016 пользователем Pax Beach

[delcpy]

Можешь вот так попробовать https://youtu.be/OVj-FnE9RYU