80
81
procedure SetCheckSum(const AValue: Boolean);
81
82
procedure SetShowText(const AValue: Boolean);
82
83
procedure SetZoom(const AValue: Double);
84
function CreateBarcode: TBitmap;
85
function CreateLabelFont(aCanvas: TCanvas): TFont;
86
procedure DrawLabel(aCanvas: TCanvas; R: TRect);
86
90
constructor Create; override;
87
91
destructor Destroy; override;
88
92
procedure Assign(From: TfrView); override;
93
function GenerateBitmap: TBitmap;
89
94
procedure LoadFromStream(Stream: TStream); override;
90
95
procedure SaveToStream(Stream: TStream); override;
91
96
procedure Draw(aCanvas: TCanvas); override;
92
97
procedure Print(Stream: TStream); override;
93
procedure DefinePopupMenu(Popup: TPopupMenu); override;
94
function GenerateBitmap: TBitmap;
98
procedure DefinePopupMenu({%H-}Popup: TPopupMenu); override;
96
100
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
97
101
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
241
constructor TfrBarCodeView.Create;
245
BarC := TBarCode.Create(nil);
246
Param.cCheckSum := True;
247
Param.cShowText := True;
248
Param.cCadr := False;
249
Param.cBarType := bcCode39;
253
Memo.Add(cbDefaultText);
258
destructor TfrBarCodeView.Destroy;
264
procedure TfrBarCodeView.Assign(From:TfrView);
266
inherited Assign(From);
267
Param := (From as TfrBarCodeView).Param;
270
procedure TfrBarCodeView.LoadFromStream(Stream:TStream);
272
inherited LoadFromStream(Stream);
273
Stream.Read(Param, SizeOf(Param));
276
procedure TfrBarCodeView.SaveToStream(Stream:TStream);
278
inherited SaveToStream(Stream);
279
Stream.Write(Param, SizeOf(Param));
282
function TfrBarCodeView.GenerateBitmap: TBitmap;
287
newdx,newdy : Integer;
248
function TfrBarCodeView.CreateBarcode: TBitmap;
252
if Trim(Memo.Text) = '' then
255
{Assign Barcode text}
289
256
Memo1.Assign(Memo);
291
if (Memo1.Count>0) and (Memo1[0][1]<>'[') then
292
Txt := Memo1.Strings[0]
258
if (Memo1.Text <> '') and (pos('[',Memo1.Strings[0])=0) and
259
((bcNames[Param.cBarType, 1] = 'A') or IsNumeric(Memo1.Strings[0]) or
260
Barc.BarcodeTypeChecked(Param.cBarType) ) then
262
BarC.Text := Memo1.Strings[0];
263
BarC.Checksum := Param.cCheckSum;
294
Txt := cbDefaultText;
267
BarC.Text := cbDefaultText;
268
BarC.Checksum := true;
271
if Trim(BarC.Text)='0' then Exit;
296
276
BarC.Typ := Param.cBarType;
297
277
BarC.Angle := Param.cAngle;
298
BarC.Ratio := 2; //Param.cRatio;
299
BarC.Modul := 1; //Param.cModul;
300
BarC.Checksum := Param.cCheckSum;
278
BarC.Ratio := 2; // param.cRatio <>2 renders some codes unreadable
279
BarC.Modul := 1; // param.cModul
302
281
BarC.ShowTextPosition:=stpBottomCenter;
303
282
BarC.ShowText := bcoNone;
370
335
Result.Height:=dy;
371
336
Result.Canvas.Brush.Style:=bsSolid;
372
337
Result.Canvas.Brush.Color:=clWhite;
373
Result.Canvas.FillRect(Rect(0,0,Dx,Dy));
375
BarC.DrawBarcode(Result.Canvas);
338
Result.Canvas.FillRect(Rect(0,0,dx,dy));
341
BarC.DrawBarcode(Result.Canvas);
342
if BarC.Checksum then
343
FText := BarC.CodeText
346
except on E: Exception do
353
function TfrBarCodeView.CreateLabelFont(aCanvas: TCanvas) :TFont;
357
Result := TFont.Create;
358
Result.Assign(aCanvas.Font);
359
Result.Color := clBlack;
360
Result.Name := 'Arial';
362
Result.Size := -defaultFontSize;
364
if Param.cAngle = 90 then
365
Result.Orientation := 900
367
if Param.cAngle = 180 then
368
Result.Orientation := 1800
370
if Param.cAngle = 270 then
371
Result.Orientation := 2700
373
Result.Orientation := 0;
379
procedure TfrBarCodeView.DrawLabel(aCanvas: TCanvas; R: TRect);
377
382
if Param.cShowText then
379
with Result.Canvas do
381
Font.Color := clBlack;
382
Font.Name := 'Courier New';
386
388
if Param.cAngle = 0 then
388
390
Brush.Color:=clWhite;
389
391
Brush.Style:=bsSolid;
390
FillRect(Rect(0,dy-12,dx,dy));
391
TextOut((dx - TextWidth(Txt)) div 2, dy - 12, Txt);
392
FillRect(Rect(R.Left,R.Top + dy-fs ,R.Right, R.Bottom));
393
TextOut(R.Left + (dx - TextWidth(FText)) div 2, R.Top + dy - fs, FText);
394
396
if Param.cAngle = 90 then
396
398
Brush.Color:=clWhite;
397
399
Brush.Style:=bsSolid;
398
FillRect(Rect(dx - 12,0,dx,dy));
400
FillRect(Rect(R.Left + dx - fs,R.Top,R.Right, R.Bottom));
401
Font.Orientation := 900;
400
TextOut(dx - 12, dy - (dy - TextWidth(Txt)) div 2, Txt);
403
if (WidgetSet.LCLPlatform = lpGtk2) and IsPrinting then
404
{GTK2 vertical printing correction}
405
TextOut(R.Right ,R.Bottom - fs - (dy - TextWidth(FText)) div 2, FText)
407
TextOut(R.Right - fs,R.Bottom - (dy - TextWidth(FText)) div 2, FText)
403
410
if Param.cAngle = 180 then
405
412
Brush.Color:=clWhite;
406
413
Brush.Style:=bsSolid;
407
FillRect(Rect(0,0,dx,12));
409
TextOut((dx - TextWidth(Txt)) div 2, 1, Txt);
414
FillRect(Rect(R.Left,R.Top,R.Right,R.Top + fs));
415
Font.Orientation := 1800;
416
TextOut(R.left + (dx + TextWidth(FText)) div 2, R.Top + fs, FText);
413
420
Brush.Color:=clWhite;
414
421
Brush.Style:=bsSolid;
415
FillRect(Rect(0,0,12,dy));
417
//here text it's write in barcode :o( TextOut(12, (dy - TextWidth(Txt)) div 2, Txt);
422
Font.Orientation := 2700;
423
FillRect(Rect(R.Left,R.Top,R.Left + fs,R.Bottom));
424
if (WidgetSet.LCLPlatform = lpGtk2) and IsPrinting then
425
{GTK2 vertical printing correction}
426
TextOut(R.Left, R.Top + fs + (dy -TextWidth(FText)) div 2, FText)
428
TextOut(R.Left + fs, R.Top + (dy -TextWidth(FText)) div 2, FText)
435
constructor TfrBarCodeView.Create;
439
BarC := TBarCode.Create(nil);
440
Param.cCheckSum := True;
441
Param.cShowText := True;
442
Param.cCadr := False;
443
Param.cBarType := bcCode39;
447
Memo.Add(cbDefaultText);
452
destructor TfrBarCodeView.Destroy;
458
procedure TfrBarCodeView.Assign(From:TfrView);
460
inherited Assign(From);
461
Param := (From as TfrBarCodeView).Param;
464
function TfrBarCodeView.GenerateBitmap: TBitmap;
467
Result := CreateBarcode;
468
R := Rect(0,0, Result.Width,Result.Height);
469
DrawLabel(Result.Canvas,r)
472
procedure TfrBarCodeView.LoadFromStream(Stream:TStream);
474
inherited LoadFromStream(Stream);
475
Stream.Read(Param, SizeOf(Param));
478
procedure TfrBarCodeView.SaveToStream(Stream:TStream);
480
inherited SaveToStream(Stream);
481
Stream.Write(Param, SizeOf(Param));
426
484
procedure TfrBarCodeView.Draw(aCanvas:TCanvas);
430
492
BeginDraw(aCanvas);
432
Bmp := GenerateBitmap;
494
Bmp := CreateBarcode;
497
// dx/dy is calculated in CreateBarCode using as base
498
// barcdode type, angle, zoom and data
499
if (Param.cAngle = 90) or (Param.cAngle = 270) then
500
dy := round(dy * param.cRatio)
502
dx := round(dx * Param.cRatio);
436
aCanvas.StretchDraw(DRect,Bmp);
505
if Param.cShowText then
507
barcodeFont := CreateLabelFont(aCanvas);
509
oldFont := aCanvas.Font;
510
aCanvas.Font := barcodeFont;
511
if not IsPrinting then
513
if (Param.cAngle = 90) or (Param.cAngle = 270) then
514
ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleX)
516
ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleY);
517
fh := Round(aCanvas.Font.Height);
520
fh := aCanvas.Font.Height;
522
if (Param.cAngle = 90) then
523
R := Rect(DRect.Left,DRect.Top,
527
if (Param.cAngle = 180) then
528
R := Rect(DRect.Left,DRect.Top + fh,
532
if (Param.cAngle = 270) then
533
R := Rect(DRect.Left + fh,
538
R := Rect(DRect.Left,DRect.Top,
541
aCanvas.StretchDraw(R,Bmp);
542
DrawLabel(aCanvas, DRect);
544
aCanvas.Font := oldFont;
549
aCanvas.StretchDraw(DRect,Bmp);
445
559
procedure TfrBarCodeView.Print(Stream: TStream);
596
710
bc := TBarCode.Create(nil);
598
bc.CheckSum := ckCheckSum.Checked;
599
bc.Typ := TBarcodeType(cbType.ItemIndex);
600
Bmp := TBitmap.Create;
601
Bmp.Width := 16; Bmp.Height := 16;
603
Bmp.Canvas.Brush.Style:=bsSolid;
604
Bmp.Canvas.Brush.Color:=clWhite;
605
Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
607
bc.DrawBarcode(Bmp.Canvas);
609
MessageDlg(sBarcodeError,mtError,[mbOk],0);
712
if Pos('[',M1.Text) <> 0 then
714
bc.Text := cbDefaultText;
720
bc.CheckSum := ckCheckSum.Checked;
722
bc.Ratio := StrToFloatDef(edZoom.Text,1);
723
bc.Typ := TBarcodeType(cbType.ItemIndex);
724
Bmp := TBitmap.Create;
725
Bmp.Width := 16; Bmp.Height := 16;
727
Bmp.Canvas.Brush.Style:=bsSolid;
728
Bmp.Canvas.Brush.Color:=clWhite;
729
Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
731
bc.DrawBarcode(Bmp.Canvas);
733
MessageDlg(sBarcodeError,mtError,[mbOk],0);
742
procedure InitializeBarcAddin;
744
if not assigned(frBarCodeForm) {and not (csDesigning in ComponentState)} then
746
frBarCodeForm := TfrBarCodeForm.Create(nil);
747
frSetAddinEditor(TfrBarcodeView, frBarcodeForm);
748
frSetAddinIcon(TfrBarcodeView, frBarCodeForm.Image1.Picture.Bitmap);
749
frSetAddinHint(TfrBarcodeView, sInsBarcode);
616
753
{ TfrBarCodeObject }
618
755
constructor TfrBarCodeObject.Create(aOwner: TComponent);
620
757
inherited Create(aOwner);
622
if not assigned(frBarCodeForm) {and not (csDesigning in ComponentState)} then
624
frBarCodeForm := TfrBarCodeForm.Create(nil);
625
frRegisterObject(TfrBarCodeView, frBarCodeForm.Image1.Picture.Bitmap,
626
sInsBarcode, frBarCodeForm);
762
frBarcodeForm := nil;
763
frRegisterObject(TfrBarCodeView, nil, '', nil, @InitializeBarcAddin);
634
766
if Assigned(frBarCodeForm) then
635
767
frBarCodeForm.Free;