www.pudn.com > tuxiangbantouminghechneg.rar > CBmp.pas

  { 
 
   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.