cbmp.pas

图片合成工具

  {

   SmallC
   [e-mail]
   图像合成,速度较快.
   小弟是改自一个叫 "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.