(*
Copyright (c) 1998/1999/2000 by Encomps. All rights reserved.

This software comes without any warranty either implied or expressed.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Encomps grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

ImageEn may not be included in any commercial, shareware or freeware DELPHI
libraries or components.

email: encomps@tiscalinet.it

homepage: http://web.tiscalinet.it/encomps
homepage: http://members.tripod.com/~fdivitto
*)

unit QRImageEn;

interface

{$I IE.INC}

uses Windows, Messages, classes, Graphics, ImageEnView, ImageEnio,
     hyiedefs, QuickRpt;

type
	TShadowType= (iestNone, iestSolid, iestSmooth1, iestSmooth2);

	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:TShadowType;
         fGammaCorrection:double;
         fBitmap:TBitmap;				// riferimento alla bitmap (se fImageEnView è valido vale FImageEnView.bitmap)
         fImageEnView:TIEView;		// riferimento a TIEView (fbitmap=fimageenview.bitmap)
         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:TShadowType 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;

procedure Register;

implementation

uses QRDBImageEn,ImageEnProc;

procedure Register;
begin
  RegisterComponents('ImageEn', [TQRImageEn]);
end;

/////////////////////////////////////////////////////////////////////////////////////
constructor TQRImageEn.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   ZeroMemory(@fBitmapInfoHeader256,sizeof(TBitmapInfoHeader256));
   fZoom:=100;
   fCenter:=True;
   fFit:=True;
   fViewX:=0;
   fViewY:=0;
   fHDrawDib:=DrawDibOpen;
   fShadowSize:=8;
   fShadowType:=iestSmooth2;
   fGammaCorrection:=1;
   fBitmap:=nil;
   fImageEnView:=nil;
   fImageBorder:=true;
   fImageShadow:=true;
end;

/////////////////////////////////////////////////////////////////////////////////////
destructor TQRImageEn.Destroy;
begin
   DrawDibClose(fHDrawDib);
   if assigned(fImageEnView) then
       fImageEnView.RemoveBitmapChangeEvent(OnBitmapChange);
   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 RightShadow(Canvas:TCanvas; x1,y1,x2,y2:integer; st:TShadowType);
var
	y,x,ww,hh:integer;
   cl1,cl2,cl:integer;
   o:integer;
begin
	ww:=x2-x1+1;
   hh:=y2-y1+1;
   case st of
   	iestSolid:
        	Canvas.FillRect(Rect(x1,y1+ww,x2,y2+1));
   	iestSmooth1:
      	begin
				for x:=0 to ww-1 do begin
            	cl:= trunc(exp(x/ww)/exp(1)*255);
            	Canvas.Pen.Color:=TColor((cl) + (cl shl 8) + (cl shl 16));
            	Canvas.MoveTo(x1+x,y1+ww);
               Canvas.LineTo(x1+x,y2-ww+x+3);
            end;
         end;
   	iestSmooth2:
      	begin
            o:=0;
            for y:=0 to hh do begin
               cl2:= blimit(trunc(exp((hh-y*3)/hh)/exp(1)*255));
               if y>hh-ww+1 then
                  inc(o);
               for x:=o to ww do begin
                  cl1:= trunc(exp(x/ww)/exp(1)*255);
                  cl:=imax(cl1,cl2);
                  Canvas.Pixels[x1+x,y1+y]:=TColor((cl) + (cl shl 8) + (cl shl 16));
               end;
            end;
         end;
   end;
end;

procedure BottomShadow(Canvas:TCanvas; x1,y1,x2,y2:integer; st:TShadowType);
var
	y,x,ww,hh:integer;
   cl1,cl2,cl:integer;
   o:integer;
begin
	ww:=x2-x1+1;
   hh:=y2-y1+1;
   case st of
   	iestSolid:
        	Canvas.FillRect(Rect(x1+hh,y1,x2+1,y2));
   	iestSmooth1:
      	begin
				for y:=0 to hh-1 do begin
            	cl:= trunc(exp(y/hh)/exp(1)*255);
            	Canvas.Pen.Color:=TColor((cl) + (cl shl 8) + (cl shl 16));
            	Canvas.MoveTo(x1+hh,y1+y);
               Canvas.LineTo(x2-hh+y+3,y1+y);
            end;
         end;
   	iestSmooth2:
      	begin
            o:=0;
            for x:=0 to ww do begin
               cl2:= blimit(trunc(exp((ww-x*3)/ww)/exp(1)*255));
               if x>ww-hh+1 then
                  inc(o);
               for y:=o to hh do begin
                  cl1:= trunc(exp(y/hh)/exp(1)*255);
                  cl:=imax(cl1,cl2);
                  Canvas.Pixels[x1+x,y1+y]:=TColor((cl) + (cl shl 8) + (cl shl 16));
               end;
            end;
         end;
   end;
end;

function IntPower(Base: Extended; Exponent: Integer): Extended;
asm
        mov     ecx, eax
        cdq
        fld1                      { Result := 1 }
        xor     eax, edx
        sub     eax, edx          { eax := Abs(Exponent) }
        jz      @@3
        fld     Base
        jmp     @@2
@@1:    fmul    ST, ST            { X := Base * Base }
@@2:    shr     eax,1
        jnc     @@1
        fmul    ST(1),ST          { Result := Result * X }
        jnz     @@1
        fstp    st                { pop X from FPU stack }
        cmp     ecx, 0
        jge     @@3
        fld1
        fdivrp                    { Result := 1 / Result }
@@3:
        fwait
end;

function Power(Base, Exponent: Extended): Extended;
begin
  if Exponent = 0.0 then
    Result := 1.0               { n**0 = 1 }
  else if (Base = 0.0) and (Exponent > 0.0) then
    Result := 0.0               { 0**n = 0, n > 0 }
  else if (Frac(Exponent) = 0.0) and (Abs(Exponent) <= MaxInt) then
    Result := IntPower(Base, Trunc(Exponent))
  else
    Result := Exp(Exponent * Ln(Base))
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);
         DrawDibDraw(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
                  RightShadow(Canvas,fOffX+fExtx,fOffY,fOffX+fExtx+fShadowSize+2,fOffY+fExty+fShadowSize,fShadowType);
                  BottomShadow(Canvas,fOffX,fOffY+fExty,fOffX+fExtx+fShadowSize,fOffY+fExty+fShadowSize+1,fShadowType);
               end else begin
                  // ombra sul frame
                  RightShadow(Canvas,CalcRight+2,CalcTop,CalcRight+2+fShadowSize,CalcBottom+fShadowSize,fShadowType);
                  BottomShadow(Canvas,CalcLeft,CalcBottom+1,CalcRight+fShadowSize,CalcBottom+1+fShadowSize,fShadowType);
               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(OnBitmapChange);
   	fImageEnView:=nil;
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TQRImageEn.SetAttachedBitmap(atBitmap:TBitmap);
begin
	if assigned(fImageEnView) then
   	fImageEnView.RemoveBitmapChangeEvent(OnBitmapChange);	// 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(OnBitmapChange);	// rimuove precedente, se c'è
   fImageEnView:=atImageEn;
   if assigned(fImageEnView) then begin // fImageEnView ora potrebbe anche essere nil
      fBitmap:=fImageEnView.Bitmap;
      fImageEnView.FreeNotification(self);
      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.
