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

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; 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;

补充：软件开发 , Delphi ,

上一个：delphi Shell_NotifyIcon（系统托盘图标API函数）
下一个：DELPHI+SQLITE实现自定义公式