home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_BarC.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  10KB  |  427 lines
  1. {*******************************************}
  2. {                                           }
  3. {          FastReport CLX v2.4              }
  4. {         Barcode Add-in object             }
  5. {                                           }
  6. { Copyright (c) 1998-2001 by Tzyganenko A.  }
  7. {                                           }
  8.  
  9. //  Barcode Component
  10. //  Version 1.3
  11. //  Copyright 1998-99 Andreas Schmidt and friends
  12.  
  13. //  Freeware
  14.  
  15. //  for use with Delphi 2/3/4
  16.  
  17.  
  18. //  this component is for private use only!
  19. //  i am not responsible for wrong barcodes
  20. //  Code128C not implemented
  21.  
  22. //  bug-reports, enhancements:
  23. //  mailto:shmia@bizerba.de or
  24. //  a_j_schmidt@rocketmail.com
  25.  
  26. {  Fr_BarC:     Guilbaud Olivier            }
  27. {               golivier@worldnet.fr        }
  28. {  Ported to FR2.3: Alexander Tzyganenko    }
  29. {                                           }
  30. {*******************************************}
  31.  
  32. unit FR_BarC;
  33.  
  34. interface
  35.  
  36. uses
  37.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  38.   QStdCtrls, QMenus, frBarcod, FR_Class, QExtCtrls, FR_Ctrls, QButtons;
  39.  
  40. type
  41.   TfrBarCodeObject = class(TComponent)  // fake component
  42.   end;
  43.  
  44.   TfrBarCodeRec = packed record
  45.     cCheckSum : Boolean;
  46.     cShowText : Boolean;
  47.     cCadr     : Boolean;
  48.     cBarType  : TfrBarcodeType;
  49.     cModul    : Integer;
  50.     cRatio    : Double;
  51.     cAngle    : Double;
  52.   end;
  53.  
  54.   TfrBarCodeView = class(TfrView)
  55.   private
  56.     BarC: TfrBarCode;
  57.     procedure BarcodeEditor(Sender: TObject);
  58.   public
  59.     Param: TfrBarCodeRec;
  60.     constructor Create; override;
  61.     destructor Destroy; override;
  62.     procedure LoadFromStream(Stream: TStream); override;
  63.     procedure SaveToStream(Stream: TStream); override;
  64.     procedure Draw(Canvas: TCanvas); override;
  65.     procedure StreamOut(Stream: TStream); override;
  66.     procedure DefinePopupMenu(Popup: TPopupMenu); override;
  67.     procedure DefineProperties; override;
  68.     procedure ShowEditor; override;
  69.   end;
  70.  
  71.   TfrBarCodeForm = class(TForm)
  72.     bCancel: TButton;
  73.     bOk: TButton;
  74.     M1: TfrComboEdit;
  75.     Label1: TLabel;
  76.     cbType: TComboBox;
  77.     Label2: TLabel;
  78.     Image1: TImage;
  79.     GroupBox1: TGroupBox;
  80.     ckCheckSum: TCheckBox;
  81.     ckViewText: TCheckBox;
  82.     GroupBox2: TGroupBox;
  83.     RB1: TRadioButton;
  84.     RB2: TRadioButton;
  85.     RB3: TRadioButton;
  86.     RB4: TRadioButton;
  87.     Label3: TLabel;
  88.     eZoom: TEdit;
  89.     Panel1: TPanel;
  90.     frSpeedButton1: TfrSpeedButton;
  91.     frSpeedButton2: TfrSpeedButton;
  92.     procedure FormCreate(Sender: TObject);
  93.     procedure bOkClick(Sender: TObject);
  94.     procedure FormActivate(Sender: TObject);
  95.     procedure ExprBtnClick(Sender: TObject);
  96.     procedure frSpeedButton1Click(Sender: TObject);
  97.     procedure frSpeedButton2Click(Sender: TObject);
  98.   private
  99.     procedure Localize;
  100.   public
  101.   end;
  102.  
  103.  
  104. implementation
  105.  
  106. uses FR_Const, FR_Utils;
  107.  
  108. {$R *.xfm}
  109. {$R *.res}
  110.  
  111. const
  112.   cbDefaultText = '12345678';
  113.  
  114.  
  115. {$HINTS OFF}
  116. function isNumeric(St: String): Boolean;
  117. var
  118.   R: Double;
  119.   E: Integer;
  120. begin
  121.   Val(St, R, E);
  122.   Result := (E = 0);
  123. end;
  124. {$HINTS ON}
  125.  
  126. constructor TfrBarCodeView.Create;
  127. begin
  128.   inherited Create;
  129.  
  130.   BarC := TfrBarCode.Create(nil);
  131.   Param.cCheckSum := True;
  132.   Param.cShowText := True;
  133.   Param.cCadr     := False;
  134.   Param.cBarType  := bcCode39;
  135.   Param.cModul    := 1;
  136.   Param.cRatio    := 2;
  137.   Param.cAngle    := 0;
  138.   Memo.Add(cbDefaultText);
  139.   BaseName := 'Bar';
  140. end;
  141.  
  142. destructor TfrBarCodeView.Destroy;
  143. begin
  144.   BarC.Free;
  145.   inherited Destroy;
  146. end;
  147.  
  148. procedure TfrBarCodeView.DefineProperties;
  149. begin
  150.   inherited DefineProperties;
  151.   AddProperty('Barcode', [frdtHasEditor, frdtOneObject], BarcodeEditor);
  152.   AddProperty('DataField', [frdtOneObject, frdtHasEditor, frdtString], frFieldEditor);
  153. end;
  154.  
  155. procedure TfrBarCodeView.LoadFromStream(Stream:TStream);
  156. begin
  157.   inherited LoadFromStream(Stream);
  158.   Stream.Read(Param, SizeOf(Param));
  159. end;
  160.  
  161. procedure TfrBarCodeView.SaveToStream(Stream:TStream);
  162. begin
  163.   inherited SaveToStream(Stream);
  164.   Stream.Write(Param, SizeOf(Param));
  165. end;
  166.  
  167. procedure TfrBarCodeView.Draw(Canvas: TCanvas);
  168. var
  169.   Txt: String;
  170.   hg: Integer;
  171.   EMF: TBitmap;
  172. begin
  173.   if (dx < 0) or (dy < 0) then Exit;
  174.   BeginDraw(Canvas);
  175.   Memo1.Assign(Memo);
  176.  
  177.   if (Memo1.Count > 0) and (Memo1[0][1] <> '[') then
  178.     Txt := Memo1[0] else
  179.     Txt := cbDefaultText;
  180.   Param.cAngle := 0;
  181.   BarC.Angle := Param.cAngle;
  182.   BarC.Ratio := Param.cRatio;
  183.   BarC.Modul := Param.cModul;
  184.   BarC.Checksum := Param.cCheckSum;
  185.   if FillColor = clNone then
  186.     BarC.Color := clWhite else
  187.     BarC.Color := FillColor;
  188.   BarC.Typ := Param.cBarType;
  189.   if bcData[Param.cBarType].Num = False then
  190.     BarC.Text := Txt
  191.   else if IsNumeric(Txt) then
  192.     BarC.Text := Txt else
  193.     BarC.Text := cbDefaultText;
  194.   if (Param.cAngle = 90) or (Param.cAngle = 270) then
  195.     dy := BarC.Width else
  196.     dx := BarC.Width;
  197.  
  198.   if Trim(BarC.Text) = '0' then Exit;
  199.  
  200.   if (Param.cAngle = 90) or (Param.cAngle = 270) then
  201.     if Param.cShowText then
  202.       hg := dx - 14 else
  203.       hg := dx
  204.   else if Param.cShowText then
  205.       hg := dy - 14 else
  206.       hg := dy;
  207.   BarC.Left := 0;
  208.   BarC.Top := 0;
  209.   BarC.Height := hg;
  210.   if Param.cAngle = 180 then
  211.     BarC.Top := dy - hg
  212.   else if Param.cAngle = 270 then
  213.     BarC.Left := dx - hg;
  214.  
  215.   EMF := TBitmap.Create;
  216.   EMF.Width := dx;
  217.   EMF.Height := dy;
  218.   with EMF.Canvas do
  219.   begin
  220.     Brush.Color := FillColor;
  221.     FillRect(Rect(0, 0, dx, dy));
  222.   end;
  223.   BarC.DrawBarcode(EMF.Canvas);
  224.   Txt := BarC.Text;
  225.  
  226.   if Param.cShowText then
  227.   with EMF.Canvas do
  228.   begin
  229.     Font.Color := clBlack;
  230.     Font.Name := 'Courier New';
  231.     Font.Height := -12;
  232.     Font.Style := [];
  233.     if Param.cAngle = 0 then
  234.       TextOut((dx - TextWidth(Txt)) div 2, dy - 12, Txt)
  235.     else if Param.cAngle = 90 then
  236.       TextOut(dx - 12, dy - (dy - TextWidth(Txt)) div 2, Txt)
  237.     else if Param.cAngle = 180 then
  238.       TextOut(dx - (dx - TextWidth(Txt)) div 2, 12, Txt)
  239.     else
  240.       TextOut(12, (dy - TextWidth(Txt)) div 2, Txt);
  241.   end;
  242.  
  243.   CalcGaps;
  244.   ShowBackground;
  245.   Canvas.StretchDraw(DRect, EMF);
  246.   EMF.Free;
  247.   ShowFrame;
  248.   RestoreCoord;
  249. end;
  250.  
  251. procedure TfrBarCodeView.StreamOut(Stream: TStream);
  252. var
  253.   SaveTag: String;
  254. begin
  255.   BeginDraw(Canvas);
  256.   Memo1.Assign(Memo);
  257.   CurReport.InternalOnEnterRect(Memo1, Self);
  258.   frInterpretator.DoScript(Script);
  259.   if not Visible then Exit;
  260.  
  261.   SaveTag := Tag;
  262.   if (Tag <> '') and (Pos('[', Tag) <> 0) then
  263.     ExpandVariables(Tag);
  264.  
  265.   if Memo1.Count > 0 then
  266.     if (Length(Memo1[0]) > 0) and (Memo1[0][1] = '[') then
  267.     try
  268.       Memo1[0] := frParser.Calc(Memo1[0]);
  269.     except
  270.       Memo1[0] := '0';
  271.     end;
  272.  
  273.   Stream.Write(Typ, 1);
  274.   frWriteString(Stream, ClassName);
  275.   SaveToStream(Stream);
  276.  
  277.   Tag := SaveTag;
  278. end;
  279.  
  280. procedure TfrBarCodeView.DefinePopupMenu(Popup: TPopupMenu);
  281. begin
  282.   // no specific items in popup menu
  283. end;
  284.  
  285. procedure TfrBarCodeView.BarcodeEditor(Sender: TObject);
  286. begin
  287.   ShowEditor;
  288. end;
  289.  
  290. procedure TfrBarCodeView.ShowEditor;
  291. begin
  292.   with TfrBarcodeForm.Create(nil) do
  293.   begin
  294.     if Memo.Count > 0 then
  295.       M1.Text := Memo.Strings[0];
  296.     cbType.ItemIndex   := ord(Param.cBarType);
  297.     ckCheckSum.checked := Param.cCheckSum;
  298.     ckViewText.Checked := Param.cShowText;
  299.     eZoom.Text := IntToStr(Param.cModul);
  300.     if Param.cAngle = 0 then
  301.       RB1.Checked := True
  302.     else if Param.cAngle = 90 then
  303.       RB2.Checked := True
  304.     else if Param.cAngle = 180 then
  305.       RB3.Checked := True
  306.     else
  307.       RB4.Checked := True;
  308.     if ShowModal = mrOk then
  309.     begin
  310.       frDesigner.BeforeChange;
  311.       Memo.Clear;
  312.       Memo.Add(M1.Text);
  313.       Param.cModul := StrToInt(eZoom.Text);
  314.       Param.cCheckSum  := ckCheckSum.Checked;
  315.       Param.cShowText  := ckViewText.Checked;
  316.       Param.cBarType := TfrBarcodeType(cbType.ItemIndex);
  317.       if RB1.Checked then
  318.         Param.cAngle := 0
  319.       else if RB2.Checked then
  320.         Param.cAngle := 90
  321.       else if RB3.Checked then
  322.         Param.cAngle := 180
  323.       else
  324.         Param.cAngle := 270;
  325.     end;
  326.     Free;
  327.   end;
  328. end;
  329.  
  330.  
  331. //--------------------------------------------------------------------------
  332. procedure TfrBarCodeForm.Localize;
  333. begin
  334.   Caption := (S53650);
  335.   Label1.Caption := (S53651);
  336.   Label2.Caption := (S53652);
  337.   Label3.Caption := (S53659);
  338.   GroupBox1.Caption := (S53653);
  339.   ckCheckSum.Caption := (S53654);
  340.   ckViewText.Caption := (S53655);
  341.   M1.ButtonHint := (S53656);
  342.   GroupBox2.Caption := (S53658);
  343.   bOk.Caption := (SOk);
  344.   bCancel.Caption := (SCancel);
  345. end;
  346.  
  347. procedure TfrBarCodeForm.FormCreate(Sender: TObject);
  348. var
  349.   i: TfrBarcodeType;
  350. begin
  351.   Localize;
  352.   CbType.Items.Clear;
  353.   for i := bcCode_2_5_interleaved to bcCodeEAN128C do
  354.     cbType.Items.Add(bcData[i].Name);
  355.   cbType.ItemIndex := 0;
  356. end;
  357.  
  358. procedure TfrBarCodeForm.FormActivate(Sender: TObject);
  359. begin
  360.   M1.SetFocus;
  361. end;
  362.  
  363. procedure TfrBarCodeForm.ExprBtnClick(Sender: TObject);
  364. var
  365.   s: String;
  366. begin
  367.   s := frDesigner.InsertExpression;
  368.   if s <> '' then
  369.     M1.Text := s;
  370. end;
  371.  
  372. procedure TfrBarCodeForm.bOkClick(Sender: TObject);
  373. var
  374.   bc: TfrBarCode;
  375.   Bmp: TBitmap;
  376. begin
  377.   bc := TfrBarCode.Create(nil);
  378.   bc.Text := M1.Text;
  379.   bc.CheckSum  := ckCheckSum.Checked;
  380.   bc.Typ := TfrBarcodeType(cbType.ItemIndex);
  381.   Bmp := TBitmap.Create;
  382.   Bmp.Width := 16; Bmp.Height := 16;
  383.   if (bc.Text = '') or (bc.Text[1] <> '[') then
  384.     try
  385.       bc.DrawBarcode(Bmp.Canvas);
  386.     except
  387.       Application.MessageBox(SBarcodeError, SError,
  388.         [smbOk], smsCritical);
  389.       ModalResult := 0;
  390.     end;
  391.   Bmp.Free;
  392. end;
  393.  
  394.  
  395. var
  396.   Bmp: TBitmap;
  397.  
  398. procedure TfrBarCodeForm.frSpeedButton1Click(Sender: TObject);
  399. var
  400.   i: Integer;
  401. begin
  402.   i := StrToInt(eZoom.Text);
  403.   Inc(i);
  404.   eZoom.Text := IntToStr(i);
  405. end;
  406.  
  407. procedure TfrBarCodeForm.frSpeedButton2Click(Sender: TObject);
  408. var
  409.   i: Integer;
  410. begin
  411.   i := StrToInt(eZoom.Text);
  412.   Dec(i);
  413.   if i <= 0 then i := 1;
  414.   eZoom.Text := IntToStr(i);
  415. end;
  416.  
  417. initialization
  418.   Bmp := TBitmap.Create;
  419.   Bmp.LoadFromResourceName(hInstance, 'FR_BARCODEVIEW');
  420.   frRegisterObject(TfrBarCodeView, Bmp, (SInsBarcode));
  421.  
  422. finalization
  423.   Bmp.Free;
  424.  
  425.  
  426. end.
  427.