{

   SmallC
   small_c@mail.china.com
   圖像合成,速度較快.
   小弟是改自一個叫 "AlComps"的控件包.
  }
unit CBmp;

interface

  Uses Windows ;

  procedure BlendPic(hBmp,hBmp2,hDC,Proportion :Integer);
  procedure BlendPic2(hBmp,hBmp2,hDC,Proportion :Integer);
 
implementation {==========================================================}

type

TFColor=record
  b,g,r: Byte;
end;

TLine=array[0..0]of TFColor;
PLine=^TLine;

var
  Handle, Handle2,
  Width,Height:     Integer;
  Bits,Bits2:       Pointer;
  BmpHeader:        TBITMAPINFOHEADER;
  BmpInfo:          TBITMAPINFO;
  RGB1:array of TFColor  ;
  RGB2:array of TFColor  ;

procedure SetLine(y:Integer;Line,Line2:Pointer);
begin
  CopyMemory( Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3)),
                Line,Width*3);

  CopyMemory(Pointer(Integer(Bits2)+(y*(Width mod 4))+((y*Width)*3)),
                Line2,Width*3);
end;

procedure GetScanLine(y:Integer;Line,Line2:Pointer);
begin
  CopyMemory(Line,
                Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3)),
                Width*3);
  CopyMemory(Line2,
                Pointer(Integer(Bits2)+(y*(Width mod 4))+((y*Width)*3)),
                Width*3);
end;

procedure CreateFromhWnd(hBmp,hBmp2:Integer);
    var Bmp:  TBITMAP;
        hDC:  Integer;
begin
       //為專門設備創建設備場景
  hDC:=CreateDC('DISPLAY',nil,nil,nil);
                //DISPLAY 獲取整個屏幕
   //每個設備場景都可能有選入其中的圖形對象。
  SelectObject(hDC,hBmp);
             //設備場景的句柄; 位圖句柄
  //取得對指定對象進行說明的一個結構。
  GetObject(hBmp,SizeOf(Bmp),@Bmp);
         //位圖句柄;長度; 位圖BITMAP
  Width:= Bmp.bmWidth;
  Height:=Bmp.bmHeight;

  with BmpHeader do
  begin
    biSize:=SizeOf(BmpHeader);
    biWidth:=Width;
    biHeight:=- Height;
    biPlanes:=1;
    biBitCount:=24;
    biCompression:=BI_RGB;
  end;
  BmpInfo.bmiHeader:=BmpHeader;

    Handle:=CreateDIBSection(0,BmpInfo,
                   DIB_RGB_COLORS,
                   Bits,0,0);
   Handle2:=CreateDIBSection(0,BmpInfo,
                   DIB_RGB_COLORS,
                   Bits2,0,0);

   //將來自一幅位圖的二進制位復制到一幅與設備無關的位圖里
  GetDIBits(hDC,                  //設備場景的句柄
            hBmp,                 //源位圖的句柄。
            0,                    //欲復制到DIB中的第一條掃描線的編號
            Height,                //欲復制的掃描線數量
            Bits,                  //指向一個緩沖區的指針。
            BmpInfo,                //BITMAPINFO，對lpBits DIB的格式及顏色進行說明的一個結構。
            DIB_RGB_COLORS);        //在顏色表中裝載RGB顏色
   GetDIBits(hDC,
            hBmp2,
            0,
            Height,
            Bits2,
            BmpInfo,
            DIB_RGB_COLORS);

  DeleteDC(hDC);   //刪除專用設備場景或信息場景
end;

procedure BlendPic(hBmp,hBmp2,hDC,Proportion :Integer);
  var   x,y : Integer;
        Line,Line2:   PLine;
        p,p2:Single;
begin
   CreateFromhWnd(hBmp,hBmp2);
   GetMem(Line,Width*3);
   GetMem(Line2,Width*3);

  p2:= Proportion/5;
  p:=2-p2;
  for y:=0 to Height-1 do
  begin
    GetScanLine(y,Line,Line2);
    for x:=0 to Width-1 do
    begin
       Line^[x].r:=  Trunc((Line^[x].r*p  +  Line2^[x].r*p2)  / 2) ;
       Line^[x].g:=  Trunc((Line^[x].g*p  +  Line2^[x].g*p2) / 2 ) ;
       Line^[x].b:=  Trunc((Line^[x].b*p  +  Line2^[x].b*p2) / 2 ) ;
    end;
      SetLine(y,Line,Line2);
  end;
  FreeMem(Line,Width*3);     //釋放內存
  FreeMem(Line2,Width*3);

  SetDIBitsToDevice(hDC,                 //設備場景的句柄。該場景用于接收位圖數據
                    0,0,                 //用邏輯坐標表示的目標矩形的起點
                    Width,Height,       //用目標矩形的設備單位表示的寬度及高度
                    0,0,                //用設備坐標表示的源矩形在DIB中的起點
                    0,                  //Bits數組中第一條掃描線的編號。
                    Height,              //欲復制的掃描線數量
                    Bits ,               //指向一個緩沖區的指針
                    BmpInfo,            //BITMAPINFO，對Bits DIB的格式和顏色進行描述的一個結構
                    DIB_RGB_COLORS);   //顏色表包含了RGB顏色

  DeleteObject(Handle);  //刪除GDI對象
  DeleteObject(Handle2);

  end;


procedure CreateFromhWnd2(hBmp,hBmp2:Integer);
    var Bmp:   TBITMAP;
        hDC :  Integer;
        Prgb:Pointer;
begin
  hDC:=CreateDC('DISPLAY',nil,nil,nil);
  SelectObject(hDC,hBmp);
  GetObject(hBmp,SizeOf(Bmp),@Bmp);
  Width:= Bmp.bmWidth;
  Height:=Bmp.bmHeight;

  with BmpHeader do
  begin
    biSize:=SizeOf(BmpHeader);
    biWidth:=Width;
    biHeight:=- Height;
    biPlanes:=1;
    biBitCount:=24;
    biCompression:=BI_RGB;
  end;
  BmpInfo.bmiHeader:=BmpHeader;

    setlength(RGB1, Width*Height ) ;
    setlength(RGB2, Width*Height ) ;
     Prgb:=@RGB1[0];
    Handle:=CreateDIBSection(0,BmpInfo,
                   DIB_RGB_COLORS,Prgb ,0,0);

     Prgb:=@RGB2[0];
    Handle2:=CreateDIBSection(0,BmpInfo,
                   DIB_RGB_COLORS, Prgb ,0,0);

  GetDIBits(hDC,hBmp,0,Height,@RGB1[0],
            BmpInfo,DIB_RGB_COLORS);
   GetDIBits(hDC,hBmp2,0,Height,@RGB2[0],
             BmpInfo,DIB_RGB_COLORS);

  DeleteDC(hDC);
end;

procedure BlendPic2(hBmp,hBmp2,hDC,Proportion :Integer);
  var   x   : Integer;
        p,p2:Single;
begin
   CreateFromhWnd2(hBmp,hBmp2);
   p2:= Proportion/5;
   p:=2-p2;
   for x:=0 to high(RGB1)  do
    begin
       RGB1[x].r:=  Trunc((RGB1[x].r*p  +  RGB2[x].r*p2) / 2 ) ;
       RGB1[x].g:=  Trunc((RGB1[x].g*p  +  RGB2[x].g*p2) / 2 ) ;
       RGB1[x].b:=  Trunc((RGB1[x].b*p  +  RGB2[x].b*p2) / 2 ) ;
    end;

  SetDIBitsToDevice(hDC,0,0,Width,Height,0,0,0,Height,@RGB1[0],
                    BmpInfo,DIB_RGB_COLORS);

   setlength(RGB1, 0) ;
   setlength(RGB2, 0) ;
  DeleteObject(Handle);   
  DeleteObject(Handle2);

  end;


end.