(*
Copyright (c) 1998/99 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://www.fairesavoir.com/fdivitto
homepage: http://members.tripod.com/~fdivitto
*)

unit QRImageEn;

interface

{$I IE.INC}

uses Windows, Messages, classes, Graphics, ImageEnView, ImageEnio,
     iedefs, 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);
      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;
   _CopyBitmap(fBitmap,XBitmap);
   //LoadPictureEx(fImageEnIO);
   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;
   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);
begin
	if assigned(fImageEnView) then
		fBitmap:=fImageEnView.Bitmap;
end;



end.
