pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

lazbarcodes: Add method to copy a barcode image to clipboard.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5038 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-26 17:40:08 +00:00
parent 990112f3ff
commit c9fc88a06e
1 changed files with 22 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
components/lazbarcodes/src/ubarcodes.pas
View File

@ -39,6 +39,7 @@ protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CopyToClipboard(AWidth: Integer = -1; AHeight: Integer = -1);
procedure PaintOnCanvas(const aTargetCanvas: TCanvas; const aRect: TRect);
procedure Generate; virtual; abstract;
published
@ -124,6 +125,9 @@ procedure Register;
implementation
uses
clipbrd;
procedure Register;
begin
{$I tbarcodeqr.lrs}
@ -296,6 +300,24 @@ begin
inherited Destroy;
end;
procedure TLazBarcodeCustomBase.CopyToClipboard(AWidth, AHeight: Integer);
var
bmp: TBitmap;
begin
if AWidth = -1 then AWidth := Width;
if AHeight = -1 then AHeight := Height;
bmp := TBitmap.Create;
try
bmp.SetSize(AWidth, AHeight);
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(0, 0, AWidth, AHeight);
PaintOnCanvas(bmp.Canvas, Rect(0, 0, AWidth, AHeight));
Clipboard.Assign(bmp);
finally
bmp.Free;
end;
end;
procedure TLazBarcodeCustomBase.PaintOnCanvas(const aTargetCanvas: TCanvas;
const aRect: TRect);
begin