Склеиваем изображения средствами Delphi

Иногда требуется соединить (склеить) в программе несколько изображений. Мне такое потребовалось при написании программы для регистрации email’ов.

Сделать склейку поможет нижеследующая процедура:

procedure Glue;
var J1,J2,J3 , JSum: TJPEGImage;
r1,r2: TRect;
B1, B2, B3, BSum, BSum2: TBitmap;
begin
J1:= TJPEGImage.Create;
J2:= TJPEGImage.Create;
J3:= TJPEGImage.Create;
JSum:= TJPEGImage.Create;

BSum:= TBitmap.Create;
BSum2:= TBitmap.Create;
B1:= TBitmap.Create;
B2:= TBitmap.Create;
B3:= TBitmap.Create;

J1.LoadFromFile(‘1.jpeg’);
J2.LoadFromFile(‘2.jpeg’);
J3.LoadFromFile(‘3.jpeg’);
B1.Assign(J1);
B2.Assign(J2);
B3.Assign(J3);

// BSum — склеиваем B1 и B2
BSum.Width:= B1.Width+B2.Width; // устанавливаем длину
BSum.Height:= Max(B1.Height,B2.Height); // устанавливаем ширину

r1 := Rect(0,0,B1.Width-1,B1.Height-1);
BSum.Canvas.CopyRect(r1,B1.Canvas,r1);

r1 := Rect(0,0,B2.Width-1,B2.Height-1);
r2 := Rect(B1.Width,0,B1.Width+B2.Width-1,B2.Height-1);
BSum.Canvas.CopyRect(r2,B2.Canvas,r1);

// BSum2 — склеиваем BSum и B3
BSum2.Width:= BSum.Width+B3.Width; // устанавливаем длину
BSum2.Height:= Max(BSum.Height,B3.Height); // устанавливаем ширину

r1 := Rect(0,0,BSum.Width-1,BSum.Height-1);
BSum2.Canvas.CopyRect(r1,BSum.Canvas,r1);

r1 := Rect(0,0,B3.Width-1,B3.Height-1);
r2 := Rect(BSum.Width,0,BSum.Width+B3.Width-1,B3.Height-1);
BSum2.Canvas.CopyRect(r2,B3.Canvas,r1);

JSum.Assign(BSum2);
JSum.SaveToFile(‘4.jpeg’);

B1.Free;
B2.Free;
B3.Free;
BSum.Free;
BSum2.Free;
J1.Free;
J2.Free;
J3.Free;
JSum.Free;
end;
Она склеивает три произвольных изображения в одно. Процедура универсальна, изображения могут быть разного размера.

Немного по алгоритму:

Переводим изображения jpeg в bmp
В переменную BSum копируем прямоугольную область первого изображения и правее — прямоугольную область второго изображения
В переменную BSum2 копируем прямоугольную область BSum и правее — прямоугольную область третьего изображения
Сохраняем BSum2 в файл jpeg

Для процедуры необходимо в uses прописать jpeg и Math

Прилагаю также исходник программы, использующей эту процедуру

Склейка jpg

Добавить комментарий