Qrcode компонент

YushininYushinin Воронеж
отредактировано July 2012 Раздел: FastReport 4.0
Здравствуйте, все.

Понадобился мне тут 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.

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

Комментарии

  • отредактировано 19:25
    нужно разработчикам включить в поставку стандартную :)
  • отредактировано September 2012
    В ОгненнойОбезъяне уже будут QR-коды.

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

    Поделитесь примером на дельфях пожалуйста, как привязать данную реализацию к генератору отчетов?
    За ранее спасибо!
  • gpigpi
    отредактировано November 2012
    Пример в аттаче
  • GdalexGdalex Таганрог
    отредактировано 19:25
    gpi написал: »
    Пример в аттаче
    А без дизайнера? У меня отчет хранится в форме. В режиме редактора нифига нет компонента. Если запустить программу и из-под нее дизайнер, то компонент есть, но пустой.
  • YushininYushinin Воронеж
    отредактировано 19:25
    Gdalex написал: »
    А без дизайнера? У меня отчет хранится в форме. В режиме редактора нифига нет компонента. Если запустить программу и из-под нее дизайнер, то компонент есть, но пустой.

    Gdalex, ну это уж совсем просто.
    Нужно создать пакет, добавить модуль и установить его в среду.
    Пакет, модуль, библиотека и инструкция прилагаются
  • отредактировано 19:25
    очень нужный компонент, проинсталировал из пакета syFR3, немного пришлось dpk поправить, ибо FR 3.24, но в итоге все установилось, в дизайнере прекрасно работает, вот при выводе на бумагу вместо приличного по размерам QRcode выходит маленький квадратик
  • gpigpi
    отредактировано 19:25
    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;
    
  • YushininYushinin Воронеж
    отредактировано 19:25
    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 нельзя.
  • mvsmvs
    отредактировано 19:25
    Создаю отчёт в run-time.
    В FR-дизайнере могу расместить компонент QRcode1 на странице. Просмотр и печать ОК.
    Если в коде (вкладка "Код" FR-дизайнера) пытаюсь изменить QRcode1.Text , то при просмотре получаю сообщение "Неизвестный тип "TfrxQRcode".
    procedure Button2OnClick(Sender: TfrxComponent);
    begin
      QRCode1.Text := 'Text могу менять в инспекторе объектов, а тут проблема!';
    end;
    

    Версия FR 4.4
    В чем проблема?
  • mvsmvs
    отредактировано 19:25
    Зарегистрировать класс 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);
    
  • отредактировано October 2013
    Люди добрые, здравствуйте! Как установить на Delphi 7, FastReport 3.15!? Вопрос жизни.... и работы.
  • gpigpi
    отредактировано 19:25
    А что не получается?
  • отредактировано 19:25
    Аналогичная хрень с разерами
    На экране один размер, на печати - совсем другой, намного меньше.
    Как наиболее безопасно порешать?

    ЗЫ: Делфи-7 , ФР-4
    поменял в dpk fs15, frx15 на fs7, frx7;
  • gpigpi
    отредактировано 19:25
    Это пробовали?
    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;
    
  • отредактировано 19:25
    Меня смутил один из постов:
    написал:
    Работь то будет, но опасно это.
    Изменять пропорции QRcode нельзя.
  • YushininYushinin Воронеж
    отредактировано 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.
    Проверил на печати, все ок и распознается.

  • отредактировано 19:25
    Подскажите в чём может быть трабла?
    Установил QRCode. В дезижене добавляется и просматривается всё нормально. а вот в рантайме при просмотре - акцессвиолейшон... Делфи 2010, FR 4.9.32
  • отредактировано 19:25
    AlexChar написал: »
    Подскажите в чём может быть трабла?
    Установил QRCode. В дезижене добавляется и просматривается всё нормально. а вот в рантайме при просмотре - акцессвиолейшон... Делфи 2010, FR 4.9.32
    а кто знает, в какой кодировке заносится русский текст?
    или это зависит от версии Делфи?
  • отредактировано 19:25
    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-ке прикрутить.
  • отредактировано 19:25
    написал:
    Зарегистрировать класс 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);
    Где это писать?
  • Stalker4Stalker4 123
    отредактировано 19:25
    reiter написал: »
    Где это писать?
    В Delphi-коде.
  • XBBXBB
    отредактировано 19:25
    Исправленный quricol32 (qr код) для FastReport 5. В дизайнере отображается корректно добавлены свойства zoom как у стандартного qr и Level от 0 до 3 (TErrorCorretion = (QualityLow, QualityMedium, QualityStandard, QualityHigh))
  • XBBXBB
    отредактировано 19:25
    XBB написал: »
    Исправленный quricol32 (qr код) для FastReport 5. В дизайнере отображается корректно добавлены свойства zoom как у стандартного qr и Level от 0 до 3 (TErrorCorretion = (QualityLow, QualityMedium, QualityStandard, QualityHigh))
    файл на форум не загружается.
    https://drive.google.com/open?id=0B5Ts1vanf...LUpuT2hpc0h6ZTQ
  • отредактировано 19:25
    XBB написал: »
    файл на форум не загружается.
    https://drive.google.com/open?id=0B5Ts1vanf...LUpuT2hpc0h6ZTQ

    А под 4.0 работать будет?
  • отредактировано 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 разрядная в архиве
  • XBBXBB
    отредактировано 19:25
    XBB написал: »
    файл на форум не загружается.
    https://drive.google.com/open?id=0B5Ts1vanf...LUpuT2hpc0h6ZTQ
    Добавлно два свойства
    property CalcHeight: Extended read GetCalcHeight;
    property CalcWidth: Extended read GetCalcHeight;
    и 64 битная библиотека

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

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.