Content-Transfer-Encoding: 7bit
Message-ID: <5.1.0.14.2.20020313100503.012fffd0@mail.netvision.net.il>
Date: Wed, 13 Mar 2002 11:17:57 +0200
To: <efg2@efg2.com>
From: <information@inmatrix.com>
Subject: ComputerLab Feedback
MIME-Version: 1.0
Content-Type: text/plain;


I would like to thank you for maintaining the EFG site, over the past few
months, I've find some helpful tips which helped me in my work.

Toward that end, here's some code I've written that you may find of use:

// ---------------------------------------------------------------------------
// Two procedures to fill a vertical and horizontal gradient within a TBitmap:
// ---------------------------------------------------------------------------
Type
   TMyRGB =
   Record
     mBlue  : Byte;
     mGreen : Byte;
     mRed   : Byte;
   End;
   TMyScanLine       = Array[0..4095] of TMyRGB;

procedure sGradientRectH(DestBitmap : TBitmap;
DestX,DestY,sWidth,sHeight,sRGB1,sRGB2 : TColor);
var
   sRGB    : TMyRGB;
   dRGB    : TMyRGB;
   P,P2    : ^TMyScanLine;
   PDif    : Integer;
   Speed1  : Integer;
   Speed2  : Integer;
   Y,X     : Integer;
begin
   // Dirty way to convert TColor to an RGB
   Move(sRGB1,sRGB,3);
   Move(sRGB2,dRGB,3);
   // Calculate memory used for each line display for quick scanline seeks
   P    := DestBitmap.ScanLine[DestY];
   P2   := DestBitmap.ScanLine[DestY+1];
   PDif := Integer(P2)-Integer(P);
   // Calculate the first line (all future lines share the same data)
   For X := 1 to sWidth do
   Begin
     // Pre-calculate some more repeated math
     Speed1 := sWidth-X;
     Speed2 := DestX+X-1;
     // We switch blue red to compensate for RGB vs BGR
     P^[Speed2].mRed   := ((Speed1*sRGB.mBlue ) + (X*dRGB.mBlue )) div sWidth;
     P^[Speed2].mGreen := ((Speed1*sRGB.mGreen) + (X*dRGB.mGreen)) div sWidth;
     P^[Speed2].mBlue  := ((Speed1*sRGB.mRed  ) + (X*dRGB.mRed  )) div sWidth;
   End;
   For Y := 1 to sHeight-1 do
   Begin
     // Duplicate source line for cover image height
     Move(P^[DestX],P2^[DestX],sWidth*3);
     Inc(Integer(P2),PDif);
   end;
end;

procedure sGradientRectV(DestBitmap : TBitmap;
DestX,DestY,sWidth,sHeight,sRGB1,sRGB2 : TColor);
var
   sRGB    : TMyRGB;
   dRGB    : TMyRGB;
   P       : ^TMyScanLine;
   PDif    : Integer;
   Speed1  : Integer;
   Y,X     : Integer;
begin
   // Dirty way to convert TColor to an RGB
   Move(sRGB1,sRGB,3);
   Move(sRGB2,dRGB,3);
   // Calculate memory used for each line display for quick scanline seeks
   P    := DestBitmap.ScanLine[DestY];
   PDif := Integer(DestBitmap.ScanLine[DestY+1])-Integer(P);

   For Y := 0 to sHeight-1 do
   Begin
     // Pre-calculate some more repeated math
     Speed1 := ((sHeight-Y));
     // We switch blue red to compensate for RGB vs BGR
     P^[DestX].mRed   := ((Speed1*sRGB.mBlue ) + (Y*dRGB.mBlue )) div sHeight;
     P^[DestX].mGreen := ((Speed1*sRGB.mGreen) + (Y*dRGB.mGreen)) div sHeight;
     P^[DestX].mBlue  := ((Speed1*sRGB.mRed  ) + (Y*dRGB.mRed  )) div sHeight;
     // Fill color through the rest of the line
     For X := 1 to sWidth-1 do P^[DestX+X] := P^[DestX];
     Inc(Integer(P),PDif);
   End;
end;

//
-----------------------------------------------------------------------------
// a procedure to smoothly downsize a TBitmap (can upsize too,but not very
well)
// copies a bitmap into a rectangle within a second bitmap.
//
-----------------------------------------------------------------------------

procedure ImageFactorReize(SrcBitmap,DestBitmap : TBitmap;
DestX,DestY,dWidth,dHeight : Integer);
var
   Speed1            : Integer;
   Speed2            : Integer;
   Speed4            : Integer;
   PixR              : Integer;
   PixG              : Integer;
   PixB              : Integer;
   SX,SY             : Integer;
   X,Y               : Integer;
   PixXShl           : Integer;
   PixYShl           : Integer;
   PixXRnd           : Integer;
   PixYRnd           : Integer;
   PicWidth          : Integer;
   PicHeight         : Integer;
   PixCount          : Integer;
   PixXPos           : Integer;
   PixYPos           : Integer;
   P                 : ^TMyScanLine;
   PL                : Array[0..4095] of ^TMyScanLine;
   PDif              : Integer;
begin
   // Calculate memory used for each line display for quick scanline seeks
(dest image)
   PL[0] := SrcBitmap.Scanline[0];
   PL[1] := SrcBitmap.Scanline[1];
   PDif  := Integer(PL[1])-Integer(PL[0]);
   // Pre-Calculate scanline positions for source image
   For Y := 2 to SrcBitmap.Height-1 do Integer(PL[Y]) := Integer(PL[Y-1])+PDif;

   // Pre-Calcualte some repeated math
   PicWidth     := SrcBitmap.Width  shl 2;
   PicHeight    := SrcBitmap.Height shl 2;
   PixXShl      := (PicWidth  shl 8) div dWidth;
   PixYShl      := (PicHeight shl 8) div dHeight;
   PixXRnd      := Round(PicWidth  / dWidth);
   PixYRnd      := Round(PicHeight / dHeight);
   PixCount     := PixXRnd*PixYRnd;

   // Calculate memory used for each line display for quick scanline seeks
(source image)
   P            := DestBitmap.Scanline[DestY];
   PDif         := Integer(DestBitmap.Scanline[DestY+1])-Integer(P);

   // scale the image
   For Y := 0 to dHeight-1 do
   Begin
     PixYPos := (Y*PixYShl) shr 8;
     For X := 0 to dWidth-1 do
     Begin
       PixR         := 0;
       PixG         := 0;
       PixB         := 0;
       PixXPos      := (X*PixXShl) shr 8;
       For SY := 0 to PixYRnd-1 do
       Begin
         Speed1 := ((PixYPos+SY) shr 2);
         For SX := 0 to PixXRnd-1 do
         Begin
           Speed2 := (PixXPos+SX) shr 2;
           Inc(PixR,PL[Speed1]^[Speed2].MRed);
           Inc(PixG,PL[Speed1]^[Speed2].MGreen);
           Inc(PixB,PL[Speed1]^[Speed2].MBlue);
         End;
       End;
       Speed4 := X+DestX;
       P^[Speed4].MRed   := PixR div PixCount;
       P^[Speed4].MGreen := PixG div PixCount;
       P^[Speed4].MBlue  := PixB div PixCount;
     End;
     Inc(Integer(P),PDif);
   End;
end;


Regards,
   Yaron Gur - www.inmatrix.com