Процедура, которая их сохранённой картинки вырезает кусок по координатам и сохраняет в отдельный файл.
Код:
procedure TfrmMain.Crop;
Var L, T, W, H: Integer; bmp: TBitmap; jpg: TJPEGImage;
temponary:string;
Begin
L:=StrToInt(Edit25.Text); // координата X первой точки
T:=StrToInt(Edit26.Text); // координата Y первой точки
W:=StrToInt(Edit27.Text); // координата X второй точки
H:=StrToInt(Edit28.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:\WebBrowserImage.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 кодеком
temponary:='C:\'+inttostr(RandomRange(1,10000)) + '.jpg';
Edit33.Text:=temponary;
jpg.SaveToFile(temponary); // сохраняем на диск
bmp.Free; // очищаем память от уже не нужного экземпляра класса
jpg.Free; // очищаем память от уже не нужного экземпляра класса
End
Else
ShowMessage('Неправильно задан прямоугольник!');
End
Else
ShowMessage('Неправильно задан прямоугольник!');
Image1.Picture.LoadFromFile(temponary);
End;
Туплю жутко.
Путь сохранения - temponary.
При динамически создаваемом пути - всё отлично.
При статическом - например, C:\abc.jpg - лажа.
Первый раз отрабатывает нормально. Второй раз ругается на то, что файл занят другим процессом. Ресурсы нужно освобождать, это я понимаю. Но что-то всякие вариации с Free - тоже ругаются.
В общем нужно либо придумать способ использовать постоянный путь для сохранения картинки (фактически перезапись без ошибки).
Либо удалять временные файлы при динамическом создании. DeleteFile - что-то ничего не делает.