unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
  StdCtrls, Spin, Buttons, ExtDlgs, ubarcodes;

type
  
  { TMainForm }

  TMainForm = class(TForm)
    BarcodesTree: TTreeView;
    btnSaveToFile: TBitBtn;
    btnCopyToClipboard: TBitBtn;
    btnFont: TButton;
    cbHumanReadableText: TCheckBox;
    cbAddChecksum: TCheckBox;
    cbDisplayChecksum: TCheckBox;
    cbAutoSize: TCheckBox;
    cbRecommendedSymbolSize: TCheckBox;
    clbColor: TColorButton;
    clbForeground: TColorButton;
    cmbBearerBarsBox: TComboBox;
    clbBackground: TColorButton;
    edText: TEdit;
    FontDialog: TFontDialog;
    gbGeometry: TGroupBox;
    gbShow: TGroupBox;
    gbChecksum: TGroupBox;
    gbColors: TGroupBox;
    lblWhiteSpaceWidth: TLabel;
    lblScale: TLabel;
    lblError: TLabel;
    lblMargin: TLabel;
    lblText: TLabel;
    lblSymbolHeight: TLabel;
    nbOptions: TNotebook;
    pgOptions_Plessey: TPage;
    pgOptions_QR: TPage;
    Panel1: TPanel;
    Panel2: TPanel;
    BarcodePanel: TPanel;
    rgPlessey_Checkchar: TRadioGroup;
    rgQR_ECCLevel: TRadioGroup;
    SaveDialog1: TSaveDialog;
    seWhiteSpaceWidth: TSpinEdit;
    seScale: TSpinEdit;
    seMargin: TSpinEdit;
    seSymbolHeight: TSpinEdit;
    btnSampleText: TSpeedButton;
    Splitter1: TSplitter;
    procedure BarcodeChange(Sender: TObject);
    procedure BarcodesTreeChange(Sender: TObject; Node: TTreeNode);
    procedure BarcodesTreeCustomDrawItem(Sender: TCustomTreeView; 
      Node: TTreeNode; {%H-}State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure btnCopyToClipboardClick(Sender: TObject);
    procedure btnFontClick(Sender: TObject);
    procedure btnSampleTextClick(Sender: TObject);
    procedure btnSaveToFileClick(Sender: TObject);
    procedure cbAutoSizeChange(Sender: TObject);
    procedure cbRecommendedSymbolSizeChange(Sender: TObject);
    procedure edTextChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure rgPlessey_CheckcharClick(Sender: TObject);
    procedure rgQR_ECCLevelClick(Sender: TObject);
    procedure SaveDialogTypeChange(Sender: TObject);
  private
    FBarCode: TLazBarcodeCustomText;
    FFileName: String;
    procedure PopulateBarcodesTree;
    procedure SelectBarCode(ANode: TTreeNode);
    procedure UpdateErrorMsg;

  public

  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  TypInfo;

type
  TLazBarcodeClass = class of TLazBarcodeCustomText;
  TBarcodeAccess = class(TLazBarcodeCustomText);
  TSimpleBarcodeAccess = class(TSimpleBarcode);

{ We must register all barcode classes because barcodes will be created in this
  application based on a string containing the class name. }
procedure RegisterBarcodes;
begin
  RegisterClass(TBarcodeC11);
  RegisterClass(TBarcodeC128);
  RegisterClass(TBarcode2of5);
  RegisterClass(TBarcode3of9);
  RegisterClass(TBarcodeEAN);
  RegisterClass(TBarcodeChannelCode);
  RegisterClass(TBarcodePlessey);
  RegisterClass(TBarcodeTelepen);
  RegisterClass(TBarcodeMedical);
  RegisterClass(TBarcodePostal);
  RegisterClass(TBarcodePDF417);

  RegisterClass(TBarcodeQR);
  RegisterClass(TBarcodeMicroQR);
  RegisterClass(TBarcodeAztec);
  RegisterClass(TBarcodeAztecRune);
  RegisterClass(TBarcodeDatamatrix);
end;


{ TMainForm }

procedure TMainForm.BarcodeChange(Sender: TObject);
begin
  if FBarcode = nil then
    exit;
  
  if Sender = seScale then
    TBarcodeAccess(FBarcode).Scale := seScale.Value
  else
  if Sender = seMargin then
    TBarcodeAccess(FBarcode).Margin := seMargin.Value
  else
  if Sender = seWhiteSpaceWidth then
    TBarcodeAccess(FBarcode).WhiteSpaceWidth := seWhiteSpaceWidth.Value
  else
  if Sender = seSymbolHeight then
    TBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value
  else
  if (Sender = cmbBearerBarsBox) then
    TBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex)
  else
  if Sender = clbColor then
    TBarcodeAccess(FBarcode).Color := clbColor.ButtonColor
  else
  if Sender = clbBackground then
    TBarcodeAccess(FBarcode).BackgroundColor := clbBackground.ButtonColor
  else
  if Sender = clbForeground then
    TBarcodeAccess(FBarcode).ForegroundColor := clbForeground.ButtonColor
  else
  if (Sender = cbHumanReadableText) and (FBarcode is TCustomBarcode) then
    TBarcodeAccess(FBarcode).ShowHumanReadableText := cbHumanReadableText.Checked
  else
  if (Sender = cbAddChecksum) and (FBarcode is TSimpleBarcode) then
  begin
    TSimpleBarcodeAccess(FBarcode).AddChecksum := cbAddChecksum.Checked;
    cbDisplayChecksum.Enabled := cbAddChecksum.Checked;
  end
  else
  if (Sender = cbDisplayChecksum) and (FBarcode is TSimpleBarcode) then
    TSimpleBarcodeAccess(FBarcode).DisplayChecksum := cbDisplayChecksum.Checked;
end;

procedure TMainForm.btnSampleTextClick(Sender: TObject);
begin
  if FBarCode <> nil then
  begin
    FBarcode.SampleText;
    edText.Text := FBarcode.Text;
  end;
end;

procedure TMainForm.BarcodesTreeChange(Sender: TObject; Node: TTreeNode);
begin
  SelectBarcode(Node);
end;

procedure TMainForm.BarcodesTreeCustomDrawItem(Sender: TCustomTreeView; 
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if (Node.HasChildren) or (Node.Level = 0) then
    Sender.Canvas.Font.Style := [fsBold]
  else
    Sender.Canvas.Font.Style := [];
  DefaultDraw := true;
end;

procedure TMainForm.btnCopyToClipboardClick(Sender: TObject);
begin
  FBarcode.CopyToClipboard;
end;

procedure TMainForm.btnFontClick(Sender: TObject);
begin
  FontDialog.Font.Assign(FBarcode.Font);
  if FontDialog.Execute then
    FBarcode.Font.Assign(FontDialog.Font);
end;

procedure TMainForm.btnSaveToFileClick(Sender: TObject);
begin
  with TSaveDialog.Create(self) do
  try
    Filter := 'Windows bitmap files (*.bmp)|*.bmp|' +
              'Portable network graphic files (*.png)|*.png|' +
              'JPEG image files (*.jpg;*.jpeg)|*.jpg;*.jpeg|' +
              'TIFF image files (*.tiff; *.tif)|*.tiff;*.tif|'+
              'XPM image files (*.xpm)|*.xpm|' +
              'Scalable vector graphics files (*.svg)|*.svg|'+
              'Encapsulated PostScript files (*.eps;*.ps)|*.eps;*.ps|'+
              'All files (*.*)|*.*';
    FilterIndex := 2;
    DefaultExt := '.png';
    InitialDir := ExtractFileName(FFileName);
    OnTypeChange := @SaveDialogTypeChange;
    if Execute then
    begin
      FFileName := FileName;
      case lowercase(ExtractFileExt(FFileName)) of
        '.bmp': 
          FBarcode.SaveToFile(FFileName, TBitmap);
        '.png': 
          FBarcode.SaveToFile(FFileName, TPortableNetworkGraphic);
        '.jpg', '.jpeg': 
          FBarcode.SaveTofile(FFileName, TJpegImage);
        '.tif', '.tiff': 
          FBarcode.SaveToFile(FFileName, TTiffImage);
        '.xpm':
          FBarcode.SaveToFile(FFileName, TPixmap);
        '.svg': 
          FBarcode.SaveToSvgFile(FFileName);
        '.eps', '.ps':
          Fbarcode.SaveToEpsFile(FFileName);
        else    
          raise Exception.Create('Image type not supported.');
      end;
    end;
  finally
    Free;
  end;
end;

procedure TMainForm.cbAutoSizeChange(Sender: TObject);
begin
  if Assigned(FBarcode) then
  begin
    FBarcode.AutoSize := cbAutoSize.Checked;
    if FBarcode.AutoSize then 
    begin
      FBarcode.Align := alNone;
      FBarcode.AnchorSideLeft.Control := FBarcode.Parent;
      FBarcode.AnchorSideLeft.Side := asrCenter;
      FBarcode.AnchorSideTop.Control := FBarcode.Parent;
      FBarcode.AnchorSideTop.Side := asrCenter;
    end else
    begin
      FBarcode.AnchorSideLeft.Control := nil;
      FBarcode.AnchorSideTop.Control := nil;
      FBarcode.Align := alClient;
    end;
  end;
end;

procedure TMainForm.cbRecommendedSymbolSizeChange(Sender: TObject);
begin
  seScale.Enabled := not cbRecommendedSymbolSize.Checked;
  lblScale.Enabled := seScale.Enabled;
  seMargin.Enabled := not cbRecommendedSymbolSize.Checked;
  lblMargin.Enabled := seMargin.Enabled;
  seWhitespaceWidth.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'WhiteSpaceWidth');
  lblWhitespaceWidth.Enabled := seWhitespaceWidth.Enabled;
  seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'SymbolHeight');
  lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
  cmbBearerBarsBox.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'BearerBarMode');
  if FBarcode is TSimpleBarcode then
  begin
    TSimpleBarcode(FBarcode).RecommendedSymbolSize := cbRecommendedSymbolSize.Checked;
    if not cbRecommendedSymbolSize.Checked then
    begin
      TSimpleBarcode(FBarcode).Scale := seScale.Value;
      TSimpleBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value;
      TSimpleBarcode(FBarcode).Margin := seMargin.Value;
      TSimpleBarcodeAccess(FBarcode).WhitespaceWidth := seWhiteSpaceWidth.Value;
      TSimpleBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex);
    end;
  end else
  if FBarcode is TBarcodePDF417 then
  begin
    seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked;
    lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  nbOptions.PageIndex := -1;
  PopulateBarcodesTree;
end;

procedure TMainForm.rgPlessey_CheckcharClick(Sender: TObject);
begin
  if FBarcode is TBarcodePlessey then
    TBarcodePlessey(FBarcode).CheckChar := TPlesseyCheckChar(rgPlessey_CheckChar.ItemIndex);
end;

procedure TMainForm.rgQR_ECCLevelClick(Sender: TObject);
begin
  if FBarcode is TBarcodeQR then
    TBarcodeQR(FBarcode).ECCLevel := TBarcodeQR_ECCLevel(rgQR_ECCLevel.ItemIndex);
end;

procedure TMainForm.SaveDialogTypeChange(Sender: TObject);
var
  dlg: TSaveDialog;
  L: TStrings;
  idx: Integer;
begin
  dlg := Sender as TSaveDialog;
  L := TStringList.Create;
  try
    L.StrictDelimiter := true;
    L.Delimiter := '|';
    L.DelimitedText := dlg.Filter;
    idx := (dlg.FilterIndex - 1) * 2 + 1;
    dlg.DefaultExt := ExtractfileExt(L[idx]);
  finally
    L.Free;
  end;
end;

procedure TMainForm.edTextChange(Sender: TObject);
begin
  FBarcode.Text := edText.Text;
  UpdateErrorMsg;
end;

procedure TMainForm.PopulateBarcodesTree;
var
  node, child: TTreeNode;
begin
  with BarcodesTree do begin
    Items.BeginUpdate;
    try
      Items.Clear;

      node := Items.AddChild(nil, '1-dimensional barcodes');
        child := Items.AddChildObject(node, 'Code 11', PChar('TBarcodeC11'));
        child := Items.AddChildObject(node, 'Code 128 and related', PChar('TBarcodeC128'));
          Items.AddChildObject(child, 'Code-128', Pointer(PtrInt(bctCode128)));
          Items.AddChildObject(child, 'EAN-128', Pointer(PtrInt(bctEAN128)));
        child := Items.AddChildObject(node, '2-of-5 codes', PChar('TBarcode2of5'));
          Items.AddChildObject(child, 'Standard 2-of-5', Pointer(PtrInt(bctCode25Standard)));
          Items.AddChildObject(child, 'Data Logic 2-of-5', Pointer(PtrInt(bctCode25DataLogic)));
          Items.AddChildObject(child, 'IATA 2-of-5', Pointer(PtrInt(bctCode25IATA)));
          Items.AddChildObject(child, 'Industrial 2-of-5', Pointer(PtrInt(bctCode25Industrial)));
          Items.AddChildObject(child, 'Interleaved 2-of-5', Pointer(PtrInt(bctCode25Interleaved)));
          Items.AddChildObject(child, 'ITF-14', Pointer(PtrInt(bctITF14)));
        child := Items.AddChildObject(node, '3-of-9 codes', PChar('TBarcode3of9'));
          Items.AddChildObject(child, 'Code 3-of-9 (C39)', Pointer(ptrInt(bctCode39)));
          Items.AddChildObject(child, 'Code 3-of-9 extended (C39+)', Pointer(PtrInt(bctCode39Ext)));
          Items.AddChildObject(child, 'LOGMARS', Pointer(PtrInt(bctLOGMARS)));
          Items.AddChildObject(child, 'Code 93', Pointer(PtrInt(bctCode93)));
        child := Items.AddChildObject(node, 'Channel code', PChar('TBarcodeChannelCode'));
        child := Items.AddChildObject(node, 'UPC/EAN codes', PChar('TBarcodeEAN'));
          Items.AddChildObject(child, 'EAN-8, EAN-13', Pointer(PtrInt(bctEAN)));
          Items.AddChildObject(child, 'EAN-14', Pointer(PtrInt(bctEAN14)));
          Items.AddChildObject(child, 'ISBN', Pointer(PtrInt(bctISBN)));
          Items.AddChildObject(child, 'NVE-18', Pointer(PtrInt(bctNVE18)));
          Items.AddChildObject(child, 'UPC-A', Pointer(PtrInt(bctUPCA)));
          Items.AddChildObject(child, 'UPC-E', Pointer(PtrInt(bctUPCE)));
        child := Items.AddChildObject(node, 'MSI/Plessey', PChar('TBarcodePlessey'));
          Items.AddChildObject(child, 'Plessey', Pointer(PtrInt(bctPlessey)));
          Items.AddChildObject(child, 'MSI/Plessey', Pointer(PtrInt(bctMSIPlessey)));
        child := Items.AddChildObject(node, 'Telepen', PChar('TBarcodeTelepen'));
          Items.AddChildObject(child, 'Telepen', Pointer(PtrInt(bctTelepen)));
          Items.AddChildObject(child, 'Telepen numeric', Pointer(PtrInt(bctTelepenNum)));
        child := Items.AddChildObject(node, 'Medical/pharmaceutical', PChar('TBarcodeMedical'));
          Items.AddChildObject(child, 'CodaBar', Pointer(PtrInt(bctCodaBar)));
          Items.AddChildObject(child, 'Code32', Pointer(PtrInt(bctCode32)));
          Items.AddChildObject(child, 'Pharma one-track', Pointer(PtrInt(bctPharmaOne)));
          Items.AddChildObject(child, 'Pharma two-track', Pointer(PtrInt(bctPharmaTwo)));
          Items.AddChildObject(child, 'Pharmazentralnummer (7-digit)', Pointer(PtrInt(bctPZN7)));
          Items.AddChildObject(child, 'Pharmazentralnummer (8-digit)', Pointer(PtrInt(bctPZN8)));
        child := Items.AddChildObject(node, 'Postal barcodes', PChar('TBarcodePostal'));
          Items.AddChildObject(child, 'Australia Post Customer', Pointer(PtrInt(bctAustraliaPostCustomer)));
          Items.AddChildObject(child, 'Australia Post Reply Paid', Pointer(PtrInt(bctAustraliaPostReplyPaid)));
          Items.AddChildObject(child, 'Australia Post Routing', Pointer(PtrInt(bctAustraliaPostRoute)));
          Items.AddChildObject(child, 'Australia Post Redirection', Pointer(PtrInt(bctAustraliaPostRedirect)));
          Items.AddChildObject(child, 'DAFT', Pointer(PtrInt(bctDaft)));
          Items.AddChildObject(child, 'Deutsche Post IdentCode', Pointer(PtrInt(bctDeutschePostIdentCode)));
          Items.AddChildObject(child, 'Deutsche Post LeitCode', Pointer(PtrInt(bctDeutschePostLeitCode)));
          Items.AddChildObject(child, 'FIM (Face Identification Mark)', Pointer(PtrInt(bctFIM)));
          Items.AddChildObject(child, 'Japanese Post', Pointer(PtrInt(bctJapanPost)));
          Items.AddChildObject(child, 'KIX', Pointer(PtrInt(bctKix)));
          Items.AddChildObject(child, 'Korea Post', Pointer(PtrInt(bctKoreaPost)));
          Items.AddChildObject(child, 'Planet', Pointer(PtrInt(bctPlanet)));
          Items.AddChildObject(child, 'PostNet', Pointer(PtrInt(bctPostNet)));
          Items.AddChildObject(child, 'Royal Mail RM4SCC', Pointer(PtrInt(bctRM4SCC)));

      node := Items.AddChild(nil, '2-dimensional barcodes');
        child := Items.AddChildObject(node, 'QR Code', PChar('TBarcodeQR'));
        child := Items.AddChildObject(node, 'Micro QR', PChar('TBarcodeMicroQR'));
        child := Items.AddChildObject(node, 'Aztec', PChar('TBarcodeAztec'));
        child := Items.AddChildObject(node, 'Aztec Rune', PChar('TBarcodeAztecRune'));
        child := Items.AddChildObject(node, 'Data Matrix', PChar('TBarcodeDataMatrix'));
        child := Items.AddChildObject(node, 'PDF417 variants', PChar('TBarcodePDF417'));
          Items.AddChildObject(child, 'PDF417', Pointer(PtrInt(bctPDF417)));
          Items.AddChildObject(child, 'Compact PDF417', Pointer(PtrInt(bctPDF417trunc)));
          Items.AddChildObject(child, 'MicroPDF417 (ISO 24728)', Pointer(PtrInt(bctMicroPDF417)));

      FullExpand;
    finally
      Items.EndUpdate;
    end;
  end;
end;

procedure TMainForm.SelectBarcode(ANode: TTreeNode);
var
  barcodeClassName: String;
  barcodeClass: TLazBarcodeClass;
  barcodeType: Integer;
begin
  if (ANode = nil) then
  begin
    if FBarcode <> nil then FBarcode.Hide;
    exit;
  end;

  FreeAndNil(FBarcode);

  // Determine from the node's Data field the class of the barcode to be created
  // and/or the value of the BarcodeType property.
  if (ANode.Level = 1) and not ANode.HasChildren then
    barcodeClassName := PChar(ANode.Data)
  else
  if (ANode.Level = 2) then
  begin
    barcodeClassName := PChar(ANode.Parent.Data);
    barcodeType := {%H-}PtrInt(ANode.Data);
  end else
  begin
    if FBarcode <> nil then FBarcode.Hide;
    exit;
  end;

  // Create barcode from information provided in the node's Data field.
  barcodeClass := TLazBarcodeClass(GetClass(barcodeClassName));
  FBarcode := barcodeClass.Create(self);
  FBarcode.Parent := BarcodePanel;

  // Apply general properties
  FBarcode.Text := edText.Text;
  TBarcodeAccess(FBarcode).Color := clbColor.ButtonColor;
  TBarcodeAccess(FBarcode).BackgroundColor := clbBackground.ButtonColor;
  TBarcodeAccess(FBarcode).ForegroundColor := clbForeground.ButtonColor;
  TBarcodeAccess(FBarcode).Scale := seScale.Value;
  TBarcodeAccess(FBarcode).Margin := seMargin.Value;
  TBarcodeAccess(FBarcode).WhiteSpaceWidth := seWhitespaceWidth.Value;
  TBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex);
  TBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value;
  TBarcodeAccess(FBarcode).RecommendedSymbolSize := cbRecommendedSymbolSize.Checked;

  // Apply specific properties for each barcode class - not very elegant...
  if (FBarcode is TCustomBarcode) then
    TBarcodeAccess(FBarcode).ShowHumanReadableText := cbHumanReadableText.Checked;
  
  if (FBarcode is TSimpleBarCode) then
  begin
    TSimpleBarcodeAccess(FBarcode).AddChecksum := cbAddChecksum.Checked;
    cbAddChecksum.Enabled := IsPublishedProp(FBarcode, 'AddChecksum');
    TSimpleBarcodeAccess(FBarcode).DisplayChecksum := cbDisplayChecksum.Checked;
    cbDisplayChecksum.Enabled := cbAddChecksum.Checked and IsPublishedProp(FBarcode, 'DisplayChecksum');
    if (ANode.Level = 2) then
      TSimpleBarcodeAccess(FBarcode).BarcodeType := TBarcodeType(barcodeType);
  end;

  cbAutoSizeChange(nil);

  // Show options page corresponding to the selected barcode type.
  if (FBarcode is TBarcodePlessey) and (TBarcodePlessey(FBarcode).BarcodeType = bctMSIPlessey) then
    nbOptions.PageIndex := pgOptions_Plessey.PageIndex
  else
  if (FBarcode is TBarcodeQR) then
    nbOptions.PageIndex := pgOptions_QR.PageIndex
  else
    nbOptions.PageIndex := -1;

  // Enable/disable GUI components
  cbHumanReadableText.Enabled := not ((FBarcode is TBarcodeSquare) or (FBarcode is TBarcodePDF417));
  btnFont.Enabled := cbHumanReadableText.Enabled;
  seWhiteSpaceWidth.Enabled := IsPublishedProp(FBarcode, 'WhiteSpaceWidth') and not cbRecommendedSymbolSize.Checked;
  lblWhitespaceWidth.Enabled := seWhiteSpaceWidth.Enabled;
  if FBarcode is TBarcodePDF417 then
  begin
    seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked;
    lblSymbolHeight.Caption := 'Row height ratio';
  end else
  begin
    seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'SymbolHeight');
    lblSymbolHeight.Caption := 'Symbol height';
  end;
  lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
    
  // Show error message from rendering, if available.
  UpdateErrorMsg;
end;

procedure TMainForm.UpdateErrorMsg;
begin
  lblError.Visible := FBarcode.ErrorString <> '';
  lblError.Caption := FBarcode.ErrorString;
  if FBarcode <> nil then
    FBarcode.Visible := not lblError.Visible;
end;

initialization
  RegisterBarcodes;
  
end.

