Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.10.2010, 10:36   #1
Nub
Пользователь
 
Регистрация: 04.10.2010
Сообщений: 19
По умолчанию Нужен пример с CopyRect или bitbln

А может кто-нибудь показать какой-нибудь пример, открывающий допустим c:\Image.jpg, вырезающий прямоугольник по 4 координатам и сохраняющий его в c:\Image2.jpg. Что-то гугл ничего не даёт
Nub вне форума Ответить с цитированием
Старый 06.10.2010, 14:56   #2
DomiNick
Студент, не
Старожил
 
Аватар для DomiNick
 
Регистрация: 29.01.2009
Сообщений: 2,067
По умолчанию

Именно для Делфи а не на апи? Просто для облегчения задачи есть удобные (хоть и немного неуклюжие) классы VCL - TBitmap и TJPEGImage....
И обычно указывают не 4 координаты, а 2 - левый верхний угол прямоугольника и правый нижний...
Код:
Uses JPEG;

...

Procedure TForm1.Button1Click(Sender: TObject);
Var L, T, W, H: Integer; bmp: TBitmap; jpg: TJPEGImage;
Begin
L:=StrToInt(Edit1.Text); // координата X первой точки
T:=StrToInt(Edit2.Text); // координата Y первой точки
W:=StrToInt(Edit3.Text); // координата X второй точки
H:=StrToInt(Edit4.Text); // координата Y второй точки
// координаты не могут быть отрицательными:
If (L<0) Then
      L:=0;
If (T<0) Then
      T:=0;
If (W<0) Then
      W:=0;
If (H<0) Then
      H:=0;
If (L<>W) And (Abs(T-H)>1) Then // проверка не является ли прямоугольник "пустым" (с площадью равной нулю) -- вообще должно быть "And (T<>H)", но в моём модуле JPEG кажется какой-то баг с этим
      Begin
      bmp:=TBitmap.Create; // создаём экземпляр класса TBitmap
      jpg:=TJPEGImage.Create; // создаём экземпляр класса TJPEGImage
      jpg.LoadFromFile('C:\Image.jpg'); // загружаем изображение из jpg-файла
      bmp.Assign(jpg); // конвертируем jpg в bmp (VCL'ские классы сами сделают необходимые преобразования)
      // а вдруг точки перепутали - не левый верхний и правый нижний угол, а как-то по-другому? на всякий случай проверим:
      If L>W Then
            Begin // алгоритм меняющий "местами" значения двух переменных:
            L:=L XOr W;
            W:=L XOr W;
            L:=L XOr W;
            End;
      If T>H Then
            Begin // алгоритм меняющий "местами" значения двух переменных:
            T:=T XOr H;
            H:=T XOr H;
            T:=T XOr H;
            End;
      // а вдруг точки находится за пределами изображения? тоже проверим:
      If (W>=jpg.Width) Then
            W:=jpg.Width-1;
      If (H>=jpg.Height) Then
            H:=jpg.Height-1;
      If (L<W) And (T<H-1) Then // а тут из-за той же баги пришлось дописать "-1"
            Begin
            W:=W-L; // теперь тут не "координата X правого нижнего угла", а ширина прямоугольника
            H:=H-T; // а тут не "координата Y правого нижнего угла", а висота прямоугольника
            BitBlt(bmp.Canvas.Handle, 0, 0, W, H, bmp.Canvas.Handle, L, T, SRCCOPY); // копируем заданную область в левый верхний угол битмапа
            bmp.Width:=W; // уменьшаем его размеры width
            bmp.Height:=H; // и height до размеров заданной области
            jpg.Assign(bmp); // конвертируем обратно в jpg
            jpg.CompressionQuality:=100; // наилучшее качество (максимально возможное с использованием модуля JPEG) - можно задавать в пределах от 1 до 100
            jpg.Compress; // сожмём jpg кодеком
            jpg.SaveToFile('C:\Image2.jpg'); // сохраняем на диск
            End
      Else
            ShowMessage('Неправильно задан прямоугольник!');
      bmp.Free; // очищаем память от уже не нужного экземпляра класса
      jpg.Free; // очищаем память от уже не нужного экземпляра класса
      End
Else
      ShowMessage('Неправильно задан прямоугольник!');
End;
Уфф... Вроде так, вроде ничё не перепутал...
I am the First of Cyber Evolution...
I am the First to Program your Future...

Последний раз редактировалось DomiNick; 06.10.2010 в 16:05. Причина: Немного не там внутренний "End Else" был... *
DomiNick вне форума Ответить с цитированием
Старый 06.10.2010, 15:56   #3
Nub
Пользователь
 
Регистрация: 04.10.2010
Сообщений: 19
По умолчанию

Отлично! Огромное спасибо. Двое суток лопачу форумы. Пробовал и с CopyRect и с BitBln - ничего не получалось. Ещё раз спасибо за пример
Nub вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужен пример на Dilphi, перемещение строки между двумя listbox из одного в другой MaHTpug Помощь студентам 1 17.06.2010 21:25
Нужен пример OSD (On Screen Display) на Delphi 7 Noor Общие вопросы Delphi 15 30.03.2010 16:54
Связка TidHttp и TidCompressorZLibEx, нужен пример работы ilich7 Работа с сетью в Delphi 2 25.09.2008 15:11
нужен пример работы с sql server (1000 руб.) hochu Фриланс 1 27.09.2007 20:41
нужен пример регера мыла SHEI'TI Работа с сетью в Delphi 2 20.07.2007 12:36