-
всем привет! тут такая тема.. нужно взять картинку(неважно какого разрешения) формата jpg и средствами дельфи уменьшить по пропорциям до определенного размера, а затем пересохранить. то биш была у нас картинка 1024х768, мы ее изменили в 640х480- и теперь следует сохранить в определенное место такого разрешения опять ж в формат jpg. пробовал загружать напрямую, изменять параметры и пересохранять(пишу по памяти):
var
jpg: tjpegimage;
begin
jpg:= tjpegimage.create;
jpg.loadfromfile('*.jpg');
jpg.width:= newvalueW;
jpg.Height:= newvalueH;
jpg.savetofile('c:/1.jpg');
end;
в общем выдает ошибку, что мол JPEG Width не может быть изменена. Вооот.. (( Надо както по другому..( Никто не подскажет? ото в голове вообще как-то больше идей никаких нет..
-
Bitmap.Assign(jpg)
далее изменить размеры битмапа (StretchDraw, например, или другими методами), и обратно в jpg
-
о-о-о, все, разобрался, спасибо за нужное направление ;)))
-
я не разобрался
а нельзя ли рабочий вариант посмотреть?
-
а какой именно этап непонятен?
-
procedure ImageJPGSizeWH(File1,file2:string;W,H:integer);
var
sr: TSearchRec;
img: TPicture;
bmp: TBitmap;
pic: TBitMap;
begin
img := TPicture.Create;
bmp := TBitMap.Create;
pic := TBitMap.Create;
img.LoadFromFile(File1);
bmp.Assign(img.Graphic);
pic.Width := W;
pic.Height:= H;
pic.Canvas.StretchDraw(Rect(0,0,pic.Width, pic.Height), bmp);
pic.SaveToFile(file2);
img.Free;
bmp.Free;
pic.Free;
end;
-
> а нельзя ли рабочий вариант посмотреть?
procedure ResizeBMP(ABitMap: TBitmap; ANewWidth, ANewHeight: Integer);
var
tmpBmp: TBitmap;
divHeight,
divWidth: double;
begin
tmpBmp := TBitmap.Create;
try
tmpBmp.PixelFormat := ABitMap.PixelFormat;
tmpBmp.Width := ABitMap.Width;
tmpBmp.Height := ABitMap.Height;
BitBlt(tmpBmp.Canvas.Handle, 0, 0, tmpBmp.Width, tmpBmp.Height,
ABitMap.Canvas.Handle, 0, 0, SRCCOPY);
divHeight := ABitMap.Height / ANewHeight;
divWidth := ABitMap.Width / ANewWidth;
if (divHeight = 1.0) and (divWidth = 1.0) then
begin
ANewWidth := ABitMap.Width;
ANewHeight := ABitMap.Height;
end
else if divHeight > divWidth then
begin
ANewWidth := trunc(ABitMap.Width / divHeight);
end
else
begin
ANewHeight := trunc(ABitMap.Height / divWidth);
end;
ABitMap.Width := ANewWidth;
ABitMap.Height := ANewHeight;
if SetStretchBltMode(ABitMap.Canvas.Handle, HALFTONE) = 0 then
begin
ShowMessage('SetStretchBltMode: ' + SysErrorMessage(GetLastError));
end
else if not SetBrushOrgEx(ABitMap.Canvas.Handle, 0, 0, nil) then
begin
ShowMessage('SetBrushOrgEx: ' + SysErrorMessage(GetLastError));
end
else if not StretchBlt(ABitMap.Canvas.Handle, 0, 0, ABitMap.Width, ABitMap.Height,
tmpBmp.Canvas.Handle, 0, 0, tmpBmp.Width, tmpBmp.Height, SRCCOPY) then
begin
ShowMessage('StretchBlt: ' + SysErrorMessage(GetLastError));
end;
finally
tmpBmp.Free;
end;
end;
-
> denissoft
Некроман, блин...
-
эм... А что такого не так с [5] ?
-
> Студент (12.01.11 12:25) [8]
>
> эм... А что такого не так с [5] ?
Труп двух летней давности выкопан.
-
Для Гладкого стретча можно так Procedure ReSizeJpeg(var jpg:TJpegImage; NewWidth,NewHeight:integer);
var
bmp,sbmp:Tbitmap;
begin
bmp:=Tbitmap.create;
bmp.assign(jpg);
sbmp:=Tbitmap.create;
sbmp.width:=NewWidth;
sbmp.Height:=NewHeight;
sbmp.pixelFormat:=pf24bit;
SetStretchBltMode(sbmp.canvas.handle,4);
StretchBlt(sbmp.canvas.handle,0,0,NewWidth,NewHeight,bmp.canvas.handle,
0,0,bmp.width,bmp.height,SRCCOPY);
jpg.assign(sbmp);
jpg.compressQuality := 90;
jpg.compress;
sbmp.free;
bmp.free;
end;
-
RGV, большое спасибо. Всё работает!
-
Как использовать какую либо из этих функций в моем случае.У меня есть сохраненное изображение С:\1.jpeg c с размером 218X241 мне нужно его растянуть с минимальной потерей качества(желательно) до 827x1063.Какую функцию нужно использовать и как?Пробовал использовать функцию ImageJPGSizeWH и ReSizeJpeg но пишет ошибку jpg error #53.Что посоветуете?
-
> vivaldi (12.10.11 09:20) [12]
да ты фантазер однако :D
-
Задаю вопрос проще у меня есть изображение С:\1.jpeg c с размером 218X241 как его растянуть до 827x1063 и сохранить как С:\2.jpeg.Уж проще некуда
-
> vivaldi (12.10.11 10:32) [14]
1. Загрузить.
2. Растянуть.
3. Сохранить.
На какой стадии загвоздка?
-
Загружать её не нужно она находится на форме в image1.Я не знаю как её растянуть до 827x1063.
-
Загружать её не нужно она находится на форме в image1.Я не знаю как её растянуть до 827x1063.
-
> Я не знаю как её растянуть до 827x1063.with Image1 do
begin
Stretch := true;
SetBounds(Left, Top, 827, 1063);
end;
-
Написал в кнопку этот код with Img1 dobegin Stretch := true; SetBounds(Left, Top, 827, 1063);end; с картинкой ничего не просходит. Может нужно как то через canvas сделать потому что эту картинку я получаю вырезая область экрана с помощью
var L,R,B,T:Extended;
ax,ay:Extended
ax:=Image1.Picture.Width/Image1.Width;
ay:=Image1.Picture.Width/Image1.Height;
L:=(Image1.Left-Image1.Left);
R:=(L+Image1.Width)*ax;
B:=Image1.top*ay;
T:=B+(Image1.Height*ay));
Image1.Width:=round(R-L);
Image1.Height:=round(T-B);
Image1.Canvas.Draw(round(-L),round(-B),Image1.Picture.Graphic);
После этого я приравниваю изображение в Img1 к Image.Кодом img1.Picture.Graphic:=Image1.Picture.Graphic; После сохраняю,Он сохраняет его с размером Image1(218X241). А мне нужно предварительно img1 увеличить,а потом сохранить
|
Есть новые 
Нет новых [134427 +38][b:0][p:0.003]