[MrDiG]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68

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 кодеком   <b>            temponary:='C:\'+inttostr(RandomRange(1,10000)) + '.jpg';</b>             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]

Открываю

Код:

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

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

Код:

1	FileClose(F);

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

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

Код:

1 2 3 4 5 6

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

[RootDevice]

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


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