您现在的位置:首页 >> 图形媒体 >> 图形媒体 >> 内容

Delphi给图片添加平铺水印效果

时间:2011/9/3 15:01:29 点击:

  核心提示:function TForm1.WaterMaskBitmap(SrcBmp, MaskBmp: Tbitmap;AlphaColor:Tcolor;AlphaValue:integer): Tbit...
function TForm1.WaterMaskBitmap(SrcBmp, MaskBmp: Tbitmap;AlphaColor:Tcolor;AlphaValue:integer): Tbitmap;
type
TPixels = Array of array of TRGBTriple;

function GetPPbitmap(const Width,height:integer;SrcBmp:Tbitmap):Tbitmap;
var
xi,yi:integer;
begin
Result:=Tbitmap.Create;
Result.Width:=Width;
Result.Height:=Height;
xi:=0;
while (xi<=Result.Width) do
begin
yi:=0;
while (yi<=Result.Height) do
begin
Result.Canvas.Draw(xi,yi,SrcBmp);
yi:=yi+SrcBmp.Height;
end;
xi:=xi+SrcBmp.Width;
end;

end;

Procedure GraphicFading(PicA, PicB: TPixels; const PicR: tBitmap; Percent: Byte);//Make a Fading Picture From

var                                            //PicA to PicB

   MidR,MidG,MidB : Byte;

   i,j : integer; m:Integer;

   pixPtrR : PByteArray;

   Position,pixpos : Single;
   rPos,gPos:Integer;

   PicRWidth:Integer;

begin

     Position := Percent / 100;

     PicRWidth:=PicR.Width-1;

     for i := 0 to picR.Height -1 do begin

         PixPtrR := picR.ScanLine[i];

         for j := 0 to picRWidth do Begin

             m:=j*3;

             rPos:=m+2;

             gPos:=m+1;

         if (PicB[j,i].RGBTRed=GetRValue(AlphaColor)) and (PicB[j,i].RGBTgREEN=GetGValue(AlphaColor)) and (PicB[j,i].RGBTBlue=GetBValue(AlphaColor)) then
             pixpos:=0
             else
             pixpos:=Position;

             midR := PicA[j,i].RGBTRed+Round((PicB[j,i].RGBTRed-PicA[j,i].RGBTRed)*pixpos);

             midG := PicA[j,i].RGBTgREEN+Round((PicB[j,i].RGBTgREEN-PicA[j,i].RGBTgREEN)*pixpos);

             midB := PicA[j,i].RGBTBlue+Round((PicB[j,i].RGBTBlue-PicA[j,i].RGBTBlue)*pixpos);


             pixPtrR[m] := midB;

             pixPtrR[gPos] := midG;

             pixPtrR[rPos] := MidR;

         end;

     end;

end;


procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

Var PixPtr:PbyteArray;
i,j,m:Integer;

begin

SetLength(tPix,Pic.Width,Pic.Height);

Pic.PixelFormat := pf24bit;

Pic.HandleType:=bmDIB;

For i :=0 to pic.Height-1 do begin

      PixPtr:=Pic.ScanLine[i];

      for j:= 0 to pic.Width-1 do begin

         m := j*3;

         tPix[j,i].rgbtBlue:=PixPtr[m];

         tPix[j,i].rgbtGreen := PixPtr[m+1];

         tPix[j,i].rgbtRed := PixPtr[m+2];

      end;

end;

end;

var
PixA,PixB:TPixels;
begin
Result:=Tbitmap.Create;
Result.PixelFormat := pf24Bit;
Result.HandleType:=bmDIB;
Result.Width:=SrcBmp.Width;
Result.Height:=SrcBmp.Height;
ReadPixel(SrcBmp,PixA);
ReadPixel(GetPPbitmap(Result.Width,Result.Height,MaskBmp),PixB);
GraphicFading(PixA,PixB,result,AlphaValue);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
bmpm,bmps:tbitmap;
begin
    Bmpm:=TBitmap.Create;
    bmpm.LoadFromFile('D:\pic2.bmp');
    bmps:=tbitmap.Create;
    bmps.LoadFromFile('D:\pic1.bmp');
    self.Image1.Picture.Bitmap.Assign(self.WaterMaskBitmap(bmps,bmpm,clwhite,50));
end;

作者:幸福苹果 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2020 版权所有 All Rights Reserved.
  • 沪ICP备05001939号