Как склеить несколько bmp в 1?

← →
greenrul © (2003-07-08 16:13) [0]

В кладовке есть exe файл но исходников его нет. Знаю только что он организован через DrawScene. Мне нужно наложить друг на друга 3-4 bmp картинки и сохранить их в файл.

← →
iXuSs (2003-07-08 16:59) [1]

> Мне нужно наложить друг на друга 3-4 bmp картинки и сохранить их в файл.

Сохранить результат или картинки?

← →
jel © (2003-07-08 17:18) [2]

А зачем тут DrawScene?
Если радом положить BitBlt
Если друг на друга - то считать попиксельно с весовыми коэффициентами.

← →
pasha676 (2003-07-08 17:41) [3]

> Если друг на друга - то считать попиксельно с весовыми коэффициентами.

Вот тут наверное легче через DirectX с использованием альфа канала. Хотя с другой стороны требуется время на изучение DirectX

← →
iXuSs (2003-07-08 17:55) [4]

> Вот тут наверное легче через DirectX с использованием альфа канала.

Если нужен альфа-блендинг, то проще будет использовать Graphic32.

← →
Fenik © (2003-07-08 18:30) [5]

http://delphibase.endimus.com/?action=viewfunc&topic=mediaimg&id=10300

← →
pasha676 (2003-07-09 11:19) [6]

> Если нужен альфа-блендинг, то проще будет использовать Graphic32.

Да, пожалуй вариант оптимальный.

← →
greenrul © (2003-07-09 12:59) [7]

А что именно в Graphic32? Хотя блендинг мне не нужен

← →
iXuSs (2003-07-09 15:32) [8]

> А что именно в Graphic32? Хотя блендинг мне не нужен

Именно - возможность альфа-блендинга, причём довольно быстрая. Проще будет потому, что работа с этим пакетом почти не отличается от работы со стандартными средствами Delphi, я ьы даже сказал, что нужно просто дописать "32" в конец и всё будет работать. В частности, имею ввиду работу с TBitmap32. Отличие Graphic32 от других графических пакетов состоит в том, что он оснащён полной справкой, благодаря которой можно без проблем выяснить какой-либо интересующий момент.

Если ты будешь использовать его, то вот адрес:
http://www.g32.org

В Graphic32, правда, есть маленький недостаток - отсутствие по умолчанию свойства Transparent. Дело в том, что сам пакет изначально работает только с 32-битными изображениями (при этом, необходимые преобразования делаются пакетом самостоятельно). Автор предполагает, что будут загружаться изображения, уже содержащие альфа-маску. Тем не менее, на том же сайте в FAQ он предоставляет функцию CromaKey для создания альфа-канала, т.е. замену свойству Transparent обычного TBitmap.

← →
Fenik © (2003-07-09 18:13) [9]

Да куда вы зарываетесь??
Такое можно за 10 минут с обычными битмапами сделать!

← →
greenrul © (2003-07-10 20:42) [10]

2Fenik - ну поделись пожалуйста

← →
iXuSs (2003-07-10 21:13) [11]

Вот например:

const N{umber of Bitmaps} = 3; var Bitmaps: array [1..N] of TBitmap; Result: TBitmap; i: Integer; begin For i := 1 to N do begin Bitmaps[i].LoadFromFile(IntToStr(i) + ".bmp"); Bitmaps[i].Transparent := True; end; Result.Width := Bitmaps[1].Width; Result.Height := Bitmaps[1].Height; For i := 1 to N do begin Result.Draw(0, 0, Bitmaps[i]); ( "Result.bmp") Вот например: const N{umber of Bitmaps} = 3; var Bitmaps: array [1..N] of TBitmap; Result: TBitmap; i: Integer; begin For i := 1 to N do begin Bitmaps[i].LoadFromFile(IntToStr(i) + ".bmp"); Bitmaps[i].Transparent := True; end; Result.Width := Bitmaps[1].Width; Result.Height := Bitmaps[1].Height; For i := 1 to N do begin Result.Draw(0, 0, Bitmaps[i]); end; Result.SaveToFile("Result.bmp"); end; Ошибки, если будут, исправь сам.

← →
Fenik © (2003-07-11 00:04) [12]

Или вот, абсолютно рабочий пример наложения N-битмепов друг на друга, причём разного размера. У всех одинаковая прозрачность. Для разных уровней прозрачности переделать легче лёгкого..

type
TBitmaps = array of TBitmap;

procedure AlphaBitmaps(DestBmp: TBitmap; SrcBmps: TBitmaps; CountBitmaps: Word);
var n, i, r, g, b, x, y, p: Integer;
ANum: array of record
x, y: Boolean;
end;
Dest: pByteArray;
Src: array of pByteArray;
begin
x := 0;
y := 0;
for i := 0 to CountBitmaps-1 do begin
if SrcBmps[i].Width > x then x := SrcBmps[i].Width;
if SrcBmps[i].Height > y then y := SrcBmps[i].Height;
SrcBmps[i].PixelFormat := pf24Bit;
end;
DestBmp.Width := x;
DestBmp.Height := y;
DestBmp.PixelFormat := pf24Bit;

SetLength(ANum, CountBitmaps);
for i := 0 to CountBitmaps-1 do begin
ANum[i].x := True;
ANum[i].y := True;
end;
SetLength(Src, CountBitmaps);

for y := 0 to DestBmp.Height-1 do begin
Dest := DestBmp.ScanLine[y];
for i := 0 to CountBitmaps-1 do
if ANum[i].y then begin
if SrcBmps[i].Height > y
then Src[i] := SrcBmps[i].ScanLine[y]
else ANum[i].y := False;
end;

for x := 0 to DestBmp.Width-1 do begin
r := 0;
g := 0;
b := 0;
n := 0;
p := x*3;
for i := 0 to CountBitmaps-1 do begin
if ANum[i].x and ANum[i].y then begin
if SrcBmps[i].Width > x then begin
Inc(b, Src[i, p]);
Inc(g, Src[i, p+1]);
Inc(r, Src[i, p+2]);
Inc(n);
end
else ANum[i].x := False;
end;
end;

Dest[p] := Round(b/n);
Dest[p+1] := Round(g/n);
Dest[p+2] := Round(r/n);
end;

for i := 0 to CountBitmaps-1 do ANum[i].x := True;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const N = 4; {Number of Bitmaps}
var i: Integer;
ResultBmp: TBitmap;
Bitmaps: TBitmaps;
begin
ResultBmp := TBitmap.Create;
try
SetLength(Bitmaps, N);
for i := 0 to N-1 do begin
Bitmaps[i] := TBitmap.Create;
Bitmaps[i].LoadFromFile(IntToStr(i+1) + ".bmp");
end;
AlphaBitmaps(ResultBmp, Bitmaps, N);
Canvas.Draw(100, 100, ResultBmp);
finally
ResultBmp.Free;
for i := 0 to N-1 do Bitmaps[i].Free;
end;
end;

Правда, ошибся на 15 минут :)))

← →
iXuSs (2003-07-11 23:41) [13]

2 Fenik:

Не реализовано сохранение в файл.

> Не реализовано сохранение в файл.

:)))

Точно, самое сложное забыл. Да я просто не знаю как это делать! :)

"iXuSs" - новое воплощение?

← →
iXuSs (2003-07-12 00:11) [15]

В том-то вся и психология. Замечательный, красивый и оформленный код, но не реализован один маленький ньюанс, который, тем не менее, портит общую картину. В то же время, копировать код, добавлять сохранение в файл, а затем снова постить не позволит та же психология. В результате, из-за этикета, традиций, предсрассудков и жизненного опыта страдает общая и главная картина. Такого бы не было, если бы была реализована возможность редактировать сообщения, но это уже обсуждение работы форума и на этом в данной ветке независимо от момента мы заостряться не будем.

iXuSs - временное вопрощение.

← →
iXuSs (2003-07-12 00:16) [16]

Реализация на Graphic32:

const
N{umber of Bitmaps} = 3;
var
Bitmaps: array [1..N] of TBitmap32;
Result: TBitmap32;
i: Integer;
begin
For i := 1 to N do
begin
Bitmaps[i] := TBitmap32.Create;
Bitmaps[i].LoadFromFile(IntToStr(i) + ".bmp");
CromaKey(Bitmaps[i], clWhite);
// CromaKey(Bitmaps[i], Bitmaps[i].PixelS[0,0]);
Bitmaps[i].DrawMode := dmBlend;
// Строка ниже задаёт степень прозрачности
// Bitmaps[i].MasterAlpha := [0..255];
end;
Result.Width := Bitmaps[1].Width;
Result.Height := Bitmaps[1].Height;
For i := 1 to N do
begin
( 0, 0, Bitmaps[i]) Реализация на Graphic32:

const
N{umber of Bitmaps} = 3;
var
Bitmaps: array [1..N] of TBitmap32;
Result: TBitmap32;
i: Integer;
begin
For i := 1 to N do
begin
Bitmaps[i] := TBitmap32.Create;
Bitmaps[i].LoadFromFile(IntToStr(i) + ".bmp");
CromaKey(Bitmaps[i], clWhite);
// CromaKey(Bitmaps[i], Bitmaps[i].PixelS[0,0]);
Bitmaps[i].DrawMode := dmBlend;
// Строка ниже задаёт степень прозрачности
// Bitmaps[i].MasterAlpha := [0..255];
end;
Result.Width := Bitmaps[1].Width;
Result.Height := Bitmaps[1].Height;
For i := 1 to N do
begin
Result.Draw(0, 0, Bitmaps[i]);
end;
Result.SaveToFile("Result.bmp");
end;

Чудик © (11.07.03 23:56) - упс Совсем Зачудился ;))))

временное воплощение )))

> iXuSs (12.07.03 00:11)

Но картинка ведь выводится на форму, т.е. результат виден!

> Fenik © (12.07.03 00:25)

>> iXuSs (12.07.03 00:11)

> Но картинка ведь выводится на форму, т.е. результат виден!

Да, не в тему ответил.

Надо меньше пить! )))

Как склеить несколько bmp в 1? Найти похожие ветки