procedure TForm1.Button1Click(Sender: TObject);
type
 ARGBQuad = array [0..0] of TRGBQuad;
 PARGBQuad = ^ARGBQuad;
 AByte = array [0..0] of Byte;
 PAByte = ^AByte;
var
 BMP1: TBitmap;
 BMP2: TBitmap;

 SL1, SL2: PARGBQuad;
 V1, V2: TRGBQuad;
 R: ^TRGBQuad;
 i, j: Integer;
 A_1, A: Integer;
 Delta: DWORD;

 T: DWORD;

begin
 BMP1 := TBitmap.Create;
 BMP1.LoadFromFile('C:\1.bmp');
 BMP2 := TBitmap.Create;
 BMP2.LoadFromFile('C:\2.bmp');
 
T := GetTickCount;

 SL1 := BMP1.ScanLine[0];
 SL2 := BMP2.ScanLine[0];
 Delta := DWORD(BMP1.ScanLine[1]) - DWORD(SL1);
 for i := 0 to BMP1.Height-1 do begin
   for j := 0 to BMP1.Width-1 do begin
     V1 := SL1[j];
     V2 := SL2[j];
     A := V2.rgbReserved;
     A_1 := 255-V2.rgbReserved;
     R := @SL1[j];
     R.rgbBlue := (V2.rgbBlue*A_1+V1.rgbBlue*A) shr 8;
     R.rgbGreen := (V2.rgbGreen*A_1+V1.rgbGreen*A) shr 8;
     R.rgbRed := (V2.rgbRed*A_1+V1.rgbRed*A) shr 8;
   end;
   SL1 := Pointer(DWORD(SL1) + Delta);
   SL2 := Pointer(DWORD(SL2) + Delta);
 end;

ShowMessage(IntToStr(GetTickCount - T));

 Image1.Canvas.StretchDraw(Rect(0, 0, 1024, 768), BMP1);
 BMP1.Free;
 BMP2.Free;
end;

const
 MaxBTCount = MaxInt div SizeOf(dword);
type
 BTElement = dword;
 TBTArray = array[0..MaxBTCount-1] of BTElement;

 PxlByte = array [0..2] of byte;

 LongAS = packed record
   DW: array [0..3] of dword;
 end;

 pPRBT= ^TPRBT; //для 4х уменьшения
 TPRBT = record
   b1,b2,b3,b4:dword;
 end;
 pPRBD= ^TPRBD; //это для 2х уменьшения
 TPRBD = record
   b1,b2:dword;
 end;

 TBT = Class
   private
    procedure setarrays(x,y:integer);
   public
    DIBWidth     : integer;
    DIBHeight    : integer;
    P: ^TBTArray;
    constructor Create;
    destructor Destroy; override;
    procedure loadbitmap(bitmap:tbitmap);
    procedure savebitmap2file(filename:string);
    procedure set_widthheight(w,h:integer);
 end;

implementation

constructor TBT.Create;
begin
inherited;
DIBWidth:=0;
DIBHeight:=0;
end;

destructor TBT.Destroy;
begin
FreeMem(P, DIBWidth*DIBHeight*SizeOf(BTElement));
inherited;
end;

procedure TBT.setarrays(x,y:integer);
begin
FreeMem(P, DIBWidth*DIBHeight*SizeOf(BTElement));

DIBWidth:=x;
DIBHeight:=y;
P:=AllocMem(DIBWidth*DIBHeight * SizeOf(BTElement));
end;

procedure TBT.set_widthheight(w,h:integer);
begin
setarrays(w,h);
end;

procedure TBT.loadbitmap(bitmap:tbitmap);
var x,y,cou,n: Integer;  Row2:PRGBAArray;
begin
cou:=0;
setarrays(bitmap.Width,bitmap.Height);

for Y:=0 to bitmap.Height-1 do begin
   Row2:=bitmap.ScanLine[y];
    for x:=0 to bitmap.Width-1 do begin

      if((Row2[x].rgbRed=255) and (Row2[x].rgbGreen=0) and (Row2[x].rgbBlue=0)) then
       Row2[x].rgbReserved:=0 else
       Row2[x].rgbReserved:=255;

       P^[ y*DIBWidth+x ]:=(Row2[x].rgbRed or (Row2[x].rgbGreen shl 8) or (Row2[x].rgbBlue shl 16) or (Row2[x].rgbReserved shl 24));
    end;
 end;
end;

procedure TBT.savebitmap2file(filename:string);
var bb:tbitmap; x,y,cou: Integer;  Row2:PRGBAArray; fd:dword;
begin
bb:=tbitmap.Create;
try
 bb.PixelFormat:=pf32bit;
 bb.Width:=DIBWidth;
 bb.Height:=DIBHeight;
  for Y:=0 to bb.Height-1 do begin
    Row2:=bb.ScanLine[y];
    for x:=0 to bb.Width-1 do begin
      fd:=P^[ y*DIBWidth+x ];
      Row2[x].rgbBlue:=Byte(fd shr 16);
      Row2[x].rgbGreen:=Byte(fd shr 8);
      Row2[x].rgbRed:=Byte(fd);
      Row2[x].rgbReserved:=Byte(fd shr 24);
    end;
  end;
  bb.SaveToFile(filename);
finally
 bb.Free;
end;
end;

procedure antialias_x2(var BTSourc,BTDest:TBT);
var x,y,cou,num,i,cxi,cx,wi,hi: Integer;  Row2:PRGBAArray; fd:dword;
  y1,y2,totr,totg,totb,tota:integer;
 yy1,yy2:pPRBD;
 wii,hii:integer;
begin
 wii:=BTSourc.DIBWidth div 2;
 hii:=BTSourc.DIBHeight div 2;

  for Y:=0 to hii-1 do begin

    y1:=y*2*BTSourc.DIBWidth;
    y2:=y1+BTSourc.DIBWidth;

    for x:=0 to wii-1 do begin
      cx:=x*2;

      yy1:=pPRBD(@(BTSourc.P^[ y1+cx ]));
      yy2:=pPRBD(@(BTSourc.p^[ y2+cx ]));

      totb:=LongRec(yy1.b1).Bytes[2] + LongRec(yy2.b1).Bytes[2] ;
      totb:=totb+LongRec(yy1.b2).Bytes[2] + LongRec(yy2.b2).Bytes[2] ;

      totg:=LongRec(yy1.b1).Bytes[1] + LongRec(yy2.b1).Bytes[1] ;
      totg:=totg+LongRec(yy1.b2).Bytes[1] + LongRec(yy2.b2).Bytes[1] ;

      totr:=LongRec(yy1.b1).Bytes[0] + LongRec(yy2.b1).Bytes[0] ;
      totr:=totr+LongRec(yy1.b2).Bytes[0] + LongRec(yy2.b2).Bytes[0];

      tota:=LongRec(yy1.b1).Bytes[3] + LongRec(yy2.b1).Bytes[3] ;
      tota:=tota+LongRec(yy1.b2).Bytes[3] + LongRec(yy2.b2).Bytes[3] ;

      BTDest.P^[ y*wii+x ]:=((totr Shr 2) or ((totg Shr 2) shl 8) or ((totb Shr 2)  shl 16)or ((tota Shr 2) shl 24));

    end;
  end;
end;

procedure AlfaBliting(var BTPic,BTBack:TBT; _x,_y:integer);
var x, y,xd,yd,yyd: Integer; _r,_b,_g:integer;
   w_out,h_out,tmp,x_cor,y_cor,x_corS,y_corS: Integer;
   _d,_dd:double;
   fd,fs,fr:dword;
begin
w_out:=BTBack.DIBWidth;
h_out:=BTBack.DIBHeight;
if (_x)>w_out-1 then exit; if (_x+w_out)<0 then exit;
if (_y)>h_out-1 then exit; if (_y+h_out)<0 then exit;
if _x<0 then x_corS:=abs(_x) else x_corS:=0;
if _y<0 then y_corS:=abs(_y) else y_corS:=0;
if (_x+BTPic.DIBWidth)>w_out then x_cor:=_x+BTPic.DIBWidth-w_out else x_cor:=0;
if (_y+BTPic.DIBHeight)>h_out then y_cor:=_y+BTPic.DIBHeight-h_out else y_cor:=0;
 y_cor:=BTPic.DIBHeight-1-y_cor;
 tmp:=BTPic.DIBWidth-1-x_cor; _dd:=(100/255)/100;
 for y:=y_corS to y_cor do begin
    yd:=y*BTPic.DIBWidth;
    yyd:=(y+_y)*BTBack.DIBWidth;
   for x:=x_corS to tmp do begin
     fd:=BTPic.P^[ yd+x ];
     if(LongRec(fd).Bytes[3]>0)then begin
         xd:=x+_x;
         fs:=BTBack.P^[ yyd +xd ];

         _d:=LongRec(fd).Bytes[3]*_dd;

        _r:= LongRec(fs).Bytes[0]+round((LongRec(fd).Bytes[0]-LongRec(fs).Bytes[0])*_d);
        if _r>255 then _r:=255 else if _r<0 then _r:=0;

        _g:= LongRec(fs).Bytes[1]+round((LongRec(fd).Bytes[1]-LongRec(fs).Bytes[1])*_d);
        if _g>255 then _g:=255 else if _g<0 then _g:=0;

        _b:= LongRec(fs).Bytes[2]+round((LongRec(fd).Bytes[2]-LongRec(fs).Bytes[2])*_d);
        if _b>255 then _b:=255 else if _b<0 then _b:=0;

      if LongRec(fs).Bytes[3]<LongRec(fd).Bytes[3] then
        BTBack.P^[ yyd +xd ]:=(_r or (_g shl 8) or (_b  shl 16)or (LongRec(fd).Bytes[3] shl 24))
      else
        BTBack.P^[ yyd +xd ]:=(_r or (_g shl 8) or (_b  shl 16)or (LongRec(fs).Bytes[3] shl 24));

       end;

 end; end;

end;

procedure Bliting(var BTPic,BTBack:TBT; _x,_y:integer);
var x, y,yd,yyd: Integer;
   w_out,h_out,tmp,x_cor,y_cor,x_corS,y_corS: Integer;
begin
w_out:=BTBack.DIBWidth;
h_out:=BTBack.DIBHeight;
if (_x)>w_out-1 then exit; if (_x+w_out)<0 then exit;
if (_y)>h_out-1 then exit; if (_y+h_out)<0 then exit;
if _x<0 then x_corS:=abs(_x) else x_corS:=0;
if _y<0 then y_corS:=abs(_y) else y_corS:=0;
if (_x+BTPic.DIBWidth)>w_out then x_cor:=_x+BTPic.DIBWidth-w_out else x_cor:=0;
if (_y+BTPic.DIBHeight)>h_out then y_cor:=_y+BTPic.DIBHeight-h_out else y_cor:=0;
 y_cor:=BTPic.DIBHeight-1-y_cor;
 tmp:=BTPic.DIBWidth-1-x_cor;
 for y:=y_corS to y_cor do begin
    yd:=y*BTPic.DIBWidth;
    yyd:=(y+_y)*BTBack.DIBWidth;
   for x:=x_corS to tmp do begin
     if(LongRec(BTPic.P^[ yd+x ]).Bytes[3]>0)then
        BTBack.P^[ yyd+x+_x ]:=BTPic.P^[ yd+x ];
   end;
 end;
end;

procedure BitmapAntialias2X(SrcBitmap, DstBitmap: TBt);
type    AGRBQuad = array [0..0] of TRGBQuad;
     PAGRBQuad = ^AGRBQuad;
var     yDest: integer;
     xDest: integer;
     xSrc: integer;
     i: integer;
     R: integer;
     G: integer;
     B: integer;
     rowDest: PAGRBQuad;
     rowSrc: array [0..3] of PAGRBQuad;
     _rowSrc: PAGRBQuad;
     SrcBits: DWORD;
     DstBits: DWORD;
     dHeight: DWORD;
     dWidth: DWORD;
     Delta: DWORD;
begin
 if CPUisMMX then begin
     SrcBits := DWORD(SrcBitmap.P);
     DstBits := DWORD(DstBitmap.P);
     dHeight := DstBitmap.DIBHeight;
     dWidth := DstBitmap.DIBWidth;
     Delta := SrcBitmap.DIBWidth*SizeOf(BTElement);//ScanLineSize(SrcBitmap);
     asm
         pushad
         mov esi, SrcBits
         mov edi, DstBits
         //pxor mm2, mm2
         db $0f, $ef, $d2

         mov eax, dHeight
@LM1:       push eax

         mov eax, dWidth
@LM2:       /////////
         mov ecx, esi

         //movd mm1, [ecx]
         db $0f, $6e, $09
         //punpcklbw mm1, mm2
         db $0f, $60, $ca
         //movd mm3, [ecx+4]
         db $0f, $6e, $59, $04
         //punpcklbw mm3, mm2
         db $0f, $60, $da
         //paddusw mm1, mm3
         db $0f, $dd, $cb

         add ecx, Delta

         //movd mm3, [ecx]
         db $0f, $6e, $19
         //punpcklbw mm3, mm2
         db $0f, $60, $da
         //paddusw mm1, mm3
         db $0f, $dd, $cb
         //movd mm3, [ecx+4]
         db $0f, $6e, $59, $04
         //punpcklbw mm3, mm2
         db $0f, $60, $da
         //paddusw mm1, mm3
         db $0f, $dd, $cb

         //psrlw mm1, 2
         db $0f, $71, $d1, $02
         //packuswb mm1, mm2
         db $0f, $67, $ca
         //movd [edi], mm1
         db $0f, $7e, $0f
         /////////

         add edi, 4
         add esi, 8

         sub eax, 1
   jnz @LM2

         add esi, Delta

         pop eax
         sub eax, 1
   jnz @LM1

         //emms
         db $0f, $77

         popad
     end;
 end else
 {for yDest := 0 to DstBitmap.DIBHeight -1 do begin
     rowDest := DstBitmap.ScanLine[yDest];
     for i := 0 to 1 do
         rowSrc[i] := SrcBitmap.ScanLine[yDest*2+i];
     for xDest := 0 to DstBitmap.Width-1 do begin
         xSrc := xDest*2;
         R:=0; G:=0; B:=0;
         for i := 0 to 1 do begin
             _rowSrc := rowSrc[i];
             R:= R+_rowSrc[xSrc+0].rgbRed
                 + _rowSrc[xSrc+1].rgbRed;
             G:= G+_rowSrc[xSrc+0].rgbGreen
                 + _rowSrc[xSrc+1].rgbGreen;
             B:= B+_rowSrc[xSrc+0].rgbBlue
                 + _rowSrc[xSrc+1].rgbBlue;
         end;
         DWORD(rowDest[xDest]) := ((R and $03fc) shl 14) or ((G and $03fc) shl 6) or (B shr 2);
     end;
 end;  }
end;

if ((DWORD(Row2[x]) AND $ffffff)=$ff0000) then

Row2[x].rgbReserved := Byte(boolean( (DWORD(Row2[x]) AND $ffffff) xor $ff0000) )*$ff;