diff --git a/components/lazreport/source/lr_barc.lfm b/components/lazreport/source/lr_barc.lfm index 30ea0dca72..cdf42b2afb 100644 --- a/components/lazreport/source/lr_barc.lfm +++ b/components/lazreport/source/lr_barc.lfm @@ -16,14 +16,14 @@ object frBarCodeForm: TfrBarCodeForm OnCreate = FormCreate Position = poScreenCenter ShowHint = True - LCLVersion = '0.9.29' + LCLVersion = '0.9.31' object Label1: TLabel AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner Left = 6 - Height = 16 + Height = 14 Top = 6 - Width = 34 + Width = 26 BorderSpacing.Around = 6 Caption = 'Code' ParentColor = False @@ -33,9 +33,9 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideTop.Control = M1 AnchorSideTop.Side = asrBottom Left = 6 - Height = 16 - Top = 55 - Width = 70 + Height = 14 + Top = 53 + Width = 57 BorderSpacing.Around = 6 Caption = 'Type of bar' ParentColor = False @@ -67,7 +67,7 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideRight.Side = asrBottom Left = 6 Height = 21 - Top = 28 + Top = 26 Width = 341 HelpContext = 260 Anchors = [akTop, akLeft, akRight] @@ -81,20 +81,20 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 6 - Height = 29 - Top = 77 + Height = 21 + Top = 73 Width = 341 HelpContext = 261 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 6 - ItemHeight = 0 + ItemHeight = 13 Style = csDropDownList TabOrder = 1 end object Panel1: TPanel - Left = 251 + Left = 310 Height = 17 - Top = 26 + Top = 8 Width = 34 BevelOuter = bvNone ClientHeight = 17 @@ -102,12 +102,11 @@ object frBarCodeForm: TfrBarCodeForm FullRepaint = False TabOrder = 2 object DBBtn: TSpeedButton - Left = -2 + Left = 0 Height = 17 Top = 0 Width = 17 Caption = 'D' - Color = clBtnFace Margin = 4 NumGlyphs = 0 OnClick = DBBtnClick @@ -118,7 +117,6 @@ object frBarCodeForm: TfrBarCodeForm Top = 0 Width = 17 Caption = 'V' - Color = clBtnFace NumGlyphs = 0 OnClick = VarBtnClick end @@ -130,24 +128,24 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideRight.Control = Owner AnchorSideRight.Side = asrBottom Left = 6 - Height = 78 - Top = 112 + Height = 71 + Top = 100 Width = 341 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Around = 6 Caption = 'Options' - ClientHeight = 62 - ClientWidth = 339 + ClientHeight = 53 + ClientWidth = 337 TabOrder = 3 object labZoom: TLabel AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = GroupBox1 - Left = 149 - Height = 16 + Left = 155 + Height = 14 Top = 6 - Width = 40 + Width = 27 BorderSpacing.Around = 6 Caption = 'Zoom' ParentColor = False @@ -156,9 +154,9 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideLeft.Control = GroupBox1 AnchorSideTop.Control = GroupBox1 Left = 6 - Height = 22 + Height = 17 Top = 6 - Width = 95 + Width = 69 HelpContext = 262 BorderSpacing.Around = 6 Caption = 'Checksum ' @@ -169,9 +167,9 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideTop.Control = ckCheckSum AnchorSideTop.Side = asrBottom Left = 6 - Height = 22 - Top = 34 - Width = 131 + Height = 17 + Top = 29 + Width = 96 HelpContext = 263 BorderSpacing.Around = 6 Caption = 'Human readable' @@ -181,9 +179,9 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideLeft.Control = labZoom AnchorSideTop.Control = labZoom AnchorSideTop.Side = asrBottom - Left = 155 + Left = 161 Height = 21 - Top = 28 + Top = 26 Width = 77 BorderSpacing.Around = 6 OnKeyPress = edZoomKeyPress @@ -199,66 +197,71 @@ object frBarCodeForm: TfrBarCodeForm AnchorSideRight.Side = asrBottom Left = 6 Height = 65 - Top = 196 + Top = 177 Width = 341 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 6 Caption = 'Orientation' - ClientHeight = 49 - ClientWidth = 339 + ClientHeight = 47 + ClientWidth = 337 TabOrder = 4 object RB1: TRadioButton Left = 8 - Height = 22 + Height = 17 Top = 16 - Width = 36 + Width = 27 HelpContext = 264 Caption = '0 ' Checked = True - State = cbChecked TabOrder = 0 + TabStop = True end object RB2: TRadioButton Left = 72 - Height = 22 + Height = 17 Top = 16 - Width = 44 + Width = 33 HelpContext = 264 Caption = '90 ' TabOrder = 1 - TabStop = False end object RB3: TRadioButton Left = 136 - Height = 22 + Height = 17 Top = 16 - Width = 52 + Width = 39 HelpContext = 264 Caption = '180 ' TabOrder = 2 - TabStop = False end object RB4: TRadioButton Left = 200 - Height = 22 + Height = 17 Top = 16 - Width = 52 + Width = 39 HelpContext = 264 Caption = '270 ' TabOrder = 3 - TabStop = False end end object ButtonPanel1: TButtonPanel Left = 6 - Height = 38 - Top = 293 + Height = 34 + Top = 297 Width = 341 OKButton.Name = 'OKButton' + OKButton.Caption = '&OK' + OKButton.DefaultCaption = False HelpButton.Name = 'HelpButton' + HelpButton.Caption = '&Help' + HelpButton.DefaultCaption = False CloseButton.Name = 'CloseButton' + CloseButton.Caption = '&Close' + CloseButton.DefaultCaption = False CloseButton.Enabled = False CancelButton.Name = 'CancelButton' + CancelButton.Caption = 'Cancel' + CancelButton.DefaultCaption = False TabOrder = 5 ShowButtons = [pbOK, pbCancel, pbHelp] end diff --git a/components/lazreport/source/lr_barc.pas b/components/lazreport/source/lr_barc.pas index 68f3f66803..7c1c7495c9 100644 --- a/components/lazreport/source/lr_barc.pas +++ b/components/lazreport/source/lr_barc.pas @@ -71,6 +71,7 @@ type TfrBarCodeView = class(TfrView) private BarC: TBarCode; + FText: string; function GetBarType: TBarcodeType; function GetCheckSum: Boolean; @@ -80,18 +81,21 @@ type procedure SetCheckSum(const AValue: Boolean); procedure SetShowText(const AValue: Boolean); procedure SetZoom(const AValue: Double); + function CreateBarcode: TBitmap; + function CreateLabelFont(aCanvas: TCanvas): TFont; + procedure DrawLabel(aCanvas: TCanvas; R: TRect); public Param: TfrBarCode; constructor Create; override; destructor Destroy; override; procedure Assign(From: TfrView); override; + function GenerateBitmap: TBitmap; procedure LoadFromStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override; procedure Draw(aCanvas: TCanvas); override; procedure Print(Stream: TStream); override; procedure DefinePopupMenu(Popup: TPopupMenu); override; - function GenerateBitmap: TBitmap; procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override; procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override; @@ -145,7 +149,7 @@ implementation {$R *.lfm} -uses LR_Var, LR_Flds, LR_Const, LR_Utils; +uses LR_Var, LR_Flds, LR_Const, LR_Utils, InterfaceBase; var @@ -182,6 +186,7 @@ const {$ENDIF} ); + defaultFontSize = 10; {$HINTS OFF} function isNumeric(St: String): Boolean; @@ -238,6 +243,187 @@ begin invalidate; end; +function TfrBarCodeView.CreateBarcode: TBitmap; +begin + + Result := nil; + if Trim(Memo.Text) = '' then + Exit; + + {Assign Barcode text} + Memo1.Assign(Memo); + + if (Memo1.Text <> '') and (Memo1.Strings[0][1]<>'[') and + ((bcNames[Param.cBarType, 1] = 'A') or IsNumeric(Memo1.Strings[0])) then + begin + BarC.Text := Memo1.Strings[0]; + BarC.Checksum := Param.cCheckSum; + end + else + begin + BarC.Text := cbDefaultText; + BarC.Checksum := true; + end; + + if Trim(BarC.Text)='0' then Exit; + + {Barcode Properties} + BarC.Left:= 0; + BarC.Top := 0; + BarC.Typ := Param.cBarType; + BarC.Angle := Param.cAngle; + BarC.Ratio := 2.1; //Param.cRatio; + BarC.Modul := 1; //Param.cModul; + {$IFDEF BC_1_25} + BarC.ShowTextPosition:=stpBottomCenter; + BarC.ShowText := bcoNone; + + if FillColor=clNone then + BarC.Color:=clWhite + else + BarC.Color:=FillColor; + + {$ELSE} + BarC.ShowText:=False; + {$ENDIF} + + + {Barcode width is determined by type of barcode and text. Update + object dimensions to suit barcode} + + if (Param.cAngle = 90) or (Param.cAngle = 270) then + dy := BarC.Width + else + dx := BarC.Width; + + + if (Param.cAngle = 90) or (Param.cAngle = 270) then + BarC.Height := dx + else + BarC.Height := dy; + + if (BarC.Typ=bcCodePostNet) and (Param.cAngle=0) then + begin + BarC.Top:=BarC.Height; + BarC.Height:=-BarC.Height; + end; + + if Param.cAngle = 90 then + begin + BarC.Top:= Round(Height); + BarC.Left:=0; + end + else + if Param.cAngle = 180 then + begin + BarC.Top:= dy; + BarC.Left:= dx; + end + else + if Param.cAngle = 270 then + begin + BarC.Top:= 0; + BarC.Left:= dx; + end; + + Result:=TBitMap.Create; + + Result.Width:=dx; + Result.Height:=dy; + Result.Canvas.Brush.Style:=bsSolid; + Result.Canvas.Brush.Color:=clWhite; + Result.Canvas.FillRect(Rect(0,0,dx,dy)); + + try + BarC.DrawBarcode(Result.Canvas); + FText := BarC.Text; + except on E: Exception do + FText := E.Message + end; + + +end; + +function TfrBarCodeView.CreateLabelFont(aCanvas: TCanvas) :TFont; +begin + with aCanvas do + begin + Result := TFont.Create; + Result.Assign(aCanvas.Font); + Result.Color := clBlack; + Result.Name := 'Arial'; + Result.Style := []; + Result.Size := -defaultFontSize; + + if Param.cAngle = 90 then + Result.Orientation := 900 + else + if Param.cAngle = 180 then + Result.Orientation := 1800 + else + if Param.cAngle = 270 then + Result.Orientation := 2700; + end; + +end; + + +procedure TfrBarCodeView.DrawLabel(aCanvas: TCanvas; R: TRect); +var fs: integer; +begin + if Param.cShowText then + begin + with aCanvas do + begin + fs := Font.Height; + + if Param.cAngle = 0 then + begin + Brush.Color:=clWhite; + Brush.Style:=bsSolid; + FillRect(Rect(R.Left,R.Top + dy-fs ,R.Right, R.Bottom)); + TextOut(R.Left + (dx - TextWidth(FText)) div 2, R.Top + dy - fs, FText); + end + else + if Param.cAngle = 90 then + begin + Brush.Color:=clWhite; + Brush.Style:=bsSolid; + FillRect(Rect(R.Left + dx - fs,R.Top,R.Right, R.Bottom)); + Font.Orientation := 900; + + if (WidgetSet.LCLPlatform = lpGtk2) and IsPrinting then + {GTK2 vertical printing correction} + TextOut(R.Right ,R.Bottom - fs - (dy - TextWidth(FText)) div 2, FText) + else + TextOut(R.Right - fs,R.Bottom - (dy - TextWidth(FText)) div 2, FText) + end + else + if Param.cAngle = 180 then + begin + Brush.Color:=clWhite; + Brush.Style:=bsSolid; + FillRect(Rect(R.Left,R.Top,R.Right,R.Top + fs)); + Font.Orientation := 1800; + TextOut(R.left + (dx + TextWidth(FText)) div 2, R.Top + fs, FText); + end + else + begin + Brush.Color:=clWhite; + Brush.Style:=bsSolid; + Font.Orientation := 2700; + FillRect(Rect(R.Left,R.Top,R.Left + fs,R.Bottom)); + if (WidgetSet.LCLPlatform = lpGtk2) and IsPrinting then + {GTK2 vertical printing correction} + TextOut(R.Left, R.Top + fs + (dy -TextWidth(FText)) div 2, FText) + else + TextOut(R.Left + fs, R.Top + (dy -TextWidth(FText)) div 2, FText) + end; + end; + end; + +end; + constructor TfrBarCodeView.Create; begin inherited Create; @@ -267,6 +453,14 @@ begin Param := (From as TfrBarCodeView).Param; end; +function TfrBarCodeView.GenerateBitmap: TBitmap; +var R: TRect; +begin + Result := CreateBarcode; + R := Rect(0,0, Result.Width,Result.Height); + DrawLabel(Result.Canvas,r) +end; + procedure TfrBarCodeView.LoadFromStream(Stream:TStream); begin inherited LoadFromStream(Stream); @@ -279,165 +473,70 @@ begin Stream.Write(Param, SizeOf(Param)); end; -function TfrBarCodeView.GenerateBitmap: TBitmap; -var - Txt: String; - hg: Integer; - h, oldh: HFont; - newdx,newdy : Integer; -begin - Memo1.Assign(Memo); - - if (Memo1.Count>0) and (Memo1[0][1]<>'[') then - Txt := Memo1.Strings[0] - else - Txt := cbDefaultText; - - BarC.Typ := Param.cBarType; - BarC.Angle := Param.cAngle; - BarC.Ratio := 2; //Param.cRatio; - BarC.Modul := 1; //Param.cModul; - BarC.Checksum := Param.cCheckSum; - {$IFDEF BC_1_25} - BarC.ShowTextPosition:=stpBottomCenter; - BarC.ShowText := bcoNone; - - if FillColor=clNone then - BarC.Color:=clWhite - else - BarC.Color:=FillColor; - - {$ELSE} - BarC.ShowText:=False; - {$ENDIF} - - if bcNames[Param.cBarType, 1] = 'A' then - BarC.Text := Txt - else - begin - if IsNumeric(Txt) then - BarC.Text := Txt - else - BarC.Text := cbDefaultText; - end; - - - newdx:=dx; - newdy:=dy; - if (Param.cAngle = 90) or (Param.cAngle = 270) then - begin - dy := BarC.Width; - newdy:=Round(dy*Param.cRatio); - end - else - begin - dx := BarC.Width; - newdx:=Round(dx*Param.cRatio); - end; - - if Trim(BarC.Text)='0' then Exit; - - if (Param.cAngle = 90) or (Param.cAngle = 270) then - if Param.cShowText then - hg := dx - 14 - else - hg := dx - else - if Param.cShowText then - hg := dy - 14 - else - hg := dy; - - BarC.Left:=0; - BarC.Top :=0; - BarC.Height:=hg; - - if (BarC.Typ=bcCodePostNet) and (Param.cAngle=0) then - begin - BarC.Top:=hg; - BarC.Height:=-hg; - end; - - if Param.cAngle = 180 then - BarC.Top:=dy-hg - else - if Param.cAngle = 270 then - BarC.Left:=dx-hg; - - Result:=TBitMap.Create; - - Result.Width:=dx; - Result.Height:=dy; - Result.Canvas.Brush.Style:=bsSolid; - Result.Canvas.Brush.Color:=clWhite; - Result.Canvas.FillRect(Rect(0,0,Dx,Dy)); - - BarC.DrawBarcode(Result.Canvas); - - if Param.cShowText then - begin - with Result.Canvas do - begin - Font.Color := clBlack; - Font.Name := 'Courier New'; - Font.Height := -12; - Font.Style := []; - - if Param.cAngle = 0 then - begin - Brush.Color:=clWhite; - Brush.Style:=bsSolid; - FillRect(Rect(0,dy-12,dx,dy)); - TextOut((dx - TextWidth(Txt)) div 2, dy - 12, Txt); - end - else - if Param.cAngle = 90 then - begin - Brush.Color:=clWhite; - Brush.Style:=bsSolid; - FillRect(Rect(dx - 12,0,dx,dy)); - - TextOut(dx - 12, dy - (dy - TextWidth(Txt)) div 2, Txt); - end - else - if Param.cAngle = 180 then - begin - Brush.Color:=clWhite; - Brush.Style:=bsSolid; - FillRect(Rect(0,0,dx,12)); - - TextOut((dx - TextWidth(Txt)) div 2, 1, Txt); - end - else - begin - Brush.Color:=clWhite; - Brush.Style:=bsSolid; - FillRect(Rect(0,0,12,dy)); - - //here text it's write in barcode :o( TextOut(12, (dy - TextWidth(Txt)) div 2, Txt); - end; - end; - end; - - dx:=newdx; - dy:=newdy; -end; - procedure TfrBarCodeView.Draw(aCanvas:TCanvas); var Bmp : TBitMap; + R: TRect; + fh: integer; + barcodeFont: TFont; + oldFont: TFont; begin BeginDraw(aCanvas); - Bmp := GenerateBitmap; + Bmp := CreateBarcode; + if Bmp <> nil then try CalcGaps; ShowBackground; - aCanvas.StretchDraw(DRect,Bmp); + if Param.cShowText then + begin + barcodeFont := CreateLabelFont(aCanvas); + try + oldFont := aCanvas.Font; + aCanvas.Font := barcodeFont; + if not IsPrinting then + begin + if (Param.cAngle = 90) or (Param.cAngle = 270) then + ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleX) + else + ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleY); + fh := Round(aCanvas.Font.Height); + end + else + fh := aCanvas.Font.Height; + + if (Param.cAngle = 90) then + R := Rect(DRect.Left,DRect.Top, + DRect.Right - fh, + DRect.Bottom) + else + if (Param.cAngle = 180) then + R := Rect(DRect.Left,DRect.Top + fh, + DRect.Right , + DRect.Bottom) + else + if (Param.cAngle = 270) then + R := Rect(DRect.Left + fh, + DRect.Top, + DRect.Right, + DRect.Bottom) + else + R := Rect(DRect.Left,DRect.Top, + DRect.Right , + DRect.Bottom - fh); + aCanvas.StretchDraw(R,Bmp); + DrawLabel(aCanvas, DRect); + finally + aCanvas.Font := oldFont; + barcodeFont.Free + end; + end + else + aCanvas.StretchDraw(DRect,Bmp); finally - Bmp.Free; + Bmp.Free end; - + ShowFrame; RestoreCoord; end; @@ -520,7 +619,7 @@ end; procedure TfrBarCodeForm.edZoomKeyPress(Sender: TObject; var Key: char); begin - If (Key>#31) and not (Key in ['0'..'9']) then + If (Key>#31) and not (Key in ['0'..'9','.']) then {AJW} Key:=#0; end; @@ -541,7 +640,7 @@ begin RB3.Checked := True else RB4.Checked := True; - edZoom.Text:=SysUtils.Format('%.0f',[Param.cRatio]); + edZoom.Text:=SysUtils.Format('%.1f',[Param.cRatio]); if ShowModal = mrOk then begin @@ -594,8 +693,17 @@ var Bmp: TBitmap; begin bc := TBarCode.Create(nil); - bc.Text := M1.Text; - bc.CheckSum := ckCheckSum.Checked; + if Pos('[',M1.Text) = 1 then + begin + bc.Text := cbDefaultText; + bc.checksum := true + end + else + begin + bc.Text := M1.Text; + bc.CheckSum := ckCheckSum.Checked; + end; + bc.Ratio := StrToFloatDef(edZoom.Text,1); bc.Typ := TBarcodeType(cbType.ItemIndex); Bmp := TBitmap.Create; Bmp.Width := 16; Bmp.Height := 16; @@ -619,17 +727,23 @@ constructor TfrBarCodeObject.Create(aOwner: TComponent); begin inherited Create(aOwner); +(* if not assigned(frBarCodeForm) {and not (csDesigning in ComponentState)} then + begin + frBarCodeForm := TfrBarCodeForm.Create(nil); + frRegisterObject(TfrBarCodeView, frBarCodeForm.Image1.Picture.Bitmap, + sInsBarcode, frBarCodeForm); + end;*) +end; + +initialization + +// frBarCodeForm:=nil; if not assigned(frBarCodeForm) {and not (csDesigning in ComponentState)} then begin frBarCodeForm := TfrBarCodeForm.Create(nil); frRegisterObject(TfrBarCodeView, frBarCodeForm.Image1.Picture.Bitmap, sInsBarcode, frBarCodeForm); end; -end; - -initialization - - frBarCodeForm:=nil; finalization if Assigned(frBarCodeForm) then frBarCodeForm.Free;