Qrcode компонент

Yushinin · July 2012

Здравствуйте, все.

Понадобился мне тут QRCode в отчетах.
Поискав, обнаружил только для .NET
Решил исправить такую несправедливаость и написал свой.
Онлайн решения отмел сразу, так как не факт, что на машине клиента будет устойчивый инет.
Нашел бесплатную библиотеку с примерами на Delphi - http://delphi32.blogspot.com/2011/11/quric...or-library.html
Посмотрев примеры и почитав документацию написал следущее:

unit syQRcode;

interface

uses classes, graphics, frxClass, frxDsgnIntf, QuricolCode, variants;

type
  TQRcodeParams = class(TPersistent)
  private
    FPixelSize: integer;
    FMargin: integer;
    constructor Create(AOwner: TComponent);
  published
    property Margin: integer read FMargin write FMargin;
    property PixelSize: integer read FPixelSize write FPixelSize;
  end;

  TfrxQRcode = class(TfrxView)
  private
    FText: string;
    FParams: TQRcodeParams;

  published

  public
    class function GetDescription: string; override;
    procedure Draw(Canvas: TCanvas; ScaleX: Extended; ScaleY: Extended; OffsetX: Extended;
      OffsetY: Extended); override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetData; override;
  published
    property Text: string read FText write FText;
    property CodeParams: TQRcodeParams read FParams write FParams;
    property DataField;
    property DataSet;

  end;

implementation

{ TfrxQRcode }

constructor TfrxQRcode.Create(AOwner: TComponent);
begin
  inherited;
  Text := 'http://yushinin.ru';
  FParams := TQRcodeParams.Create(self);
  Description := GetDescription;
end;

destructor TfrxQRcode.Destroy;
begin
  FParams.Free;
  inherited;
end;

procedure TfrxQRcode.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  bmp: tbitmap;
begin
  inherited;
  BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
  if Text <> '' then
  begin
    bmp := TQRCode.GetBitmapImage(Text, FParams.FMargin, FParams.FPixelSize);
    Width := bmp.Width;
    Height := bmp.Height;
    Canvas.Draw(Fx, fy, bmp);
  end;
end;

procedure TfrxQRcode.GetData;
begin
  inherited;
  if IsDataField then
    FText := VarToStr(DataSet.Value[DataField])
end;

class function TfrxQRcode.GetDescription: string;
begin
  Result := 'QR code';
end;

{ TQRcodeParams }

constructor TQRcodeParams.Create(AOwner: TComponent);
begin
  FMargin := 4;
  FPixelSize := 3;
end;

initialization

frxObjects.RegisterObject1(TfrxQRcode, nil, '', '', 0, 23);

finalization

frxObjects.Unregister(TfrxQRcode);

end.

Работает отлично.

sysadminix · July 2012

нужно разработчикам включить в поставку стандартную

carrabaz · September 2012

В ОгненнойОбезъяне уже будут QR-коды.

А вот тем, кто пока ее не использует (к примеру мне), будет очень полезно использовать это решение!
Спасибо!

crvik · November 2012

Здравствуйте!

Поделитесь примером на дельфях пожалуйста, как привязать данную реализацию к генератору отчетов?
За ранее спасибо!

gpi · November 2012

Пример в аттаче

Gdalex · January 2013

gpi написал: »

Пример в аттаче

А без дизайнера? У меня отчет хранится в форме. В режиме редактора нифига нет компонента. Если запустить программу и из-под нее дизайнер, то компонент есть, но пустой.

Yushinin · March 2013

Gdalex написал: »

А без дизайнера? У меня отчет хранится в форме. В режиме редактора нифига нет компонента. Если запустить программу и из-под нее дизайнер, то компонент есть, но пустой.

Gdalex, ну это уж совсем просто.
Нужно создать пакет, добавить модуль и установить его в среду.
Пакет, модуль, библиотека и инструкция прилагаются

kerma · April 2013

очень нужный компонент, проинсталировал из пакета syFR3, немного пришлось dpk поправить, ибо FR 3.24, но в итоге все установилось, в дизайнере прекрасно работает, вот при выводе на бумагу вместо приличного по размерам QRcode выходит маленький квадратик

gpi · April 2013

procedure TfrxQRcode.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  bmp: tbitmap;
  r: TRect;
begin
  inherited;
  BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
  if Text <> '' then
  begin
    bmp := TQRCode.GetBitmapImage(Text, FParams.FMargin, FParams.FPixelSize);
    Width := bmp.Width * ScaleX;
    Height := bmp.Height * ScaleY;
    r := Rect(FX, FY, FX + Round(Width), FY + Round(Height));
    frxDrawGraphic(Canvas, r, bmp, IsPrinting, True, False, clNone);
  end;
end;

Yushinin · July 2013

gpi написал: »

procedure TfrxQRcode.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  bmp: tbitmap;
  r: TRect;
begin
  inherited;
  BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
  if Text <> '' then
  begin
    bmp := TQRCode.GetBitmapImage(Text, FParams.FMargin, FParams.FPixelSize);
    Width := bmp.Width * ScaleX;
    Height := bmp.Height * ScaleY;
    r := Rect(FX, FY, FX + Round(Width), FY + Round(Height));
    frxDrawGraphic(Canvas, r, bmp, IsPrinting, True, False, clNone);
  end;
end;

Работь то будет, но опасно это.
Изменять пропорции QRcode нельзя.

mvs · September 2013

Создаю отчёт в run-time.
В FR-дизайнере могу расместить компонент QRcode1 на странице. Просмотр и печать ОК.
Если в коде (вкладка "Код" FR-дизайнера) пытаюсь изменить QRcode1.Text , то при просмотре получаю сообщение "Неизвестный тип "TfrxQRcode".

procedure Button2OnClick(Sender: TfrxComponent);
begin
  QRCode1.Text := 'Text могу менять в инспекторе объектов, а тут проблема!';
end;

Версия FR 4.4
В чем проблема?

mvs · September 2013

Зарегистрировать класс TfrxQRCode

{ TFunctions }

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited Create(AScript);
  with AScript do
  begin
    AddClass(TfrxQRCode, 'TfrxView');
  end;
end;


initialization
  fsRTTIModules.Add(TFunctions);

finalization
  if fsRTTIModules <> nil then
    fsRTTIModules.Remove(TFunctions);

Biged · October 2013

Люди добрые, здравствуйте! Как установить на Delphi 7, FastReport 3.15!? Вопрос жизни.... и работы.

gpi · October 2013

А что не получается?

andreymx · October 2013

Аналогичная хрень с разерами
На экране один размер, на печати - совсем другой, намного меньше.
Как наиболее безопасно порешать?

ЗЫ: Делфи-7 , ФР-4
поменял в dpk fs15, frx15 на fs7, frx7;

gpi · October 2013

Это пробовали?

procedure TfrxQRcode.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  bmp: tbitmap;
  r: TRect;
begin
  inherited;
  BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
  if Text <> '' then
  begin
    bmp := TQRCode.GetBitmapImage(Text, FParams.FMargin, FParams.FPixelSize);
    Width := bmp.Width * ScaleX;
    Height := bmp.Height * ScaleY;
    r := Rect(FX, FY, FX + Round(Width), FY + Round(Height));
    frxDrawGraphic(Canvas, r, bmp, IsPrinting, True, False, clNone);
  end;
end;

andreymx · October 2013

Меня смутил один из постов:

написал:

Работь то будет, но опасно это.
Изменять пропорции QRcode нельзя.

Yushinin · November 2013

andreymx написал: »

Меня смутил один из постов:

Стал проверять и действительно - при печати то масштабы меняются из-за разной разрешения экрана и принтера.

Спасибо gpi.
Метод Draw может быть таким:

procedure TfrxQRcode.Draw(Canvas: TCanvas;
  ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  bmp: tbitmap;
begin
  inherited;
  BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
  if Text <> '' then
  begin
    bmp := TQRCode.GetBitmapImage(Text, FParams.FMargin, FParams.FPixelSize);
   try
    Width := bmp.Width * ScaleX;
    Height := bmp.Height * ScaleY;
    Canvas.StretchDraw( Rect(FX, FY, FX + Round(Width), FY + Round(Height)), bmp);

  //  frxDrawGraphic(Canvas, Rect(FX, FY, FX + Round(Width), FY + Round(Height)), bmp, IsPrinting, True, False, clNone);
   finally
     bmp.free;
   end;
  end;
end;

Добавил удаление битмапа, а то ведь утечки памяти...
Можно использовать и фирменный FR метод печати frxDrawGraphic, добавив в uses модуль frxUtils.
Однако там ничего реально нужного для печати кода нет, кроме того же StretchDraw.
Проверил на печати, все ок и распознается.

AlexChar · November 2013

Подскажите в чём может быть трабла?
Установил QRCode. В дезижене добавляется и просматривается всё нормально. а вот в рантайме при просмотре - акцессвиолейшон... Делфи 2010, FR 4.9.32

andreymx · December 2013

AlexChar написал: »

Подскажите в чём может быть трабла?
Установил QRCode. В дезижене добавляется и просматривается всё нормально. а вот в рантайме при просмотре - акцессвиолейшон... Делфи 2010, FR 4.9.32

а кто знает, в какой кодировке заносится русский текст?
или это зависит от версии Делфи?

Владимир_746532 · April 2016

gpi написал: »

Пример в аттаче

Ссылка https://www.fastreport.ru/ru/forum/index.ph...ost&id=1157 не работает! Как и остальные где вложения...
Возвращает Sorry, an error occurred. If you are unsure on how to use a feature, or don't know why you got this error message, try looking through the help files for more information.
Не первый раз такое на форуме. Понятно что вышла новая версия и там всё есть, но обновление с 4 на 5 FR стоит 10 тыс, хотелось бы к 4-ке прикрутить.

reiter · October 2016

написал:

Зарегистрировать класс TfrxQRCode
Код
{ TFunctions }

constructor TFunctions.Create(AScript: TfsScript);
begin
inherited Create(AScript);
with AScript do
begin
AddClass(TfrxQRCode, 'TfrxView');
end;
end;

initialization
fsRTTIModules.Add(TFunctions);

finalization
if fsRTTIModules <> nil then
fsRTTIModules.Remove(TFunctions);

Где это писать?

Stalker4 · October 2016

reiter написал: »

Где это писать?

В Delphi-коде.

XBB · September 2017

Исправленный quricol32 (qr код) для FastReport 5. В дизайнере отображается корректно добавлены свойства zoom как у стандартного qr и Level от 0 до 3 (TErrorCorretion = (QualityLow, QualityMedium, QualityStandard, QualityHigh))

XBB · September 2017

XBB написал: »

Исправленный quricol32 (qr код) для FastReport 5. В дизайнере отображается корректно добавлены свойства zoom как у стандартного qr и Level от 0 до 3 (TErrorCorretion = (QualityLow, QualityMedium, QualityStandard, QualityHigh))

файл на форум не загружается.
https://drive.google.com/open?id=0B5Ts1vanf...LUpuT2hpc0h6ZTQ

maldalik · September 2017

XBB написал: »

файл на форум не загружается.
https://drive.google.com/open?id=0B5Ts1vanf...LUpuT2hpc0h6ZTQ

А под 4.0 работать будет?

maldalik · September 2017

maldalik написал: »

А под 4.0 работать будет?

И, кстати? не компилится пакадж, пробовал Delpphi XE3, Rad Studio 10
[dcc32 Fatal Error] fs14.dpk(28): E2225 Never-build package 'rtl' must be recompiled
[dcc32 Fatal Error] syFR3.dpk(35): E2202 Required package 'fs14' not found
И dll только 32 разрядная в архиве

XBB · November 2017

XBB написал: »

файл на форум не загружается.
https://drive.google.com/open?id=0B5Ts1vanf...LUpuT2hpc0h6ZTQ

Добавлно два свойства
property CalcHeight: Extended read GetCalcHeight;
property CalcWidth: Extended read GetCalcHeight;
и 64 битная библиотека

Qrcode компонент

Комментарии

Оставить комментарий