iextratransitions.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

    dstRect.Left := dstRect.Right+1;
    dstRect.Right := T-1;
  end;
  if Vert then
  begin
    T := dstRect.Top;
    dstRect.Top := dstRect.Bottom+1;
    dstRect.Bottom := T-1;
  end;
  SetStretchBltMode(Canvas.Handle, HALFTONE);
  StretchBlt(Canvas.Handle, dstRect.Left, dstRect.Top,
     dstRect.Right - dstRect.Left, dstRect.Bottom - dstRect.Top,
     Bitmap.Canvas.Handle, srcRect.Left, srcRect.Top,
     srcRect.Right - srcRect.Left, srcRect.Bottom - srcRect.Top, SRCCOPY);
end;

{NO LONGER REQUIRED AS ONLY USED FOR FADE EFFECT, WHICH IMAGEEN ALREADY HAS
// Both bitmaps must be equal size and 32 bit format.
procedure MergeTransparent(dstBitmap, srcBitmap: TBitmap; Transparency: Integer);
var
  dstPixel, srcPixel: PRGBQuad;
  InvertTransparency: Integer;
  bmpWidth, bmpHeight: Integer;
  x, y: Integer;
begin
  bmpWidth := srcBitmap.Width;
  bmpHeight := srcBitmap.Height;
  InvertTransparency := 100 - Transparency;
  for y := 0 to bmpHeight - 1 do
  begin
    srcPixel := srcBitmap.ScanLine[y];
    dstPixel := dstBitmap.ScanLine[y];
    for x := 0 to bmpWidth - 1 do
    begin
      dstPixel^.rgbRed := ((InvertTransparency * dstPixel^.rgbRed) +
                            (Transparency * srcPixel^.rgbRed)) div 100;
      dstPixel^.rgbGreen := ((InvertTransparency * dstPixel^.rgbGreen) +
                              (Transparency * srcPixel^.rgbGreen)) div 100;
      dstPixel^.rgbBlue := ((InvertTransparency * dstPixel^.rgbBlue) +
                             (Transparency * srcPixel^.rgbBlue)) div 100;
      Inc(srcPixel);
      Inc(dstPixel);
    end;
  end;
end; }

(*    
// CANNOT USE THIS ONE AS NEED TO BE IN 32 BIT FORMAT, IMAGEEN is 24BIT
        
const
  MaxPixelCount = 32768;

type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..MaxPixelCount] of TRGBQuad;

// Both bitmaps must be equal size and 32 bit format. Angle is in radians.
procedure MergeRotate(dstBitmap, srcBitmap: TBitmap; xOrg, yOrg: Integer;
  Angle: Extended);
var
  CosTheta, SinTheta: Extended;
  iCosTheta, iSinTheta: Integer;
  xSrc, ySrc: Integer;
  xDst, yDst: Integer;
  xPrime, yPrime: Integer;
  bmpWidth, bmpHeight: Integer;
  yPrimeSinTheta, yPrimeCosTheta: Integer;
  srcBits: PRGBQuadArray;
  dstBits: PRGBQuad;
begin
try
  SinCos(-Angle, SinTheta, CosTheta);
  iSinTheta := Trunc(SinTheta * (1 shl 16));
  iCosTheta := Trunc(CosTheta * (1 shl 16));
  bmpWidth := srcBitmap.Width;
  bmpHeight := srcBitmap.Height;
  srcBits := srcBitmap.ScanLine[bmpHeight-1];
  dstBits := @(PRGBQuadArray(dstBitmap.ScanLine[0])[bmpWidth-1]);
  yPrime := bmpHeight - yOrg;
  for yDst := bmpHeight - 1 downto 0 do
  begin
    yPrimeSinTheta := yPrime * iSinTheta;
    yPrimeCosTheta := yPrime * iCosTheta;
    xPrime := bmpWidth - xOrg;
    for xDst := bmpWidth - 1 downto 0 do
    begin
      xSrc := SmallInt((xPrime * iCosTheta - yPrimeSinTheta) shr 16) + xOrg;
      ySrc := SmallInt((xPrime * iSinTheta + yPrimeCosTheta) shr 16) + yOrg;
      {$IFDEF DELPHI4_UP}
      if (DWORD(ySrc) < DWORD(bmpHeight)) and (DWORD(xSrc) < DWORD(bmpWidth)) then
      {$ELSE} // Delphi 3 compiler ignores unsigned type cast and generates signed comparison code!
      if (ySrc >= 0) and (ySrc < bmpHeight) and (xSrc >= 0) and (xSrc < bmpWidth) then
      {$ENDIF}
      begin
        dstBits^ := srcBits[ySrc * bmpWidth + xSrc];
      end;
      Dec(dstBits);
      Dec(xPrime);
    end;
    Dec(yPrime);
  end;
except
on e: Exception do

  ShowMessage(e.Message);
end;
end;
*)

procedure SinCos(Theta: Extended; var Sin, Cos: Extended);
asm
        FLD     Theta
        FSINCOS
        FSTP    tbyte ptr [edx]    // Cos
        FSTP    tbyte ptr [eax]    // Sin
        FWAIT
end;


// Angle is in radians.
procedure RotatePoints(var Points: array of TPoint; xOrg, yOrg: Integer;
  Angle: Extended);
var
  Sin, Cos: Extended;
  xPrime, yPrime: Integer;
  I: Integer;
begin
 SinCos(Angle, Sin, Cos);
 for I := Low(Points) to High(Points) do
 begin
   xPrime := Points[I].X - xOrg;
   yPrime := Points[I].Y - yOrg;
   Points[I].X := Round(xPrime * Cos - yPrime * Sin) + xOrg;
   Points[I].Y := Round(xPrime * Sin + yPrime * Cos) + yOrg;
 end;
end;

{ Helper Functions }

function CreateBarRgn(X, Y, W, H, S: Integer; XMode, YMode: Integer): HRGN;
var
  X1, Y1: Integer;
  Rgn, tRgn: HRGN;
begin
  Result := 0;
  if X <= W then Y1 := 0 else Y1 := 5;
  while Y1 < H + 5 do
  begin
    if X > W then
    begin
      if XMode in [1, 4] then
        tRgn := CreateRectRgn(2 * W - X, Y1, W, Y1 + 5)
      else if XMode in [2, 5] then
        tRgn := CreateRectRgn(0, Y1, X - W, Y1 + 5)
      else
        tRgn := 0;
      Rgn := CreateRectRgn(0, Y1 - 5, W, Y1);
      if tRgn <> 0 then
      begin
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end;
    end
    else
    begin
      if (X + S) > W then X := W;
      if XMode in [1, 5] then
        Rgn := CreateRectRgn(W - X, Y1, W, Y1 + 5)
      else if XMode in [2, 4] then
        Rgn := CreateRectRgn(0, Y1, X, Y1 + 5)
      else if XMode = 3 then
      begin
        Rgn := CreateRectRgn(0, Y1 + 5, X, Y1 + 10);
        tRgn := CreateRectRgn(W - X, Y1, W, Y1 + 5);
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end
      else
        Rgn := 0;
    end;
    if Result <> 0 then
    begin
      CombineRgn(Result, Result, Rgn, RGN_OR);
      DeleteObject(Rgn);
    end
    else
      Result := Rgn;
    Inc(Y1, 10)
  end;
  if Y <= H then X1 := 0 else X1 := 5;
  while X1 < W + 5 do
  begin
    if Y > H then
    begin
      if YMode in [1, 4] then
        tRgn := CreateRectRgn(X1, 2 * H - Y, X1 + 5, H)
      else if YMode in [2, 5] then
        tRgn := CreateRectRgn(X1, 0, X1 + 5, Y - H)
      else
        tRgn := 0;
      Rgn := CreateRectRgn(X1 - 5, 0, X1, H);
      if tRgn <> 0 then
      begin
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end;
    end
    else
    begin
      if (Y + S) > H then Y := H;
      if YMode in [1, 5] then
        Rgn := CreateRectRgn(X1, H - Y, X1 + 5, H)
      else if YMode in [2, 4] then
        Rgn := CreateRectRgn(X1, 0, X1 + 5, Y)
      else if YMode = 3 then
      begin
        tRgn := CreateRectRgn(X1, H - Y, X1 + 5, H);
        Rgn := CreateRectRgn(X1 + 5, 0, X1 + 10, Y);
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end
      else
        Rgn := 0;
    end;
    if Rgn <> 0 then
    begin
      if Result <> 0 then
      begin
        CombineRgn(Result, Result, Rgn, RGN_OR);
        DeleteObject(Rgn);
      end
      else
        Result := Rgn;
    end;
    Inc(X1, 10)
  end;
end;

function CreatePourRgn(X, Y, W, H, XMode, YMode: Integer): HRGN;
var
  X1, Y1, N: Integer;
  Rgn, tRgn: HRGN;
begin
  Result := 0;
  if XMode <> 0 then
  begin
    if X < W then
      N := W div 7
    else
      N := 0;
    Y1 := 0;
    while Y1 < H do
    begin
      if XMode = 1 then
        Rgn := CreateRectRgn(W - X + Random(N) - Random(N), Y1, W, Y1 + 5 + H mod 5)
      else if XMode = 2 then
        Rgn := CreateRectRgn(0, Y1, X + Random(N) - Random(N), Y1 + 5 + H mod 5)
      else if XMode = 3 then
      begin
        Rgn := CreateRectRgn((W - X + Random(N) - Random(N)) div 2, Y1, W div 2, Y1 + 5 + H mod 5);
        tRgn := CreateRectRgn(W div 2, Y1, (W + X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end
      else
      begin
        Rgn := CreateRectRgn(W - (X + Random(N) - Random(N)) div 2, Y1, W, Y1 + 5 + H mod 5);
        tRgn := CreateRectRgn(0, Y1, (X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end;
      if Result <> 0 then
      begin
        CombineRgn(Result, Result, Rgn, RGN_OR);
        DeleteObject(Rgn);
      end
      else
        Result := Rgn;
      Inc(Y1, 5);
    end;
  end;
  if YMode <> 0 then
  begin
    if Y < H then
      N := H div 7
    else
      N := 0;
    X1 := 0;
    while X1 < W do
    begin
      if YMode = 1 then
        Rgn := CreateRectRgn(X1, H - Y + Random(N) - Random(N), X1 + 5 + W mod 5, H)
      else if YMode = 2 then
        Rgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, Y + Random(N) - Random(N))
      else if YMode = 3 then
      begin
        Rgn := CreateRectRgn(X1, (H - Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H div 2);
        tRgn := CreateRectRgn(X1, H div 2, X1 + 5 + W mod 5, (H + Y + Random(N) - Random(N)) div 2);
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end
      else
      begin
        Rgn := CreateRectRgn(X1, H - (Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H);
        tRgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, (Y + Random(N) - Random(N)) div 2);
        CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
        DeleteObject(tRgn);
      end;
      if Result <> 0 then
      begin
        CombineRgn(Result, Result, Rgn, RGN_OR);
        DeleteObject(Rgn);
      end
      else
        Result := Rgn;
      Inc(X1, 5);
    end;
  end;
end;

function CreateSwarmRgn(X, Y, W, H, XMode, YMode: Integer): HRGN;
var
  X1, Y1, N, M, I, J: Integer;
  Rgn, tRgn: HRGN;
begin
  Result := 0;
  if XMode <> 0 then
  begin
    if X < W then
      N := W div 10
    else
      N := 0;
    M := N div 20;
    if M < 2 then M := 2;