[MrDiG]

Процедура, которая их сохранённой картинки вырезает кусок по координатам и сохраняет в отдельный файл.

Код:

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 - что-то ничего не делает.

[Aristarh Dark]

Попробуй завести 2 различных объекта для считываемой картинки и записываемой.

[RootDevice]

Ругается, потому что файл не закрыл.

[MAD_EVAL]

Открываю

Код:

 F := FileOpen(FILE_NAME, fmOpenWrite OR fmShareDenyWrite);

Работаю.........
Закрываю

Код:

 FileClose(F);

Потом свободно можно переоткрыть и еперзаписать, если я не понял вопроса, поправьте.

И ещё! Лично я, при конвертации в жпег делаю приблизительно такую конструкцию

Код:

      // Создаю
try
      // Преобразовываю
finally
      // Освобождаю через Free
end;

[RootDevice]

Послушай. Попробуй сделать вот что. Запомни директоию запуска программы, выполни код, а затем верни директорию на место.
получить директорию:
GETCURRENTDIR
восстановить:
SETCURRENTDIR


Если получится - отпишись. Не получится - тоже. Была такая же проблема с ини файлом. Помогло.