Масштабировать (изменить изображение) в TBitMap

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Ответить
Аватара пользователя
qivi
энтузиаст
Сообщения: 703
Зарегистрирован: 19.01.2009 12:45:54
Откуда: Россия

Масштабировать (изменить изображение) в TBitMap

Сообщение qivi »

Как изменить размер изображения находящегося в TBitMap до заданного размера?
Аватара пользователя
vada
энтузиаст
Сообщения: 691
Зарегистрирован: 14.02.2006 12:43:17

Сообщение vada »

Да да! У меня та же задача. Только изображение в компоненте Image.
Методов не нашел. Побыренькому сам написал 1:2 (в проекте этого хватило) но как-то это не аккуратненько. Может кто носом в алгоритмы ткнет, или реализовано уже.
Аватара пользователя
qivi
энтузиаст
Сообщения: 703
Зарегистрирован: 19.01.2009 12:45:54
Откуда: Россия

Сообщение qivi »

Не т такого метода?!!!!! :shock:
Аватара пользователя
vada
энтузиаст
Сообщения: 691
Зарегистрирован: 14.02.2006 12:43:17

Сообщение vada »

Берем ImageMagic и вдумчиво перепераем :(
iskander
энтузиаст
Сообщения: 630
Зарегистрирован: 08.01.2012 18:43:34

Сообщение iskander »

Можно так:

Код: Выделить всё

procedure ScaleBitmap(aBitmap: TBitmap;Scale: Single);
var
  tmp: TBitmap;
begin
  tmp := TBitmap.Create;
  try
    tmp.Width := Round(aBitmap.Width * Scale);
    tmp.Height := Round(aBitmap.Height * Scale);
    tmp.Canvas.StretchDraw(Bounds(0,0,tmp.Width,tmp.Height), aBitmap);
    aBitmap.Assign(tmp);
  finally
    tmp.Free;
  end;
end;
Аватара пользователя
vada
энтузиаст
Сообщения: 691
Зарегистрирован: 14.02.2006 12:43:17

Сообщение vada »

Опа! Здорово! iskander спасибо!
Аватара пользователя
qivi
энтузиаст
Сообщения: 703
Зарегистрирован: 19.01.2009 12:45:54
Откуда: Россия

Сообщение qivi »

iskander писал(а):Можно так:

Код: Выделить всё

    procedure ScaleBitmap(aBitmap: TBitmap;Scale: Single);
    var
      tmp: TBitmap;
    begin
      tmp := TBitmap.Create;
      try
        tmp.Width := Round(aBitmap.Width * Scale);
        tmp.Height := Round(aBitmap.Height * Scale);
        tmp.Canvas.StretchDraw(Bounds(0,0,tmp.Width,tmp.Height), aBitmap);
        aBitmap.Assign(tmp);
      finally
        tmp.Free;
      end;
    end;


Спасибо, мне подошло.
Почти то же самое:

Код: Выделить всё

function ScaleBitmap(aBitmap:TBitmap;Scale:Single):TBitmap;
begin
  if (aBitmap.Width<>0)and(aBitmap.Height<>0) then
  begin
    result:=TBitmap.Create;
    result.Width:=Round(aBitmap.Width*Scale);
    result.Height:=Round(aBitmap.Height*Scale);
    result.Canvas.StretchDraw(Bounds(0,0,result.Width,result.Height),aBitmap);
  end else result:=nil;
end;


Хотя есть косячёк...
Известное дело что стандартными средствами альфа это недосягаемый космос, тем не менее, не знаю как, но если загрузить в TBitMap изображение из PNG с альфой, а потом выполнить на какой ни буть канвас.Draw(3,3,sGlyph), то альфа, хоть и не полноценно (либо есть/либо нет) отрабатывает... при масштабировании теряется... :(
11.JPG
Аватара пользователя
Alexx2000
постоялец
Сообщения: 490
Зарегистрирован: 25.10.2006 00:22:07
Откуда: Мытищи
Контактная информация:

Сообщение Alexx2000 »

Вот модуль, позволяющий масштабировать TBitmap, поддерживает альфа-канал и несколько алгоритмов масштабирования.
Ответить