Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Вниз

Как склеить несколько 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:

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


 
Чудик   (2003-07-11 23:56) [14]

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

:)))

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

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


 
Fenik   (2003-07-12 00:25) [17]

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

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


> iXuSs (12.07.03 00:11)

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


 
Fenik   (2003-07-12 00:28) [18]

> Fenik © (12.07.03 00:25)

>> iXuSs (12.07.03 00:11)

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

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

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



Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.036 c
7-42156
karsky
2003-09-01 09:15
2003.11.13
Сканер штрих кодов и Delphi


1-41185
snake1977
2003-11-02 15:50
2003.11.13
два приложения


1-41484
Dark Elf
2003-10-28 18:02
2003.11.13
Подключение dll в проект


6-41838
Незнайко
2003-09-12 16:01
2003.11.13
Как по удал. IP узнать Name?


14-42023
Mihey
2003-10-16 19:14
2003.11.13
Ищё компонент...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский