(原)背景图片简单替换（delphi 全范围 photoshop抠图），无法达到100%的效果，仅提供参考。速度还不错。

最新推荐文章于 2026-06-20 22:29:48 发布

原创最新推荐文章于 2026-06-20 22:29:48 发布 · 6.9k 阅读

8 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#delphi #integer #div #forms #types

本文介绍了一个使用Delphi实现的照片背景简单替换程序。该程序能够从原始照片中切割背景，并将其替换成新的背景图片。虽然效果并非完美，但对于快速更换照片背景提供了实用的解决方案。

上次不知道谁说要弄个照相馆的图片背景更换。于是写了个简单的。··

背景图片简单替换（delphi 全范围 photoshop抠图），无法达到100%的效果，仅提供参考。速度还不错。

没使用生长算法，边界探测。

欢迎访问个人网站：www.googler.cc 源码在www.googler.cc网站上有下,进入Software链接后，选择cutout的那个。

unit MainFrm; //============================================================================== //照相馆照片背景图片简单替换（delphi 全范围photoshop抠图），无法达到100%的效果，仅提供1个参考。 // Cutout the background from the image. //背景图大小必须比原图大 //作者：胡睿 //CSDN: huruihappy //欢迎访问www.googler.cc www.j2megame.com //============================================================================== interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,jpeg, StrUtils, ComCtrls,types,ShellAPI; type TForm1 = class(TForm) GroupBox3: TGroupBox; img_BackGround: TImage; GroupBox1: TGroupBox; Img_Src: TImage; GroupBox2: TGroupBox; Img_Dest: TImage; btn_ImportSrc: TButton; btn_importBaclGroundImg: TButton; btn_Process: TButton; btn_BatProcess: TButton; OpenDialog1: TOpenDialog; Memo1: TMemo; TrackBar1: TTrackBar; Label1: TLabel; Label2: TLabel; Label3: TLabel; procedure btn_ImportSrcClick(Sender: TObject); procedure btn_importBaclGroundImgClick(Sender: TObject); procedure btn_ProcessClick(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } isLoadImg : Boolean ; isLoadBackGroundImg : Boolean ; public { Public declarations } srcBmpImg : TBitmap ; backGroundImg : TBitmap ; ImageValue : Integer ; end; var Form1: TForm1; implementation {$R *.dfm} //============================================================================== // 导入原卷图片 //============================================================================== procedure TForm1.btn_ImportSrcClick(Sender: TObject); var ImagePath : ShortString ; JpgImg : TJpegImage ; begin if OpenDialog1.Execute then begin //获取文件路径 if OpenDialog1.FileName <> '' then begin ImagePath := OpenDialog1.FileName ; end ; //仅支持BMP和JPG/JPEG格式 if ( RightStr(ImagePath, 3) <> 'bmp' ) and ( RightStr(ImagePath, 3) <> 'jpg' ) and ( RightStr(ImagePath, 3) <> 'epg' ) then begin ShowMessage( ' 对不起，仅支持BMP和JPG格式的图 ' ); Exit ; end ; isLoadImg := True ; if srcBmpImg <> nil then srcBmpImg.Free ; if JpgImg <> nil then JpgImg.Free ; //创建BMP格式图 srcBmpImg := TBitmap.Create ; if ( RightStr(ImagePath, 3) = 'bmp' ) then begin srcBmpImg.LoadFromFile(ImagePath); end ; //创建JPG格式图 if ( RightStr(ImagePath, 3) = 'jpg' ) or ( RightStr(ImagePath, 3) = 'epg' ) then begin JpgImg := TJpegImage.Create; try JpgImg.LoadFromFile(ImagePath); srcBmpImg.Assign(JpgImg); finally JpgImg.Free; end; end ; //导入图片 Img_Src.Picture.Assign(srcBmpImg); end ; end; //============================================================================== //导入背景图片 //============================================================================== procedure TForm1.btn_importBaclGroundImgClick(Sender: TObject); var ImagePath : ShortString ; JpgImg : TJpegImage ; begin if OpenDialog1.Execute then begin //获取文件路径 if OpenDialog1.FileName <> '' then begin ImagePath := OpenDialog1.FileName ; end ; //仅支持BMP和JPG/JPEG格式 if ( RightStr(ImagePath, 3) <> 'bmp' ) and ( RightStr(ImagePath, 3) <> 'jpg' ) and ( RightStr(ImagePath, 3) <> 'epg' ) then begin ShowMessage( ' 对不起，仅支持BMP和JPG格式的图 ' ); Exit ; end ; isLoadBackGroundImg := True ; if backGroundImg <> nil then backGroundImg.Free ; if JpgImg <> nil then JpgImg.Free ; //创建BMP格式图 backGroundImg := TBitmap.Create ; if ( RightStr(ImagePath, 3) = 'bmp' ) then begin backGroundImg.LoadFromFile(ImagePath); end ; //创建JPG格式图 if ( RightStr(ImagePath, 3) = 'jpg' ) or ( RightStr(ImagePath, 3) = 'epg' ) then begin JpgImg := TJpegImage.Create; try JpgImg.LoadFromFile(ImagePath); backGroundImg.Assign(JpgImg); finally JpgImg.Free; end; end ; //导入图片 img_BackGround.Picture.Assign(backGroundImg); end ; end; //============================================================================== //处理图像 //============================================================================== procedure TForm1.btn_ProcessClick(Sender: TObject); var i,j : Integer ; PSrcImg : PbyteArray; PBackGround : PByteArray ; TRed,TGreen,TBlue,TMaxColor : Integer ; begin TRed := 0 ; TGreen := 0 ; TBlue := 0 ; TMaxColor := 0 ; //1 R 2 G 3 B 4 WHITE if isLoadBackGroundImg and isLoadImg then begin //获取背景图颜色 for i := 0 to 10 do begin PSrcImg := srcBmpImg.ScanLine[i]; for j := 0 to 10 do begin TBlue := TBlue + PSrcImg[j*3] ; TGreen := TGreen + PSrcImg[j*3+1] ; TRed := TRed + PSrcImg[j*3+2] ; end ; end ; TBlue := TBlue div 121 ; TGreen := TGreen div 121 ; TRed := TRed div 121 ; if (TBlue >= TGreen) and (TBlue >=TRed) then begin //偏蓝 TMaxColor := 3 ; end ; if (TGreen >= TBlue) and (TGreen >= TRed) then begin //偏绿 TMaxColor := 2 ; end ; if (TRed >= TGreen) and (TRed >= TBlue) then begin //偏红 TMaxColor := 1 ; end ; if ( (TRed = TGreen) or (TRed = TBlue) or (TGreen = TBlue) ) and ( Abs( ( TGreen + TRed + TBlue ) div 3 - TBlue ) <= 25 ) then begin //白 TMaxColor := 4 ; end ; //获取原图所有点的像素并储存 for i := 0 to srcBmpImg.Height-1 do begin PSrcImg:= srcBmpImg.ScanLine[i]; PBackGround := backGroundImg.ScanLine[i]; for j := 0 to srcBmpImg.Width-1 do begin case TMaxColor of 1 : //偏红 begin if ( PSrcImg[j*3+2] - PSrcImg[j*3] > ImageValue ) and ( PSrcImg[j*3+2] - PSrcImg[j*3+1] > ImageValue ) then begin PSrcImg[j*3] := PBackGround[j*3] ; PSrcImg[j*3+1] := PBackGround[j*3+1] ; PSrcImg[j*3+2] := PBackGround[j*3+2] ; end ; end ; 2 : //偏绿 begin if ( PSrcImg[j*3+1] - PSrcImg[j*3] > ImageValue ) and ( PSrcImg[j*3+1] - PSrcImg[j*3+2] > ImageValue ) then begin PSrcImg[j*3] := PBackGround[j*3] ; PSrcImg[j*3+1] := PBackGround[j*3+1] ; PSrcImg[j*3+2] := PBackGround[j*3+2] ; end ; end ; 3 : //偏蓝 begin if ( PSrcImg[j*3] - PSrcImg[j*3+1] > ImageValue ) and ( PSrcImg[j*3] - PSrcImg[j*3+2] > ImageValue ) then begin PSrcImg[j*3] := PBackGround[j*3] ; PSrcImg[j*3+1] := PBackGround[j*3+1] ; PSrcImg[j*3+2] := PBackGround[j*3+2] ; end ; end ; 4 : //偏白 begin if ( Abs( (PSrcImg[j*3] + PSrcImg[j*3+1] + PSrcImg[j*3+2]) div 3 - PSrcImg[j*3] ) <= 25 ) then begin PSrcImg[j*3] := PBackGround[j*3] ; PSrcImg[j*3+1] := PBackGround[j*3+1] ; PSrcImg[j*3+2] := PBackGround[j*3+2] ; end ; end ; end ; end ; end ; Img_Src.Picture.Assign(srcBmpImg); Img_Dest.Picture.Assign(srcBmpImg); // Memo1.Lines.SaveToFile('c:/ImageProcess.txt'); end ; end; //============================================================================== //容差 //============================================================================== procedure TForm1.TrackBar1Change(Sender: TObject); begin ImageValue := TrackBar1.Position ; Label1.Caption := '容差：' + IntToStr(ImageValue) + ' ' ; end; //============================================================================== //初始化 //============================================================================== procedure TForm1.FormCreate(Sender: TObject); begin ImageValue := TrackBar1.Position ; ShowMessage('My email : 235483710@qq.com -- Hu Rui . Thanks for www.googler.cc and www.j2megame.com 。'); shellexecute(handle,'open',pchar('http://www.googler.cc'),nil,nil,sw_show); shellexecute(handle,'open',pchar('http://www.j2megame.com'),nil,nil,sw_show); end; end.

更换图片的背景：