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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 22.03.2013, 16:32
Аватар для Algplux
Algplux Algplux вне форума
Прохожий
 
Регистрация: 03.11.2012
Адрес: Березники, Пермский край
Сообщения: 20
Версия Delphi: 7
Репутация: 10
По умолчанию Масштабирование изображения

Нужна помощь по применению процедуры изменяющей размер изображения.
Есть 2-а ЛаблЕдита, кнопка, изображение (битмап) загружается в Имейдж если выбрать пункт меню открыть. Возникаю проблемы по применению данной процедуры для кнопки.

Код:
procedure TFormConvertir.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
var
   xini, xfi, yini, yfi, saltx, salty: single;
   x, y, px, py, tpix: integer;
   PixelColor: TColor;
   r, g, b: longint;

   function MyRound(const X: Double): Integer;
   begin
     Result := Trunc(x);
     if Frac(x) >= 0.5 then
       if x >= 0 then Result := Result + 1
       else
         Result := Result - 1;
     // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5); 
  end;

 begin
   // Set target size 

  imgd.Width  := nw;
   imgd.Height := nh;

   // Calcs width & height of every area of pixels of the source bitmap 

  saltx := imgo.Width / nw;
   salty := imgo.Height / nh;


   yfi := 0;
   for y := 0 to nh - 1 do
   begin
     // Set the initial and final Y coordinate of a pixel area 

    yini := yfi;
     yfi  := yini + salty;
     if yfi >= imgo.Height then yfi := imgo.Height - 1;

     xfi := 0;
     for x := 0 to nw - 1 do
     begin
       // Set the inital and final X coordinate of a pixel area 

      xini := xfi;
       xfi  := xini + saltx;
       if xfi >= imgo.Width then xfi := imgo.Width - 1;


       // This loop calcs del average result color of a pixel area 
      // of the imaginary grid 

      r := 0;
       g := 0;
       b := 0;
       tpix := 0;

       for py := MyRound(yini) to MyRound(yfi) do
       begin
         for px := MyRound(xini) to MyRound(xfi) do
         begin
           Inc(tpix);
           PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
           r := r + GetRValue(PixelColor);
           g := g + GetGValue(PixelColor);
           b := b + GetBValue(PixelColor);
         end;
       end;

       // Draws the result pixel 

      imgd.Canvas.Pixels[x, y] :=
         rgb(MyRound(r / tpix),
         MyRound(g / tpix),
         MyRound(b / tpix)
         );
     end;
   end;
 end;

Пожалуйста помогите.

Последний раз редактировалось Algplux, 22.03.2013 в 16:34.
Ответить с цитированием
  #2  
Старый 22.03.2013, 17:28
Аватар для Algplux
Algplux Algplux вне форума
Прохожий
 
Регистрация: 03.11.2012
Адрес: Березники, Пермский край
Сообщения: 20
Версия Delphi: 7
Репутация: 10
По умолчанию

Вот мой вариант:
Код:
// Собатие возникает при нажатии на кнопку "Масштабировать"
procedure TForm1.Button1Click(Sender: TObject);
var
  imho, imgd: TBitmap;
  nw, nh: Integer;
begin
    // Если путь задан
    if path <> '' then
    begin
        // Считываем значение с текстового поля
        nw:=StrToInt(LabeledEdit3.Text);
        nh:=StrToInt(LabeledEdit2.Text);
        // Загружаем изображение
        imho:=MyImage1.Picture.Bitmap;
        imgd:=MyImage1.Picture.Bitmap;
        // Масштабируем изобржение
        MyImage1.ResizeBitmap(imho, imgd, nw, nh);
        // Сохраняем временный файл
        MyImage1.SaveFileTmp(MyImage1.Picture.Bitmap, ExtractFilePath(Application.ExeName));
        // Если кол-во временных файлов не 0
        if MyImage1.CountFileTmp <> 1 then begin
            if(not N7.Enabled) then N7.Enabled := true;
        end else
            N7.Enabled := false;
    end else
        ShowMessage('Изображение не загружено. Для открытия изображения нажмите на кнопку "Открыть"');
end;
Ответить с цитированием
  #3  
Старый 22.03.2013, 17:55
Аватар для poli-smen
poli-smen poli-smen вне форума
Профессионал
 
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
По умолчанию

Цитата:
Сообщение от Algplux
Вот мой вариант:
Код:
// Собатие возникает при нажатии на кнопку "Масштабировать"
procedure TForm1.Button1Click(Sender: TObject);
var
  imho, imgd: TBitmap;
  nw, nh: Integer;
begin
    // Если путь задан
    if path <> '' then
    begin
        // Считываем значение с текстового поля
        nw:=StrToInt(LabeledEdit3.Text);
        nh:=StrToInt(LabeledEdit2.Text);
        // Загружаем изображение
        imho:=MyImage1.Picture.Bitmap;
        imgd:=MyImage1.Picture.Bitmap;
        // Масштабируем изобржение
        MyImage1.ResizeBitmap(imho, imgd, nw, nh);
        // Сохраняем временный файл
        MyImage1.SaveFileTmp(MyImage1.Picture.Bitmap, ExtractFilePath(Application.ExeName));
        // Если кол-во временных файлов не 0
        if MyImage1.CountFileTmp <> 1 then begin
            if(not N7.Enabled) then N7.Enabled := true;
        end else
            N7.Enabled := false;
    end else
        ShowMessage('Изображение не загружено. Для открытия изображения нажмите на кнопку "Открыть"');
end;
А зачем здесь проверка что path не пустая если потом эта переменная всё равно не используется?
И что такое MyImage1 ? Если это объект типа TImage, то откуда у него взялся метод ResizeBitmap ?
Тебе наверное нужно что-то вроде такого:
Код:
  ResizeBitmap(MyImage1.Picture.Bitmap, MyImage2.Picture.Bitmap, StrToInt(LabeledEdit3.Text), StrToInt(LabeledEdit2.Text));
  MyImage2.Picture.Bitmap.SaveToFile(...);
Ответить с цитированием
Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
Algplux (04.04.2013)
  #4  
Старый 22.03.2013, 18:41
Аватар для Algplux
Algplux Algplux вне форума
Прохожий
 
Регистрация: 03.11.2012
Адрес: Березники, Пермский край
Сообщения: 20
Версия Delphi: 7
Репутация: 10
По умолчанию

Цитата:
А зачем здесь проверка что path не пустая если потом эта переменная всё равно не используется?
Она потом в дальнейшем в программе используется. Не уделяйте этому внимания.
Цитата:
И что такое MyImage1 ? Если это объект типа TImage, то откуда у него взялся метод ResizeBitmap ?
MyImage1- компонент на основе Timage, метод ResizeBitmap я прописал в компонент.
Моя программа- редактор изображений, хотел реализовать в ней возможность уменьшать и увеличивать изображение как будет угодно пользователю.
В результате получилось не то что я хотел. Программа компилируется но при нажатии на кнопку, изображение как будто обрезается, а не уменьшается.
Либо не правильное применение, либо я не совсем понял что делает данная процедура.

Последний раз редактировалось Algplux, 22.03.2013 в 18:56.
Ответить с цитированием
  #5  
Старый 22.03.2013, 19:49
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

А не проще Proportional и Stretch в true у Image и изменять размеры рамки.
Ответить с цитированием
Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Algplux (04.04.2013)
  #6  
Старый 22.03.2013, 20:55
Аватар для Algplux
Algplux Algplux вне форума
Прохожий
 
Регистрация: 03.11.2012
Адрес: Березники, Пермский край
Сообщения: 20
Версия Delphi: 7
Репутация: 10
По умолчанию

Цитата:
А не проще Proportional и Stretch в true у Image и изменять размеры рамки.
А можно по подробней, как изменить размер рамки?
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

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