|
|
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
 |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
17.09.2012, 17:24
|
|||
|
|||
AlphaBlend: наложить bmp на jpg или наоборот
Здравствуйте, делаю лабу, нужно наложить одно изображение на другое, для этого используется Alpha-наложение при помощи API AlphaBlend. Если выбирается jpg, то я преобразую jpg в bmp и пытаюсь наложить. Если оба выбранных изображения bmp, или оба jpg, то всё накладывается отлично, если одно jpg, а другое bmp, то GetLastError с кодом 87(неверно задан параметр). Понятно, что я как-то недопреобразовал jpg, но информации о том, как правильно сделать не нашел.
Может найдется добрый дядя, который мне поможет? Вот код: Код:
procedure TForm1.Button1Click(Sender: TObject);
var
bmp1, bmp2: TBitMap;
jpg1, jpg2: TJpegImage;
Blend: TBlendFunction;
i, j: integer;
s1, s2: string;
begin
jpg1 := TJpegImage.Create;
jpg2 := TJpegImage.Create;
bmp1 := TBitMap.Create;
bmp2 := TBitMap.Create;
try
i := pos('.', edit1.Text);
j := pos('.', edit2.Text);
s1 := Copy(edit1.text, i + 1, 3);
s2 := Copy(edit2.text, j + 1, 3);
if ((s1 = 'jpg') or (s1 = 'jpeg')) and ((s2 = 'jpg') or (s2 = 'jpeg')) then //если оба jpg
begin
jpg1:=TJPEGImage.Create;
bmp1:=TBitmap.Create;
jpg1.CompressionQuality:=100;
jpg1.Compress;
jpg1.LoadFromFile(Edit1.Text);
bmp1.Assign(jpg1);
jpg2:=TJPEGImage.Create;
bmp2:=TBitmap.Create;
jpg2.CompressionQuality:=100;
jpg2.Compress;
jpg2.LoadFromFile(Edit2.Text);
bmp2.Assign(jpg2);
end;
if ((s1 = 'jpg') or (s1 = 'jpeg')) and (s2 = 'bmp') then //если первый jpg, а второй bmp
begin
jpg1:=TJPEGImage.Create;
bmp1:=TBitmap.Create;
jpg1.CompressionQuality:=100;
jpg1.Compress;
jpg1.LoadFromFile(Edit1.Text);
bmp1.Assign(jpg1);
end;
if ((s2 = 'jpg') or (s2 = 'jpeg')) and (s1 = 'bmp') then //если первый bmp, а второй jpg
begin
jpg2:=TJPEGImage.Create;
bmp2:=TBitmap.Create;
jpg2.CompressionQuality:=100;
jpg2.Compress;
jpg2.LoadFromFile(Edit2.Text);
bmp2.Assign(jpg2);
end;
if (s1 = 'bmp') and (s2 = 'bmp') then //если оба bmp
begin
bmp1.LoadFromFile(Edit1.Text);
bmp2.LoadFromFile(Edit1.Text);
end;
bmp1.PixelFormat := pf32bit;
bmp2.PixelFormat := pf32bit;
Blend.BlendOp := AC_SRC_OVER;
Blend.BlendFlags := 0;
Blend.SourceConstantAlpha := ScrollBar1.Position;
Blend.AlphaFormat := AC_SRC_ALPHA;
if Windows.AlphaBlend(bmp1.Canvas.Handle, 0, 0, bmp1.Width, bmp1.Height,
bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) then
image1.Canvas.Draw(0, 0, bmp1)
else
ShowMessage(IntToStr(GetLastError));
bmp1.Free;
bmp2.Free;
except
ShowMessage('Не удалось выполнить наложение, проверьте правильность путей' + #10#13 + 'для выбранных изображений');
end;
end; |
|
#2
17.09.2012, 18:13
|
||||
|
||||
|
Цитата:
 (пришлось переделать почти всё):Код:
procedure TForm1.Button1Click(Sender: TObject);
function GetBitmap(const FileName: string): TBitmap;
var
ext: string;
bmp: TBitmap;
jpg: TJPEGImage;
begin
Result := nil;
ext := AnsiLowerCase(ExtractFileExt(FileName));
if ext = '.bmp' then
begin
bmp := TBitmap.Create;
try
bmp.LoadFromFile(FileName);
Result := bmp;
bmp := nil;
finally
bmp.Free;
end;
end else
if (ext = '.jpg') or (ext = '.jpeg') then
begin
jpg := TJPEGImage.Create;
try
jpg.LoadFromFile(FileName);
bmp := TBitmap.Create;
try
bmp.Assign(jpg);
Result := bmp;
bmp := nil;
finally
bmp.Free;
end;
finally
jpg.Free;
end;
end else
begin
raise Exception.Create('Неизвестное расширение у файла: "' + FileName + '"');
end;
end;
var
bmp1, bmp2: TBitmap;
Blend: TBlendFunction;
err: DWORD;
begin
try
bmp1 := GetBitmap(Edit1.Text);
try
bmp2 := GetBitmap(Edit2.Text);
try
bmp1.PixelFormat := pf32bit;
bmp2.PixelFormat := pf32bit;
Blend.BlendOp := AC_SRC_OVER;
Blend.BlendFlags := 0;
Blend.SourceConstantAlpha := ScrollBar1.Position;
Blend.AlphaFormat := AC_SRC_ALPHA;
if Windows.AlphaBlend(bmp1.Canvas.Handle, 0, 0, bmp1.Width, bmp1.Height,
bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) then
begin
Image1.Canvas.Draw(0, 0, bmp1);
// или так:
// Image1.Picture.Assign(bmp1);
end else
begin
err:=GetLastError;
MessageDlg('Ошибка №'+IntToStr(err)+': "'+SysErrorMessage(err)+'"',
mtError, [mbOK], 0);
end;
finally
bmp2.Free;
end;
finally
bmp1.Free;
end;
except
on E: Exception do
begin
MessageDlg('Возникло исключение класса "'+E.ClassName+'", с сообщением "'+
E.Message+'"', mtError, [mbOk], 0 );
end;
end;
end; |
|
#3
17.09.2012, 18:41
|
|||
|
|||
|
Спасибо, конечно, огромное, за переделку, а не могли бы Вы мне сказать каким нибудь русским предложением, в чём была моя ошибка? Так было бы быстрее. Если не учитывать все мелкие различия, то бросается в глаза следующее, у Вас в функции преобразования нет сжатия.
Убрал сжатие не помогло, та же ошибка. Если есть еще какая-то принципиальная разница между процедурами я её не заметил. Последний раз редактировалось Fredwriter, 17.09.2012 в 19:03. |
|
#4
17.09.2012, 20:03
|
|||
|
|||
|
Нашел ошибку, оказалось, я когда у меня разные форматы, загружал только jpg, а bmp забыл. Банальная невнимательность.
|
|
#6
17.09.2012, 20:41
|
|||
|
|||
|
|
|
#7
18.09.2012, 02:49
|
|||||||
|
|||||||
|
Цитата:
Вот в этом коде: Код:
jpg1:=TJPEGImage.Create; bmp1:=TBitmap.Create; jpg1.CompressionQuality:=100; jpg1.Compress; Цитата:
Но самое главное, что сам принцип неправильный (поэтому я и переписал исходник вместо того, чтобы просто внести мелкие исправления): не нужно перечислять все возможные комбинации форматов входных картинок, типа: Цитата:
Цитата:
Вместо этого достаточно просто описать одну функцию, которая будет преобразовывать любую картинку известного ей формата в Bitmap. Тогда с помощью этой функции преобразуем две нужные картинки в Bitmap'ы, которые и отдаём процедуре AlphaBlend (которая только с Bitmap'ами собственно говоря и умеет работать). Цитата:
Цитата:
Чтобы не растягивалось нужно указывать оба прямоугольника одинаковыми и равными размерам источникового прямоугольника: Код:
// Т.е. не так:
if Windows.AlphaBlend(bmp1.Canvas.Handle, 0, 0, bmp1.Width, bmp1.Height,
bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) then
// а так:
if Windows.AlphaBlend(bmp1.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height,
bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) thenЦитата:
|
|
#8
18.09.2012, 08:50
|
|||
|
|||
|
Спасибо, помогло. Теперь еще один момент, я в программе, сначала двигаю мышкой источник по целевому изображению, он у меня меньше целевого, а затем, мне нужно наложить его на целевое изображение там куда я его передвинул, а оно, так как верхние углы у обоих изображений 0, 0, понятно, всегда в правом верхнем углу накладывается. Если пытаться поменять эти нули на точку, в которой находится верхний левый угол источника, то выходит ошибка 87.
Последний раз редактировалось Fredwriter, 18.09.2012 в 08:56. |
|
#9
18.09.2012, 09:02
|
||||
|
||||
|
Цитата:
Например если X и Y это координаты левого верхнего угла где нужно нарисовать источник, то рисовать нужно так: Код:
if Windows.AlphaBlend(bmp1.Canvas.Handle, X, Y, bmp2.Width + X, bmp2.Height + Y,
bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) then |
| Этот пользователь сказал Спасибо poli-smen за это полезное сообщение: | ||
Fredwriter (18.09.2012)
| ||
|
#10
18.09.2012, 11:19
|
|||
|
|||
|
Понятно, спасибо.
|
Линейный вид
