Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.09.2012, 17:24
Fredwriter Fredwriter вне форума
Прохожий
 
Регистрация: 14.11.2010
Сообщения: 9
Репутация: 10
По умолчанию 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
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от Fredwriter
Здравствуйте, делаю лабу, нужно наложить одно изображение на другое, для этого используется Alpha-наложение при помощи API AlphaBlend. Если выбирается jpg, то я преобразую jpg в bmp и пытаюсь наложить. Если оба выбранных изображения bmp, или оба jpg, то всё накладывается отлично, если одно jpg, а другое bmp, то GetLastError с кодом 87(неверно задан параметр). Понятно, что я как-то недопреобразовал jpg, но информации о том, как правильно сделать не нашел.
Может найдется добрый дядя, который мне поможет?
По мотивам твоей процедуры (пришлось переделать почти всё):
Код:
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 Fredwriter вне форума
Прохожий
 
Регистрация: 14.11.2010
Сообщения: 9
Репутация: 10
По умолчанию

Спасибо, конечно, огромное, за переделку, а не могли бы Вы мне сказать каким нибудь русским предложением, в чём была моя ошибка? Так было бы быстрее. Если не учитывать все мелкие различия, то бросается в глаза следующее, у Вас в функции преобразования нет сжатия.
Убрал сжатие не помогло, та же ошибка. Если есть еще какая-то принципиальная разница между процедурами я её не заметил.

Последний раз редактировалось Fredwriter, 17.09.2012 в 19:03.
Ответить с цитированием
  #4  
Старый 17.09.2012, 20:03
Fredwriter Fredwriter вне форума
Прохожий
 
Регистрация: 14.11.2010
Сообщения: 9
Репутация: 10
По умолчанию

Нашел ошибку, оказалось, я когда у меня разные форматы, загружал только jpg, а bmp забыл. Банальная невнимательность.
Ответить с цитированием
  #5  
Старый 17.09.2012, 20:40
Fredwriter Fredwriter вне форума
Прохожий
 
Регистрация: 14.11.2010
Сообщения: 9
Репутация: 10
По умолчанию

Здесь написано, что источниковое изображение по любому растянется до исходного, а можно ли сделать, чтобы оно не растягивалось?

Последний раз редактировалось Fredwriter, 17.09.2012 в 20:44.
Ответить с цитированием
  #7  
Старый 18.09.2012, 02:49
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от Fredwriter
Спасибо, конечно, огромное, за переделку, а не могли бы Вы мне сказать каким нибудь русским предложением, в чём была моя ошибка? Так было бы быстрее. Если не учитывать все мелкие различия, то бросается в глаза следующее, у Вас в функции преобразования нет сжатия.
А какой здесь смысл использовать сжатие? Сжатие нужно только для преобразования Bitmap в Jpeg, а в твоей задаче необходимо обратное преобразование.
Вот в этом коде:
Код:
jpg1:=TJPEGImage.Create;
bmp1:=TBitmap.Create;
jpg1.CompressionQuality:=100;
jpg1.Compress;
Здесь последняя строка лишена смысла - в объект jpg1 ничего не загружали (т.е. пустой), а значит и сжимать нечего, и Compress здесь сработает "вхолостую". А без Compress, также теряют смысл любые присваивания в CompressionQuality.
Цитата:
Сообщение от Fredwriter
Нашел ошибку, оказалось, я когда у меня разные форматы, загружал только jpg, а bmp забыл. Банальная невнимательность.
А ещё нигде не освобождаются jpg1 и jpg2, а значит будут утечки памяти.
Но самое главное, что сам принцип неправильный (поэтому я и переписал исходник вместо того, чтобы просто внести мелкие исправления): не нужно перечислять все возможные комбинации форматов входных картинок, типа:
Цитата:
1) если Картинка1=BMP и Картинка2=BMP тогда <...> иначе
2) если Картинка1=BMP и Картинка2=JPG тогда <...> иначе
3) если Картинка1=JPG и Картинка2=BMP тогда <...> иначе
4) если Картинка1=JPG и Картинка2=JPG тогда <...>
А если нужно будет ввести поддержку ещё одного формата, например PNG? Тогда придётся программировать уже 9 вариантов:
Цитата:
1) если Картинка1=BMP и Картинка2=BMP тогда <...> иначе
2) если Картинка1=BMP и Картинка2=JPG тогда <...> иначе
3) если Картинка1=BMP и Картинка2=PNG тогда <...> иначе
4) если Картинка1=JPG и Картинка2=BMP тогда <...> иначе
5) если Картинка1=JPG и Картинка2=JPG тогда <...> иначе
6) если Картинка1=JPG и Картинка2=PNG тогда <...> иначе
7) если Картинка1=PNG и Картинка2=BMP тогда <...> иначе
8) если Картинка1=PNG и Картинка2=JPG тогда <...> иначе
9) если Картинка1=PNG и Картинка2=PNG тогда <...>
А если добавить поддержку GIF, то уже получается 16 вариантов, и т.д.
Вместо этого достаточно просто описать одну функцию, которая будет преобразовывать любую картинку известного ей формата в Bitmap. Тогда с помощью этой функции преобразуем две нужные картинки в Bitmap'ы, которые и отдаём процедуре AlphaBlend (которая только с Bitmap'ами собственно говоря и умеет работать).
Цитата:
Сообщение от Fredwriter
Здесь написано, что источниковое изображение по любому растянется до исходного, а можно ли сделать, чтобы оно не растягивалось?
Там такого не написано. Там написано:
Цитата:
Если исходный и целевой прямоугольник имеют не один и тот же размер, исходный точечный рисунок растягивается, чтобы соответствовать целевому прямоугольнику.
И это понятно. Если попытаться нарисовать картинку размером скажем 32x32 на прямоугольнике 800x600, то что ему нужно сделать как не растянуться?
Чтобы не растягивалось нужно указывать оба прямоугольника одинаковыми и равными размерам источникового прямоугольника:
Код:
  // Т.е. не так:
  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
Цитата:
Сообщение от Fredwriter
Смешная ссылка
Ответить с цитированием
  #8  
Старый 18.09.2012, 08:50
Fredwriter Fredwriter вне форума
Прохожий
 
Регистрация: 14.11.2010
Сообщения: 9
Репутация: 10
По умолчанию

Спасибо, помогло. Теперь еще один момент, я в программе, сначала двигаю мышкой источник по целевому изображению, он у меня меньше целевого, а затем, мне нужно наложить его на целевое изображение там куда я его передвинул, а оно, так как верхние углы у обоих изображений 0, 0, понятно, всегда в правом верхнем углу накладывается. Если пытаться поменять эти нули на точку, в которой находится верхний левый угол источника, то выходит ошибка 87.

Последний раз редактировалось Fredwriter, 18.09.2012 в 08:56.
Ответить с цитированием
  #9  
Старый 18.09.2012, 09:02
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от Fredwriter
Спасибо, помогло. Теперь еще один момент, я в программе, сначала двигаю мышкой источник по целевому изображению, он у меня меньше целевого, а затем, мне нужно наложить его на целевое изображение там куда я его передвинул, а оно, так как верхние углы у обоих изображений 0, 0, понятно, всегда в правом верхнем углу накладывается. Если пытаться поменять эти нули на точку, в которой находится верхний левый угол источника, то выходит ошибка 87.
Нужно изменять все четыре параметра.
Например если 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
Fredwriter Fredwriter вне форума
Прохожий
 
Регистрация: 14.11.2010
Сообщения: 9
Репутация: 10
По умолчанию

Понятно, спасибо.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:55.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025