|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Масштабирование изображения
Нужна помощь по применению процедуры изменяющей размер изображения.
Есть 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
|
||||
|
||||
Вот мой вариант:
Код:
// Собатие возникает при нажатии на кнопку "Масштабировать" 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
|
||||
|
||||
Цитата:
И что такое 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
|
||||
|
||||
Цитата:
Цитата:
Моя программа- редактор изображений, хотел реализовать в ней возможность уменьшать и увеличивать изображение как будет угодно пользователю. В результате получилось не то что я хотел. Программа компилируется но при нажатии на кнопку, изображение как будто обрезается, а не уменьшается. Либо не правильное применение, либо я не совсем понял что делает данная процедура. Последний раз редактировалось Algplux, 22.03.2013 в 18:56. |
#5
|
||||
|
||||
А не проще Proportional и Stretch в true у Image и изменять размеры рамки.
Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
Этот пользователь сказал Спасибо Alegun за это полезное сообщение: | ||
Algplux (04.04.2013)
|
#6
|
||||
|
||||
Цитата:
|
#7
|
||||
|
||||
Задавать Width и Height у Image
З.Ы. Нашёл единственную сборку по теме - пакетное изменение размеров рисунков, используются свойства JpegImage. Я не понял Вашего вопроса, но всё же Вам на него отвечу! Последний раз редактировалось Alegun, 22.03.2013 в 21:39. |
Этот пользователь сказал Спасибо Alegun за это полезное сообщение: | ||
Algplux (04.04.2013)
|
#8
|
||||
|
||||
Цитата:
|
#9
|
||||
|
||||
Возникла ошибка. Не могу понять из-за чего.
Код:
procedure TForm1.Button1Click(Sender: TObject); var w,h: Integer; begin // Если путь задан if path <> '' then begin // Считываем значение с текстового поля w:=StrToInt(LabeledEdit3.Text); h:=StrToInt(LabeledEdit2.Text); // Масштабируем изображение MyImage1.Width:=w; MyImage1.Hide:=h; // Сохраняем временный файл 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; Последний раз редактировалось Algplux, 24.03.2013 в 12:25. |
#10
|
||||
|
||||
Цитата:
jmp $ ; Happy End! The Cake Is A Lie. |
Этот пользователь сказал Спасибо Bargest за это полезное сообщение: | ||
Algplux (04.04.2013)
|
#11
|
||||
|
||||
Всё. Всем большое спасибо. Всё работает.
Ещё, кое-что спросить хотел, что бы новый топик не создавать, как сделать так что бы можно было мышью выделить часть изображения, и при нажатии на кнопку закрасить выделенное под цвет формы? Я так планировал реализовать обрезку части изображения. |
#12
|
||||
|
||||
По событиям мыши рисуешь рамку выделения, по отпусканию мыши сохраняешь, по кнопке зарисовываешь.
jmp $ ; Happy End! The Cake Is A Lie. |
Этот пользователь сказал Спасибо Bargest за это полезное сообщение: | ||
Algplux (04.04.2013)
|
#13
|
||||
|
||||
http://www.delphisources.ru/pages/fa..._for_edit.html
На основе этого получилось сделать выделение части изображения. Подскажите пожалуйста, как по кнопке, закрасить выделенное цветом формы? |
#14
|
||||
|
||||
...FillRect...
jmp $ ; Happy End! The Cake Is A Lie. |
Этот пользователь сказал Спасибо Bargest за это полезное сообщение: | ||
Algplux (04.04.2013)
|
#15
|
||||
|
||||
Не могу разобраться, как FillRect работает.
Пробую написать так: Код:
procedure TForm1.Button7Click(Sender: TObject); var MyRect: TRect; x, y: Integer; begin StartPlace.x := X; StartPlace.y := Y; EndPlace.x := X; EndPlace.y := Y; MyRect:= Rect(StartPlace.X, StartPlace.Y, EndPlace.X, EndPlace.Y); Form1.Canvas.Brush.Color := clWhite; Form1.Canvas.FillRect(MyRect); end; |