353 lines
11 KiB
Plaintext
353 lines
11 KiB
Plaintext
(*
|
|
Copyright (c) 1998-2016 by Carlotta Calandra. All rights reserved.
|
|
Copyright (c) 2011-2016 by Xequte Software.
|
|
|
|
This software comes without express or implied warranty.
|
|
In no case shall the author be liable for any damage or unwanted behavior of any
|
|
computer hardware and/or software.
|
|
|
|
Author grants you the right to include the component
|
|
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.
|
|
|
|
ImageEn, IEvolution and ImageEn ActiveX may not be included in any
|
|
commercial, shareware or freeware libraries or components.
|
|
|
|
www.ImageEn.com
|
|
*)
|
|
|
|
unit QRImageEn;
|
|
|
|
interface
|
|
|
|
{$I ie.inc}
|
|
|
|
uses Windows, Messages, classes, Graphics, ImageEnView, ImageEnio,
|
|
hyiedefs, QuickRpt, hyieutils, ieview;
|
|
|
|
type
|
|
TQRImageEn = class(TQRPrintable)
|
|
private
|
|
fCenter: boolean; // centra immagine se più piccola della client
|
|
fFit: boolean;
|
|
fZoom: integer;
|
|
fViewX: integer;
|
|
fViewY: integer;
|
|
fBitmapInfoHeader256: TBitmapInfoHeader256; // usato internamente da PaintTo e DrawTo
|
|
fHDrawDib: HDRAWDIB; // per disegno su schermo
|
|
fShadowSize: integer;
|
|
fShadowType: TIEShadowType;
|
|
fGammaCorrection: double;
|
|
fBitmap: TBitmap; // riferimento alla bitmap (se fImageEnView è valido vale FImageEnView.bitmap)
|
|
fImageEnView: TIEView; // riferimento a TIEView (fbitmap=fimageenview.bitmap)
|
|
BitmapChangeHandle: pointer; // bitmap change index (-1=nothing)
|
|
fImageBorder: boolean; // per bordo a filo immagine
|
|
fImageShadow: boolean; // ombra sul bordo dell'immagine (false=ombra sul frame)
|
|
procedure FitZoom(bmpww, bmphh, ww, hh: integer);
|
|
procedure SetAttachedBitmap(atBitmap: TBitmap);
|
|
procedure SetAttachedImageEn(atImageEn: TIEView);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure OnBitmapChange(Sender: TObject; destroying: boolean);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Paint; override;
|
|
procedure Print(OfsX, OfsY : integer); override;
|
|
property AttachedBitmap: TBitmap read fBitmap write SetAttachedBitmap;
|
|
property Bitmap: TBitmap read fBitmap write fBitmap;
|
|
published
|
|
property Fit: boolean read fFit write fFit default true;
|
|
property Center: boolean read fCenter write fCenter default true;
|
|
property ShadowSize: integer read fShadowSize write fShadowSize default 8;
|
|
property ShadowType: TIEShadowType read fShadowType write fShadowType default iestSmooth2;
|
|
property GammaCorrection: double read fGammaCorrection write fGammaCorrection;
|
|
property AttachedImageEn: TIEView read fImageEnView write SetAttachedImageEn;
|
|
property ImageBorder: boolean read fImageBorder write fImageBorder default true;
|
|
property ImageShadow: boolean read fImageShadow write fImageShadow default true;
|
|
end;
|
|
|
|
{$ifndef IEREGISTERQR}
|
|
procedure Register;
|
|
{$endif}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, QRDBImageEn, ImageEnProc, iexBitmaps;
|
|
|
|
|
|
{$ifndef IEREGISTERQR}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('ImageEn', [TQRImageEn]);
|
|
end;
|
|
{$endif}
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
constructor TQRImageEn.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ZeroMemory(@fBitmapInfoHeader256, sizeof(TBitmapInfoHeader256));
|
|
fZoom := 100;
|
|
fCenter := True;
|
|
fFit := True;
|
|
fViewX := 0;
|
|
fViewY := 0;
|
|
fHDrawDib := IEDrawDibOpen;
|
|
fShadowSize := 8;
|
|
fShadowType := iestSmooth2;
|
|
fGammaCorrection := 1;
|
|
fBitmap := nil;
|
|
fImageEnView := nil;
|
|
fImageBorder := true;
|
|
fImageShadow := true;
|
|
BitmapChangeHandle := nil;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
destructor TQRImageEn.Destroy;
|
|
begin
|
|
IEDrawDibClose(fHDrawDib);
|
|
if assigned(fImageEnView) then
|
|
fImageEnView.RemoveBitmapChangeEvent(BitmapChangeHandle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure TQRImageEn.Paint;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
Pen.Color := Frame.Color;
|
|
Pen.Width := Frame.Width;
|
|
Pen.Style := Frame.Style;
|
|
MoveTo(0, 0);
|
|
LineTo(width, height);
|
|
MoveTo(0, height);
|
|
LineTo(width, 0);
|
|
end;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure DoGammaCorrection(Gamma: double; fBitmap: TBitmap);
|
|
const
|
|
Inv255 = 1.0 / 255;
|
|
var
|
|
i, x, y: Integer;
|
|
px: PRGB;
|
|
InvGamma: double;
|
|
lut: array [0..255] of byte;
|
|
begin
|
|
InvGamma := 1.0/Gamma;
|
|
// Build LUT
|
|
for i := 0 to 255 do
|
|
lut[i] := blimit(round(255*Power(i*Inv255, InvGamma)));
|
|
//
|
|
for y := 0 to fBitmap.Height-1 do
|
|
begin
|
|
px := fBitmap.Scanline[y];
|
|
for x := 0 to fBitmap.Width-1 do
|
|
begin
|
|
with px^ do
|
|
begin
|
|
r := lut[r];
|
|
g := lut[g];
|
|
b := lut[b];
|
|
end;
|
|
inc(px);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure TQRImageEn.Print(OfsX, OfsY : integer);
|
|
var
|
|
XBitmap: TBitmap;
|
|
CalcLeft, CalcTop, CalcRight, CalcBottom : integer;
|
|
fOffX, fOffY: integer; // inizio visualizzazione (solo per imm. centrate)
|
|
fExtX, fExtY: integer; // estensione visualizzazione
|
|
fZZWW, fZZHH: integer; // dimensioni bitmap zoommata
|
|
ww, hh: integer; // width & height
|
|
o1x, o1y, o2x, o2y: integer;
|
|
rr: double;
|
|
begin
|
|
if not assigned(fBitmap) then
|
|
exit;
|
|
XBitmap := TBitmap.Create;
|
|
IECopyBitmap(fBitmap, XBitmap);
|
|
if (XBitmap.Width>0) and (XBitmap.Height>0) then
|
|
begin
|
|
if fGammaCorrection<>1 then
|
|
DoGammaCorrection(fGammaCorrection, XBitmap);
|
|
with ParentReport.QRPrinter do
|
|
begin
|
|
CalcLeft := XPos(OfsX + Size.Left)+1;
|
|
if Frame.DrawLeft then
|
|
inc(CalcLeft, Frame.Width);
|
|
CalcTop := YPos(OfsY + Size.Top)+1;
|
|
if Frame.DrawTop then
|
|
inc(CalcTop, Frame.Width);
|
|
CalcRight := XPos(OfsX + Size.Left + Size.Width)-1;
|
|
if Frame.DrawRight then
|
|
dec(CalcRight, Frame.Width);
|
|
CalcBottom := YPos(OfsY + Size.Top + Size.Height)-1;
|
|
if Frame.DrawBottom then
|
|
dec(CalcBottom, Frame.Width);
|
|
ww := CalcRight-CalcLeft+1;
|
|
hh := CalcBottom-CalcTop+1;
|
|
//
|
|
if fFit then
|
|
FitZoom(XBitmap.Width, XBitmap.Height, ww, hh)
|
|
else
|
|
fZoom := 100;
|
|
fZZWW := round(fzoom*(Xbitmap.width/100)); // nuova width della bitmap
|
|
fZZHH := round(fzoom*(Xbitmap.height/100)); // nuova height della bitmap
|
|
fOffX := 0; fOffY := 0;
|
|
fExtX := imin(fZZWW, ww); // width destinazione bitmap
|
|
fExtY := imin(fZZHH, hh); // height destinazione bitmap
|
|
if fCenter then
|
|
begin
|
|
// centra immagine
|
|
if fExtx<ww then
|
|
fOffX := (ww-fExtx) div 2;
|
|
if fExty<hh then
|
|
fOffY := (hh-fExty) div 2;
|
|
end;
|
|
//
|
|
o1x := 0; o2x := 0; o1y := 0; o2y := 0;
|
|
if fZZWW<>0 then
|
|
begin
|
|
rr := Xbitmap.width/fZZWW;
|
|
o1x := round(fViewX*rr);
|
|
o2x := round(fExtx*rr);
|
|
if (o1x+o2x)>XBitmap.Width then
|
|
dec(o2x);
|
|
end;
|
|
if fZZHH<>0 then
|
|
begin
|
|
rr := Xbitmap.height/fZZHH;
|
|
o1y := round(fViewY*rr);
|
|
o2y := round(fExty*rr);
|
|
if (o1y+o2y)>XBitmap.Height then
|
|
dec(o2y);
|
|
end;
|
|
with fBitmapInfoHeader256 do
|
|
begin
|
|
biSize := sizeof(TBitmapInfoHeader);
|
|
biWidth := Xbitmap.width;
|
|
biHeight := Xbitmap.height;
|
|
biPlanes := 1;
|
|
if Xbitmap.pixelformat=pf1bit then
|
|
begin
|
|
biBitCount := 1;
|
|
// assegna colori bianco e nero (la Palette[0] è tutta zero...)
|
|
Palette[1].rgbRed := 255;
|
|
Palette[1].rgbGreen := 255;
|
|
Palette[1].rgbBlue := 255;
|
|
end
|
|
else
|
|
biBitCount := 24;
|
|
biCompression := BI_RGB;
|
|
end;
|
|
inc(fOffX, CalcLeft);
|
|
inc(fOffY, CalcTop);
|
|
IEDrawDibDraw(fHDrawDib, canvas.handle, fOffX, fOffY, fExtx, fExty, PBitmapInfoHeader(@fBitmapInfoHeader256)^, Xbitmap.ScanLine[Xbitmap.height-1], o1x, o1y, o2x, o2y, 0);
|
|
with Canvas do
|
|
begin
|
|
Pen.Color := Frame.Color;
|
|
Pen.Width := Frame.Width;
|
|
Pen.Style := Frame.Style;
|
|
// shadow
|
|
if fShadowSize>0 then
|
|
begin
|
|
Brush.Color := clBlack;
|
|
Brush.Style := bsSolid;
|
|
if fImageShadow then
|
|
begin
|
|
// ombra sull'immagine
|
|
IERightShadow(Canvas, nil, fOffX+fExtx, fOffY, fOffX+fExtx+fShadowSize+2, fOffY+fExty+fShadowSize, fShadowType, clWhite);
|
|
IEBottomShadow(Canvas, nil, fOffX, fOffY+fExty, fOffX+fExtx+fShadowSize, fOffY+fExty+fShadowSize+1, fShadowType, clWhite);
|
|
end
|
|
else
|
|
begin
|
|
// ombra sul frame
|
|
IERightShadow(Canvas, nil, CalcRight+2, CalcTop, CalcRight+2+fShadowSize, CalcBottom+fShadowSize, fShadowType, clWhite);
|
|
IEBottomShadow(Canvas, nil, CalcLeft, CalcBottom+1, CalcRight+fShadowSize, CalcBottom+1+fShadowSize, fShadowType, clWhite);
|
|
end;
|
|
if fImageBorder then
|
|
begin
|
|
// bordo sull'immagine
|
|
moveto(fOffX, fOffY);
|
|
lineto(fOffX+fExtx-1, fOffY);
|
|
lineto(fOffX+fExtx-1, fOffY+fExty-1);
|
|
lineto(fOffX, fOffY+fExty-1);
|
|
lineto(fOffX, fOffY);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
XBitmap.free;
|
|
if (not fImageBorder) and (not fImageShadow) then
|
|
inherited;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure TQRImageEn.FitZoom(bmpww, bmphh, ww, hh: integer);
|
|
begin
|
|
if (bmpww<>0) and (bmphh<>0) then
|
|
fZoom := imin( trunc(ww/(bmpww/100)), trunc(hh/(bmphh/100)) );
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure TQRImageEn.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (AComponent=fImageEnView) and (Operation=opRemove) then
|
|
begin
|
|
fImageEnView.RemoveBitmapChangeEvent(BitmapChangeHandle);
|
|
fImageEnView := nil;
|
|
end;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure TQRImageEn.SetAttachedBitmap(atBitmap: TBitmap);
|
|
begin
|
|
if assigned(fImageEnView) then
|
|
fImageEnView.RemoveBitmapChangeEvent(BitmapChangeHandle); // rimuove precedente, se c'è
|
|
if (not assigned(atBitmap)) and assigned(fImageEnView) then
|
|
exit; // situazione senza significato
|
|
fBitmap := atBitmap;
|
|
if assigned(fBitmap) then
|
|
fImageEnView := nil;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
procedure TQRImageEn.SetAttachedImageEn(atImageEn: TIEView);
|
|
begin
|
|
if assigned(fImageEnView) then
|
|
fImageEnView.RemoveBitmapChangeEvent(BitmapChangeHandle); // rimuove precedente, se c'è
|
|
fImageEnView := atImageEn;
|
|
if assigned(fImageEnView) then
|
|
begin // fImageEnView ora potrebbe anche essere nil
|
|
fBitmap := fImageEnView.Bitmap;
|
|
fImageEnView.FreeNotification(self);
|
|
BitmapChangeHandle := fImageEnView.RegisterBitmapChangeEvent(OnBitmapChange);
|
|
end;
|
|
end;
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////
|
|
// riassegna fBitmap (chiamato dal meccanismo RegisterBitmapChangeEvent)
|
|
procedure TQRImageEn.OnBitmapChange(Sender: TObject; destroying: boolean);
|
|
begin
|
|
if destroying then
|
|
fImageEnView := nil
|
|
else
|
|
if assigned(fImageEnView) then
|
|
fBitmap := fImageEnView.Bitmap;
|
|
end;
|
|
|
|
|
|
end.
|
|
|