1 {*******************************************}
2 { }
3 { FastReport v2.3 }
4 { Barcode Add-in object }
5 { }
6 { Copyright (c) 1998-99 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 LR_BarC;
33
34 {$I lr_vers.inc}
35
36 interface
37
38 uses
39 Classes, SysUtils,
40 LCLPlatformDef, InterfaceBase, Graphics, Controls, Forms, Dialogs,
41 Buttons, StdCtrls, Menus, Barcode, ExtCtrls, ButtonPanel,
42 LCLType, LR_Class;
43
44
45 {.$DEFINE BC_1_25} //For Barcode version 1.25 actually in debug
46 type
47 {$IFDEF BC_1_25}
48 TBarCode=Class(TAsBarCode);
49 {$ENDIF}
50
51 { TfrBarCodeObject }
52
53 TfrBarCodeObject = class(TComponent) // fake component
54 public
55 constructor Create(aOwner : TComponent); override;
56 end;
57
58 TfrBarCode = packed record
59 cCheckSum : Boolean;
60 cShowText : Boolean;
61 cCadr : Boolean;
62 cBarType : TBarcodeType;
63 cModul : Integer;
64 cRatio : Double;
65 cAngle : Double;
66 end;
67
68 { TfrCustomBarCodeView }
69
70 TfrCustomBarCodeView = class(TfrView)
71 private
72 BarC: TBarCode;
73 FText: string;
74
GetAnglenull75 function GetAngle: Double;
GetBarTypenull76 function GetBarType: TBarcodeType;
GetCheckSumnull77 function GetCheckSum: Boolean;
GetShowTextnull78 function GetShowText: Boolean;
GetZoomnull79 function GetZoom: Double;
80 procedure SetAngle(AValue: Double);
81 procedure SetBarType(const AValue: TBarcodeType);
82 procedure SetCheckSum(const AValue: Boolean);
83 procedure SetShowText(const AValue: Boolean);
84 procedure SetZoom(const AValue: Double);
CreateBarcodenull85 function CreateBarcode: TBitmap;
CreateLabelFontnull86 function CreateLabelFont(aCanvas: TCanvas): TFont;
87 procedure DrawLabel(aCanvas: TCanvas; R: TRect);
88 public
89 Param: TfrBarCode;
90
91 constructor Create(AOwnerPage:TfrPage);override;
92 destructor Destroy; override;
93 procedure Assign(Source: TPersistent); override;
GenerateBitmapnull94 function GenerateBitmap: TBitmap; virtual;
95 procedure LoadFromStream(Stream: TStream); override;
96 procedure SaveToStream(Stream: TStream); override;
97 procedure Draw(aCanvas: TCanvas); override;
98 procedure Print(Stream: TStream); override;
99 procedure DefinePopupMenu({%H-}Popup: TPopupMenu); override;
100 procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
101 procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
102
103 property CheckSum : Boolean read GetCheckSum write SetCheckSum;
104 property BarType : TBarcodeType read GetBarType write SetBarType;
105 property ShowText : Boolean read GetShowText write SetShowText;
106 property Zoom : Double read GetZoom write SetZoom;
107 property Angle: Double read GetAngle write SetAngle;
108 end;
109
110 TfrBarcodeView = class(TfrCustomBarcodeView)
111 published
112 property CheckSum;
113 property BarType;
114 property ShowText;
115 property Zoom;
116 property Angle;
117 property Memo;
118 property Frames;
119 property FrameColor;
120 property FrameStyle;
121 property FrameWidth;
122 property Restrictions;
123 end;
124
125 { TfrBarCodeForm }
126
127 TfrBarCodeForm = class(TfrObjEditorForm)
128 ButtonPanel1: TButtonPanel;
129 edZoom: TEdit;
130 labZoom: TLabel;
131 M1: TEdit;
132 Label1: TLabel;
133 cbType: TComboBox;
134 Label2: TLabel;
135 Image1: TImage;
136 Panel1: TPanel;
137 DBBtn: TSpeedButton;
138 VarBtn: TSpeedButton;
139 GroupBox1: TGroupBox;
140 ckCheckSum: TCheckBox;
141 ckViewText: TCheckBox;
142 GroupBox2: TGroupBox;
143 RB1: TRadioButton;
144 RB2: TRadioButton;
145 RB3: TRadioButton;
146 RB4: TRadioButton;
147 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
148 procedure FormCreate(Sender: TObject);
149 procedure VarBtnClick(Sender: TObject);
150 procedure DBBtnClick(Sender: TObject);
151 procedure bOkClick(Sender: TObject);
152 procedure FormActivate(Sender: TObject);
153 procedure edZoomKeyPress(Sender: TObject; var Key: char);
154 public
155 procedure ShowEditor(t: TfrView); override;
156 end;
157
158
159 implementation
160
161 {$R *.lfm}
162
163 uses LR_Var, LR_Flds, LR_Const, LR_Utils;
164
165
166 var
167 frBarCodeForm: TfrBarCodeForm;
168
169 const
170 cbDefaultText ='12345678';
171 bcNames: array[bcCode_2_5_interleaved..{$IFNDEF BC_1_25}bcCodeEAN13{$ELSE}bcCodeEAN128C{$ENDIF}, 0..1] of string =
172 (('2_5_interleaved', 'N'),
173 ('2_5_industrial', 'N'),
174 ('2_5_matrix', 'N'),
175 ('Code39', 'A'),
176 ('Code39 Extended', 'A'),
177 ('Code128A', 'A'),
178 ('Code128B', 'A'),
179 ('Code128C', 'N'),
180 ('Code93', 'A'),
181 ('Code93 Extended', 'A'),
182 ('MSI', 'N'),
183 ('PostNet', 'N'),
184 ('Codebar', 'A'),
185 ('EAN8', 'N'),
186 ('EAN13', 'N')
187 {$IFDEF BC_1_25}
188 ,
189 ('UPC A','N'),
190 ('UPC E0','N'),
191 ('UPC E1','N'),
192 ('UPC SUPP 2','N'),
193 ('UPC SUPP 5','N'),
194 ('EAN128A','A'),
195 ('EAN128B','A'),
196 ('EAN128C','N')
197 {$ENDIF}
198 );
199
200 defaultFontSize = 10;
201
202 {$HINTS OFF}
203 {$NOTES OFF}
isNumericnull204 function isNumeric(St: String): Boolean;
205 var
206 {%H-}R: Double;
207 E: Integer;
208 begin
209 Val(St, R, E);
210 Result := (E = 0);
211 end;
212 {$NOTES ON}
213 {$HINTS ON}
214
GetBarTypenull215 function TfrCustomBarCodeView.GetBarType: TBarcodeType;
216 begin
217 Result:=Param.cBarType;
218 end;
219
TfrCustomBarCodeView.GetAnglenull220 function TfrCustomBarCodeView.GetAngle: Double;
221 begin
222 Result := Param.cAngle;
223 end;
224
TfrCustomBarCodeView.GetCheckSumnull225 function TfrCustomBarCodeView.GetCheckSum: Boolean;
226 begin
227 Result:=Param.cCheckSum;
228 end;
229
GetShowTextnull230 function TfrCustomBarCodeView.GetShowText: Boolean;
231 begin
232 Result:=Param.cShowText;
233 end;
234
TfrCustomBarCodeView.GetZoomnull235 function TfrCustomBarCodeView.GetZoom: Double;
236 begin
237 Result:=Param.cRatio;
238 end;
239
240 procedure TfrCustomBarCodeView.SetAngle(AValue: Double);
241 begin
242 if (Param.cAngle<>AValue) and
243 ((AValue=0.0) or (AValue=90.0) or (AValue=180.0) or (AValue=270.0)) then
244 begin
245 BeforeChange;
246 Param.cAngle:=AValue;
247 AfterChange;
248 end;
249 end;
250
251 procedure TfrCustomBarCodeView.SetBarType(const AValue: TBarcodeType);
252 begin
253 if Param.cBarType<>AValue then
254 begin
255 BeforeChange;
256 Param.cBarType:=aValue;
257 AfterChange;
258 end;
259 end;
260
261 procedure TfrCustomBarCodeView.SetCheckSum(const AValue: Boolean);
262 begin
263 if Param.cCheckSum<>AValue then
264 begin
265 BeforeChange;
266 Param.cCheckSum:=aValue;
267 AfterChange;
268 end;
269 end;
270
271 procedure TfrCustomBarCodeView.SetShowText(const AValue: Boolean);
272 begin
273 if Param.cShowText<>AValue then
274 begin
275 BeforeChange;
276 Param.cShowText:=aValue;
277 AfterChange;
278 end;
279 end;
280
281 procedure TfrCustomBarCodeView.SetZoom(const AValue: Double);
282 begin
283 if (Param.cRatio<>AValue) and
284 ((AValue>=1.0)and(Avalue<=4.0)) then
285 begin
286 BeforeChange;
287 Param.cRatio:=aValue;
288 AfterChange;
289 end;
290 end;
291
CreateBarcodenull292 function TfrCustomBarCodeView.CreateBarcode: TBitmap;
293 begin
294
295 Result := nil;
296 if Trim(Memo.Text) = '' then
297 Exit;
298
299 {Assign Barcode text}
300 Memo1.Assign(Memo);
301
302 if (Memo1.Text <> '') and (pos('[',Memo1.Strings[0])=0) and
303 ((bcNames[Param.cBarType, 1] = 'A') or IsNumeric(Memo1.Strings[0]) or
304 Barc.BarcodeTypeChecked(Param.cBarType) ) then
305 begin
306 BarC.Text := Memo1.Strings[0];
307 BarC.Checksum := Param.cCheckSum;
308 end
309 else
310 begin
311 BarC.Text := cbDefaultText;
312 BarC.Checksum := true;
313 end;
314
315 if Trim(BarC.Text)='0' then Exit;
316
317 {Barcode Properties}
318 BarC.Left:= 0;
319 BarC.Top := 0;
320 BarC.Typ := Param.cBarType;
321 BarC.Angle := Param.cAngle;
322 BarC.Ratio := 2; // param.cRatio <>2 renders some codes unreadable
323 BarC.Modul := 1; // param.cModul
324 {$IFDEF BC_1_25}
325 BarC.ShowTextPosition:=stpBottomCenter;
326 BarC.ShowText := bcoNone;
327
328 if FillColor=clNone then
329 BarC.Color:=clWhite
330 else
331 BarC.Color:=FillColor;
332
333 {$ELSE}
334 BarC.ShowText:=False;
335 {$ENDIF}
336
337
338 {Barcode width is determined by type of barcode and text. Update
339 object dimensions to suit barcode}
340
341 if (Param.cAngle = 90) or (Param.cAngle = 270) then
342 dy := BarC.Width
343 else
344 dx := BarC.Width;
345
346
347 if (Param.cAngle = 90) or (Param.cAngle = 270) then
348 BarC.Height := dx
349 else
350 BarC.Height := dy;
351
352 if (BarC.Typ=bcCodePostNet) and (Param.cAngle=0) then
353 begin
354 BarC.Top:=BarC.Height;
355 BarC.Height:=-BarC.Height;
356 end;
357
358 if Param.cAngle = 90 then
359 begin
360 BarC.Top:= Round(Height);
361 BarC.Left:=0;
362 end
363 else
364 if Param.cAngle = 180 then
365 begin
366 BarC.Top:= dy;
367 BarC.Left:= dx;
368 end
369 else
370 if Param.cAngle = 270 then
371 begin
372 BarC.Top:= 0;
373 BarC.Left:= dx;
374 end;
375
376 Result:=TBitMap.Create;
377
378 Result.Width:=dx;
379 Result.Height:=dy;
380 Result.Canvas.Brush.Style:=bsSolid;
381 Result.Canvas.Brush.Color:=clWhite;
382 Result.Canvas.FillRect(Rect(0,0,dx,dy));
383
384 try
385 BarC.DrawBarcode(Result.Canvas);
386 if BarC.Checksum then
387 FText := BarC.CodeText
388 else
389 FText := BarC.Text;
390 except on E: Exception do
391 FText := E.Message
392 end;
393
394
395 end;
396
CreateLabelFontnull397 function TfrCustomBarCodeView.CreateLabelFont(aCanvas: TCanvas) :TFont;
398 begin
399 with aCanvas do
400 begin
401 Result := TFont.Create;
402 Result.Assign(aCanvas.Font);
403 Result.Color := clBlack;
404 Result.Name := 'Arial';
405 Result.Style := [];
406 Result.Size := -defaultFontSize;
407
408 if Param.cAngle = 90 then
409 Result.Orientation := 900
410 else
411 if Param.cAngle = 180 then
412 Result.Orientation := 1800
413 else
414 if Param.cAngle = 270 then
415 Result.Orientation := 2700
416 else
417 Result.Orientation := 0;
418 end;
419
420 end;
421
422
423 procedure TfrCustomBarCodeView.DrawLabel(aCanvas: TCanvas; R: TRect);
424 var fs: integer;
425 begin
426 if Param.cShowText then
427 begin
428 with aCanvas do
429 begin
430 fs := Font.Height;
431
432 if Param.cAngle = 0 then
433 begin
434 Brush.Color:=clWhite;
435 Brush.Style:=bsSolid;
436 FillRect(Rect(R.Left,R.Top + dy-fs ,R.Right, R.Bottom));
437 TextOut(R.Left + (dx - TextWidth(FText)) div 2, R.Top + dy - fs, FText);
438 end
439 else
440 if Param.cAngle = 90 then
441 begin
442 Brush.Color:=clWhite;
443 Brush.Style:=bsSolid;
444 FillRect(Rect(R.Left + dx - fs,R.Top,R.Right, R.Bottom));
445 Font.Orientation := 900;
446
447 TextOut(R.Right - fs,R.Bottom - (dy - TextWidth(FText)) div 2, FText)
448 end
449 else
450 if Param.cAngle = 180 then
451 begin
452 Brush.Color:=clWhite;
453 Brush.Style:=bsSolid;
454 FillRect(Rect(R.Left,R.Top,R.Right,R.Top + fs));
455 Font.Orientation := 1800;
456 TextOut(R.left + (dx + TextWidth(FText)) div 2, R.Top + fs, FText);
457 end
458 else
459 begin
460 Brush.Color:=clWhite;
461 Brush.Style:=bsSolid;
462 Font.Orientation := 2700;
463 FillRect(Rect(R.Left,R.Top,R.Left + fs,R.Bottom));
464 if (WidgetSet.LCLPlatform = lpGtk2) and IsPrinting then
465 TextOut(R.Left + fs, R.Top + (dy -TextWidth(FText)) div 2, FText)
466 end;
467 end;
468 end;
469
470 end;
471
472 constructor TfrCustomBarCodeView.Create(AOwnerPage: TfrPage);
473 begin
474 inherited Create(AOwnerPage);
475
476 BarC := TBarCode.Create(nil);
477 Param.cCheckSum := True;
478 Param.cShowText := True;
479 Param.cCadr := False;
480 Param.cBarType := bcCode39;
481 Param.cModul := 2;
482 Param.cRatio := 1;
483 Param.cAngle := 0;
484 Memo.Add(cbDefaultText);
485 Typ := gtAddIn;
486 BaseName := 'Bar';
487 end;
488
489 destructor TfrCustomBarCodeView.Destroy;
490 begin
491 BarC.Free;
492 inherited Destroy;
493 end;
494
495 procedure TfrCustomBarCodeView.Assign(Source: TPersistent);
496 begin
497 inherited Assign(Source);
498 if Source is TfrCustomBarCodeView then
499 Param := TfrCustomBarCodeView(Source).Param;
500 end;
501
GenerateBitmapnull502 function TfrCustomBarCodeView.GenerateBitmap: TBitmap;
503 var
504 R: TRect;
505 barcodeFont: TFont;
506 oldFont: TFont;
507 begin
508 Result := CreateBarcode;
509 R := Rect(0,0, Result.Width,Result.Height);
510 barcodeFont := CreateLabelFont(Result.Canvas);
511 try
512 oldFont := Result.Canvas.Font;
513 Result.Canvas.Font := barcodeFont;
514 DrawLabel(Result.Canvas,r)
515 finally
516 Result.Canvas.Font := oldFont;
517 barcodeFont.Free
518 end;
519 end;
520
521 procedure TfrCustomBarCodeView.LoadFromStream(Stream:TStream);
522 begin
523 inherited LoadFromStream(Stream);
524 Stream.Read(Param, SizeOf(Param));
525 end;
526
527 procedure TfrCustomBarCodeView.SaveToStream(Stream:TStream);
528 begin
529 inherited SaveToStream(Stream);
530 Stream.Write(Param, SizeOf(Param));
531 end;
532
533 procedure TfrCustomBarCodeView.Draw(aCanvas:TCanvas);
534 var
535 Bmp : TBitMap;
536 R: TRect;
537 fh: integer;
538 barcodeFont: TFont;
539 oldFont: TFont;
540 begin
541 BeginDraw(aCanvas);
542
543 Bmp := CreateBarcode;
544 if Bmp <> nil then
545 try
546 // dx/dy is calculated in CreateBarCode using as base
547 // barcdode type, angle, zoom and data
548 if (Param.cAngle = 90) or (Param.cAngle = 270) then
549 dy := round(dy * param.cRatio)
550 else
551 dx := round(dx * Param.cRatio);
552 CalcGaps;
553 ShowBackground;
554 if Param.cShowText then
555 begin
556 barcodeFont := CreateLabelFont(aCanvas);
557 try
558 oldFont := aCanvas.Font;
559 aCanvas.Font := barcodeFont;
560 if not IsPrinting then
561 begin
562 if (Param.cAngle = 90) or (Param.cAngle = 270) then
563 ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleX)
564 else
565 ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleY);
566 fh := Round(aCanvas.Font.Height);
567 end
568 else
569 fh := aCanvas.Font.Height;
570
571 if (Param.cAngle = 90) then
572 R := Rect(DRect.Left,DRect.Top,
573 DRect.Right - fh,
574 DRect.Bottom)
575 else
576 if (Param.cAngle = 180) then
577 R := Rect(DRect.Left,DRect.Top + fh,
578 DRect.Right ,
579 DRect.Bottom)
580 else
581 if (Param.cAngle = 270) then
582 R := Rect(DRect.Left + fh,
583 DRect.Top,
584 DRect.Right,
585 DRect.Bottom)
586 else
587 R := Rect(DRect.Left,DRect.Top,
588 DRect.Right ,
589 DRect.Bottom - fh);
590 aCanvas.StretchDraw(R,Bmp);
591 DrawLabel(aCanvas, DRect);
592 finally
593 aCanvas.Font := oldFont;
594 barcodeFont.Free
595 end;
596 end
597 else
598 aCanvas.StretchDraw(DRect,Bmp);
599
600 ShowFrame;
601
602 finally
603 Bmp.Free;
604 RestoreCoord;
605 end;
606 end;
607
608 procedure TfrCustomBarCodeView.Print(Stream: TStream);
609 begin
610 BeginDraw(Canvas);
611 Memo1.Assign(Memo);
612 CurReport.InternalOnEnterRect(Memo1, Self);
613 frInterpretator.DoScript(Script);
614 if not Visible then Exit;
615
616 if Memo1.Count > 0 then
617 if (Length(Memo1[0]) > 0) and (Pos('[',Memo1[0])<>0) then
618 Memo1[0] := frParser.Calc(Memo1[0]);
619 Stream.Write(Typ, 1);
620 frWriteString(Stream, ClassName);
621 SaveToStream(Stream);
622 end;
623
624 procedure TfrCustomBarCodeView.DefinePopupMenu(Popup: TPopupMenu);
625 begin
626 // no specific items in popup menu
627 end;
628
629 procedure TfrCustomBarCodeView.LoadFromXML(XML: TLrXMLConfig; const Path: String);
630 begin
631 inherited LoadFromXML(XML, Path);
632
633 RestoreProperty('BarType',XML.GetValue(Path+'BarCode/BarType',''));
634 RestoreProperty('ShowText',XML.GetValue(Path+'BarCode/ShowText',''));
635 RestoreProperty('CheckSum',XML.GetValue(Path+'BarCode/CheckSum',''));
636 RestoreProperty('Zoom',XML.GetValue(Path+'BarCode/Zoom','1'));
637 RestoreProperty('Angle',XML.GetValue(Path+'BarCode/Angle','0'));
638 end;
639
640 procedure TfrCustomBarCodeView.SaveToXML(XML: TLrXMLConfig; const Path: String);
641 begin
642 inherited SaveToXML(XML, Path);
643
644 XML.SetValue(Path+'BarCode/BarType', GetSaveProperty('BarType'));
645 XML.SetValue(Path+'BarCode/ShowText', GetSaveProperty('ShowText'));
646 XML.SetValue(Path+'BarCode/CheckSum', GetSaveProperty('CheckSum'));
647 XML.SetValue(Path+'BarCode/Zoom', GetSaveProperty('Zoom'));
648 XML.SetValue(Path+'BarCode/Angle', GetSaveProperty('Angle'));
649 end;
650
651 //--------------------------------------------------------------------------
652 procedure TfrBarCodeForm.FormCreate(Sender: TObject);
653 var
654 i: TBarcodeType;
655 begin
656 CbType.Items.Clear;
657 for i := bcCode_2_5_interleaved to {$IFNDEF BC_1_25}bcCodeEAN13{$ELSE}bcCodeEAN128C{$ENDIF} do
658 cbType.Items.Add(bcNames[i, 0]);
659 cbType.ItemIndex := 0;
660
661 Caption := sBarCodeFormTitle;
662 Label1.Caption := sBarCodeFormCode;
663 Label2.Caption := sBarCodeFormType;
664 GroupBox1.Caption := sBarCodeFormOpts;
665 ckCheckSum.Caption := sBarCodeFormChksum;
666 ckViewText.Caption := sBarCodeFormReadable;
667 DBBtn.Hint := sBarCodeFormDbFld;
668 VarBtn.Hint := sBarCodeFormVar;
669 GroupBox2.Caption := sBarCodeFormRotate;
670 labZoom.Caption:=sBarCodeZoom;
671 end;
672
673 procedure TfrBarCodeForm.FormClose(Sender: TObject;
674 var CloseAction: TCloseAction);
675 begin
676 if ModalResult = mrOk then
677 bOkClick(nil);
678 end;
679
680 procedure TfrBarCodeForm.FormActivate(Sender: TObject);
681 begin
682 M1.SetFocus;
683 end;
684
685 procedure TfrBarCodeForm.edZoomKeyPress(Sender: TObject; var Key: char);
686 begin
687 If (Key>#31) and not (Key in ['0'..'9','.']) then {AJW}
688 Key:=#0;
689 end;
690
691 procedure TfrBarCodeForm.ShowEditor(t:TfrView);
692 var
693 tmp:Double;
694 begin
695 if t.Memo.Count > 0 then
696 M1.Text := t.Memo.Strings[0];
697 with t as TfrBarCodeView do
698 begin
699 cbType.ItemIndex := ord(Param.cBarType);
700 ckCheckSum.checked := Param.cCheckSum;
701 ckViewText.Checked := Param.cShowText;
702 if Param.cAngle = 0 then
703 RB1.Checked := True
704 else if Param.cAngle = 90 then
705 RB2.Checked := True
706 else if Param.cAngle = 180 then
707 RB3.Checked := True
708 else
709 RB4.Checked := True;
710 edZoom.Text:=SysUtils.Format('%.1f',[Param.cRatio]);
711
712 if ShowModal = mrOk then
713 begin
714 Memo.Clear;
715 Memo.Add(M1.Text);
716 CheckSum := ckCheckSum.Checked;
717 ShowText := ckViewText.Checked;
718 BarType := TBarcodeType(cbType.ItemIndex);
719 tmp := StrToFloatDef(edZoom.Text,1);
720 if tmp<1.0 then
721 tmp:=1.0;
722 Zoom := tmp;
723
724 if RB1.Checked then
725 Angle := 0
726 else if RB2.Checked then
727 Angle := 90
728 else if RB3.Checked then
729 Angle := 180
730 else
731 Angle := 270;
732 end;
733 end;
734 end;
735
736 procedure TfrBarCodeForm.VarBtnClick(Sender: TObject);
737 begin
738 frVarForm := TfrVarForm.Create(nil);
739 with frVarForm do
740 if ShowModal = mrOk then
741 if SelectedItem <> '' then
742 M1.Text := '[' + SelectedItem + ']';
743 frVarForm.Free;
744 M1.SetFocus;
745 end;
746
747 procedure TfrBarCodeForm.DBBtnClick(Sender: TObject);
748 begin
749 frFieldsForm := TfrFieldsForm.Create(nil);
750 with frFieldsForm do
751 if ShowModal = mrOk then
752 if DBField <> '' then
753 M1.Text := '[' + DBField + ']';
754 frFieldsForm.Free;
755 M1.SetFocus;
756 end;
757
758 procedure TfrBarCodeForm.bOkClick(Sender: TObject);
759 var
760 bc: TBarCode;
761 Bmp: TBitmap;
762 begin
763 Bmp := nil;
764 bc := TBarCode.Create(nil);
765 try
766 if Pos('[',M1.Text) <> 0 then
767 begin
768 bc.Text := cbDefaultText;
769 bc.checksum := true
770 end
771 else
772 begin
773 bc.Text := M1.Text;
774 bc.CheckSum := ckCheckSum.Checked;
775 end;
776 bc.Ratio := StrToFloatDef(edZoom.Text,1);
777 bc.Typ := TBarcodeType(cbType.ItemIndex);
778 Bmp := TBitmap.Create;
779 Bmp.Width := 16; Bmp.Height := 16;
780 try
781 Bmp.Canvas.Brush.Style:=bsSolid;
782 Bmp.Canvas.Brush.Color:=clWhite;
783 Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
784
785 bc.DrawBarcode(Bmp.Canvas);
786 except
787 MessageDlg(sBarcodeError,mtError,[mbOk],0);
788 ModalResult := 0;
789 end;
790 finally
791 Bmp.Free;
792 bc.Free;
793 end;
794 end;
795
796 procedure InitializeBarcAddin;
797 begin
798 if not assigned(frBarCodeForm) {and not (csDesigning in ComponentState)} then
799 begin
800 frBarCodeForm := TfrBarCodeForm.Create(nil);
801 frSetAddinEditor(TfrBarcodeView, frBarcodeForm);
802 frSetAddinIcon(TfrBarcodeView, frBarCodeForm.Image1.Picture.Bitmap);
803 frSetAddinHint(TfrBarcodeView, sInsBarcode);
804 end;
805 end;
806
807 { TfrBarCodeObject }
808
809 constructor TfrBarCodeObject.Create(aOwner: TComponent);
810 begin
811 inherited Create(aOwner);
812 InitializeBarcAddin;
813 end;
814
815 initialization
816 frBarcodeForm := nil;
817 frRegisterObject(TfrBarCodeView, nil, '', nil, @InitializeBarcAddin);
818
819 finalization
820 if Assigned(frBarCodeForm) then
821 frBarCodeForm.Free;
822
823 end.
824