unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, ComCtrls, ColorBox, DelphiZXingQRCode, QR_URL, QR_Win1251, QRGraphics, Types,
  LCLType;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnCopy: TButton;
    btnSaveToFile: TButton;
    bvlColors: TBevel;
    cbbDrawingMode: TComboBox;
    cbbErrorCorrectionLevel: TComboBox;
    clrbxBackground: TColorBox;
    clrbxForeground: TColorBox;
    cmbEncoding: TComboBox;
    dlgSaveToFile: TSaveDialog;
    edtCornerThickness: TEdit;
    edtFileName: TEdit;
    edtQuietZone: TEdit;
    edtScaleToSave: TEdit;
    grpSaveToFile: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    lblBackground: TLabel;
    lblCorner: TLabel;
    lblDrawingMode: TLabel;
    lblEncoding: TLabel;
    lblErrorCorrectionLevel: TLabel;
    lblForeground: TLabel;
    lblQRMetrics: TLabel;
    lblQuietZone: TLabel;
    lblScaleToSave: TLabel;
    mmoText: TMemo;
    mmoEncodedData: TMemo;
    pbPreview: TPaintBox;
    pgcQRDetails: TPageControl;
    pnlColors: TPanel;
    pnlDetails: TPanel;
    tsEncodedData: TTabSheet;
    tsPreview: TTabSheet;
    udCornerThickness: TUpDown;
    udQuietZone: TUpDown;
    udScaleToSave: TUpDown;
    procedure btnCopyClick(Sender: TObject);
    procedure btnSaveToFileClick(Sender: TObject);
    procedure cbbDrawingModeChange(Sender: TObject);
    procedure cbbErrorCorrectionLevelChange(Sender: TObject);
    procedure clrbxBackgroundChange(Sender: TObject);
    procedure cmbEncodingChange(Sender: TObject);
    procedure cmbEncodingDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure cmbEncodingMeasureItem(Control: TWinControl; Index: Integer;
      var AHeight: Integer);
    procedure FormCreate(Sender: TObject);
    procedure mmoTextChange(Sender: TObject);
    procedure pbPreviewPaint(Sender: TObject);
  private

  public
    FQRCode: TDelphiZXingQRCode;
    procedure RemakeQR;
  end;

var
  Form1: TForm1;

implementation
uses Clipbrd;

{$R *.lfm}

{ TForm1 }

procedure TForm1.cmbEncodingDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  R1, R2: TRect;
  IsSpecialLine: Boolean;
  OldColor, OldFontColor: TColor;
  S: string;
begin
  IsSpecialLine := (Index in [0, ENCODING_UTF8_BOM + 1]) and not (odComboBoxEdit in State);
  with Control as TComboBox do
  begin
    if IsSpecialLine {$IFNDEF WIN32}and cmbEncoding.DroppedDown{$ENDIF} then
    begin
      R1 := ARect;
      R2 := R1;
      R1.Bottom := (ARect.Bottom + ARect.Top) div 2;
      R2.Top := R1.Bottom;
    end
    else
      R2 := ARect;
    Canvas.FillRect(R2);
    if Index >= 0 then
    begin
      if IsSpecialLine {$IFNDEF WIN32}and cmbEncoding.DroppedDown{$ENDIF} then
      begin
        OldColor := Canvas.Brush.Color;
        OldFontColor := Canvas.Font.Color;
        Canvas.Brush.Color := clBtnFace;
        Canvas.Font.Style := [fsBold];
        Canvas.Font.Color := clGrayText;
        Canvas.FillRect(R1);
        if Index = 0 then
          S := 'Default'
        else
          S := 'Extended';
        Canvas.TextOut((R1.Left + R1.Right - Canvas.TextWidth(S)) div 2, R1.Top, S);
        Canvas.Font.Assign(Font);
        Canvas.Brush.Color := OldColor;
        Canvas.Font.Color := OldFontColor;
      end;
      Canvas.TextOut(R2.Left + 2, R2.Top, Items[Index]);
    end;
  end;
end;

procedure TForm1.cmbEncodingMeasureItem(Control: TWinControl; Index: Integer;
  var AHeight: Integer);
begin
  AHeight := cmbEncoding.ItemHeight;
  {$IFNDEF WIN32}if cmbEncoding.DroppedDown then{$ENDIF}
    if Index in [0, ENCODING_UTF8_BOM + 1] then
      AHeight := AHeight * 2;
end;

procedure TForm1.cmbEncodingChange(Sender: TObject);
begin
  RemakeQR;
  mmoEncodedData.Text := FQRCode.FilteredData;
end;

procedure TForm1.cbbErrorCorrectionLevelChange(Sender: TObject);
begin
  RemakeQR;
end;

procedure TForm1.clrbxBackgroundChange(Sender: TObject);
begin
  pbPreview.Repaint
end;

procedure TForm1.cbbDrawingModeChange(Sender: TObject);
begin
  dlgSaveToFile.FilterIndex := Ord(TQRDrawingMode(cbbDrawingMode.ItemIndex
    div 2) <> drwBitmap) + 1;
  pbPreview.Repaint
end;

procedure TForm1.btnCopyClick(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := nil;
  try
    Bmp := TBitmap.Create;
    MakeBmp(Bmp, udScaleToSave.Position, FQRCode, clrbxBackground.Selected,
      clrbxForeground.Selected, udCornerThickness.Position);
    Clipboard.Assign(Bmp);
    Bmp.Free;
  except
    Bmp.Free;
    raise;
  end;
end;

procedure TForm1.btnSaveToFileClick(Sender: TObject);
var
  Bmp: TBitmap;
//  M: TMetafile;
  S: string;
  J: TJPEGImage;
begin
  if dlgSaveToFile.Execute then
  begin
    S := LowerCase(ExtractFileExt(dlgSaveToFile.FileName));
    if S = '' then
    begin
      case dlgSaveToFile.FilterIndex of
        0,
        1: S := '.bmp';
        2: S := '.emf';
        3: S := '.jpg';
      end;
      dlgSaveToFile.FileName := dlgSaveToFile.FileName + S;
    end;

    edtFileName.Text := dlgSaveToFile.FileName;
    Bmp := nil;
//    M := nil;
    J := nil;
    if S = '.bmp' then
    try
      Bmp := TBitmap.Create;
      MakeBmp(Bmp, udScaleToSave.Position, FQRCode, clrbxBackground.Selected,
        clrbxForeground.Selected, udCornerThickness.Position);
      Bmp.SaveToFile(dlgSaveToFile.FileName);
      Bmp.Free;
    except
      Bmp.Free;
      raise;
    end
    else
{      if S = '.emf' then
      try
        M := TMetafile.Create;
        MakeMetafile(M, udScaleToSave.Position, FQRCode,
          clrbxBackground.Selected, clrbxForeground.Selected,
          TQRDrawingMode(cbbDrawingMode.ItemIndex div 2),
          udCornerThickness.Position);
        M.SaveToFile(dlgSaveToFile.FileName);
        M.Free;
      except
        M.Free;
        raise;
      end
      else}
        if S = '.jpg' then
        try
          Bmp := TBitmap.Create;
          MakeBmp(Bmp, udScaleToSave.Position, FQRCode,
            clrbxBackground.Selected, clrbxForeground.Selected,
            udCornerThickness.Position);
          J := TJPEGImage.Create;
          J.Assign(Bmp);
          J.SaveToFile(dlgSaveToFile.FileName);
          J.Free;
          Bmp.Free;
        except
          J.Free;
          Bmp.Free;
          raise;
        end
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  H: Integer;
begin
  FQRCode := nil;

  with cmbEncoding do
  begin
    H := ItemHeight;
//    Style := csOwnerDrawVariable;
    ItemHeight := H;
    OnChange := nil;
    ItemIndex := 0;
    OnChange := @cmbEncodingChange
  end;
  with cbbErrorCorrectionLevel do
  begin
    OnChange := nil;
    ItemIndex := 0;
    OnChange := @cbbErrorCorrectionLevelChange
  end;
  with cbbDrawingMode do
  begin
    OnChange := nil;
    ItemIndex := 0;
    OnChange := @cbbDrawingModeChange
  end;

  // create and prepare QRCode component
  FQRCode := TDelphiZXingQRCode.Create;
  FQRCode.RegisterEncoder(ENCODING_WIN1251, TWin1251Encoder);
  FQRCode.RegisterEncoder(ENCODING_URL, TURLEncoder);

  // get ready!
  mmoText.Text := 'Hello, world';
  mmoTextChange(nil);
end;

procedure TForm1.mmoTextChange(Sender: TObject);
begin
  RemakeQR;
  mmoEncodedData.Text := FQRCode.FilteredData;
end;

procedure TForm1.pbPreviewPaint(Sender: TObject);
begin
  with pbPreview.Canvas do
  begin
    Pen.Color := clrbxForeground.Selected;
    Brush.Color := clrbxBackground.Selected;
  end;
  DrawQR(pbPreview.Canvas, pbPreview.ClientRect, FQRCode,
    udCornerThickness.Position, TQRDrawingMode(cbbDrawingMode.ItemIndex div 2),
    Boolean(1 - cbbDrawingMode.ItemIndex mod 2));
end;

procedure TForm1.RemakeQR;
begin
  with FQRCode do
  try
    BeginUpdate;
    Data := mmoText.Text;
    Encoding := cmbEncoding.ItemIndex;
    ErrorCorrectionOrdinal := TErrorCorrectionOrdinal(cbbErrorCorrectionLevel.ItemIndex);
    QuietZone := StrToIntDef(edtQuietZone.Text, 4);
    EndUpdate(True);

    lblQRMetrics.Caption := IntToStr(Columns) + 'x' + IntToStr(Rows) + ' (' +
      IntToStr(Columns - QuietZone * 2) + 'x' + IntToStr(Rows - QuietZone * 2) +
      ')';
  finally
    pbPreview.Repaint;
  end;
end;

end.

