Добрый день,
Вопрос заключается в следующем: в масштабировании файла jpg.
Т.е. есть файл jpg (больших габаритов) из него надо сделать маленькую картинку предпросмотра этой картинки размерами - 100x100 + нужно сохранить пропорции первичного изображения. И, например:
1) большое изображение имеет размеры 900x500
2) если подогнать его под 100x100 (с сохранением проморций), то будет 100x55
3) надо, чтобы в итоге всё-таки получось изображение 100x100. Загнать это 100x55 в 100x100, прорисовав слева и справа (в данном случае) по 22 пикселля белого фона
надо просто дорисовать на белый фон 100x100 по центру уменьшенное изображение 100x55 вот так...
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
19-01-2009 06:57
Кто будет использовать приведенный DRON-ом код в D2009 - не забудьте заменить все PChar на PByte.
03-02-2007 01:35 | Комментарий к предыдущим ответам
>>> Прочитайте в справке про TCanvas.StretchDraw
Прочитайте вопрос: подогнать его под 100x100 (с сохранением проморций)
>>> Загнать это 100x55 в 100x100, прорисовав слева и справа
Тогда уж не справа и слева а сверху и снизу.
>>> Нечто готовое
Именно что нечто. Ни комментариев, ни описания. В принципе, у первой процедуры понятно что она делает, а вот дальше - полный мрак, на лету не разобраться, надо вникать, а это уже не есть хорошо.
02-02-2007 03:23 | Комментарий к предыдущим ответам
>>> только белым зарисовывать не обязательно, фон и так белым будет после создания битмапа
Старая привычка самому всегда заниматься инициализацией. А вдруг забудет залить или зальет другим цветом? А метод FillRect гарантирует, что все всегда будет так, как надо. Да иработает он достаточно быстро, так что нет смысла на нем экономить.
Насколько я понял в коде Geo мы сначала зарисовываем весь битмап белым цветом, а потом по центру и врисовываем ту картинку... ну.. это насколько я помню... ))) а то сейчас уже дельфинарий немножко подзабыл, полностью окунулся в ПХП со скулём да перл с сёй )
Спасибо большое! Логику я и сам понял, только вот как это на практике сделать не знал, а разбираться и ковырятся самому времени нету.. программа и так уже полтора месяца назад должна была быть сдана заказчику =)) во как -) ы
>>> забыл, что последние два элемента структуры TRect - это не ширина и высота, а правая и нижняя координата
Я для этого использую функцию Bounds вместо Rect. К тому же перед перебрасыванием jpg на bitmap можно залить последний белым цветом (чтобы удовлетворить требование "заказчика" ;-)
bmp.Canvas.Brush.Color:=clWhite;
bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
bmp.Canvas.StretchDraw( Bounds((100 - PictureWidth) div 2,(100 - PictureHeight) div 2, PictureWidth,PictureHeight), jpg );
И все равно ошибся. :) Привычка из GDI+, забыл, что последние два элемента структуры TRect - это не ширина и высота, а правая и нижняя координата. Нужно к PictureWidth, PictureHeight прибавить (100 - PictureWidth) div 2 и (100 - PictureHeight) div 2 соответственно. :)
02-02-2007 00:35 | Вопрос к автору: запрос дополнительной информации
Что значит "с белым фоном"? Откуда его взять, если Вы просто сжимаете изображение? Вы можете после "приведения" размера, попиксельно (по выбранному Вами критерию) заменить цвет каких-то пикселей на белый.
Вот, я вот так изменяю размеры.. Впринципе размеры изменяются, только нужно, всё-таки, чтобы на выходе получился 100x100 с белым фоном :) Поможите, пожалуйста.. Я понимаю, что это просто.. Но вот незнаю как енто, а вопрос горит.
Спасибо вам всем большое за исчерпывающую дискуссию по моему вопрос, буду пробывать.. Уменьшить-то картинку джпэговскую пропорцианально я смог, но вот с прорисовкой в центре белого квадрата 100x100 была проблема, благо я не шипко силён в канвасах и ректах..
01-02-2007 03:00 | Комментарий к предыдущим ответам
Если я не ошибаюсь, то в формате jpg, в начале файла есть 256х256 ВМР-шная копия изображения. Во всяком случае, мне так показалось, что многие предпросмотрщики показывают именно эту копию.
Её там может и не быть, к тому же некоторые редакторы забывают её обновить, то есть содержимое этой иконки не будет совпадать с содержимым самого файла.
Grig
Картинка сама уменьшится до нужного размера без искажения пропорций.
В том то и дело что ничего не уменьшится, картинка просто будет каждый раз перерисовываться с уменьшением размера (с помощью StretchDraw), а если речь идёт про фотографии, то каждый раз будут обрабатываться многомегабайтные массивы пикселей, ну и если таких картинок много, то никакой памяти не хватит. К тому же в последнем случае может быть важна скорость обработки и придётся воспользоваться свойствамм Scale и Performance о которых TImage не имеет ни малейшего понятия.
Может быть я чего-то не понял, но все это делается двумя строчками исходного текста, если размеры (Image1.Height:=100; Image1.Width:=100;) установить еще на этаре проектирования :
Если я не ошибаюсь, то в формате jpg, в начале файла есть 256х256 ВМР-шная копия изображения. Во всяком случае, мне так показалось, что многие предпросмотрщики показывают именно эту копию.
procedure CreateThumb(Source:TStream;Dest:TBitmap;Filter:TFilterType);
var
W,H:Integer;
Bmp:TBitmap;
JPG:TJPegImage;
begin
JPG:=TJPegImage.Create;
try
JPG.LoadFromStream(Source);
if Dest.Height<MulDiv(JPG.Height,Dest.Width,JPG.Width) then begin
H:=Dest.Height;
W:=MulDiv(JPG.Width,Dest.Height,JPG.Height);
end
else begin
W:=Dest.Width;
H:=MulDiv(JPG.Height,Dest.Width,JPG.Width);
end;
JPG.Scale:=jsFullSize;
if W<(JPG.Width/2)*1.25 then begin
JPG.Scale:=jsHalf;
if W<(JPG.Width/4)*1.25 then begin
JPG.Scale:=jsQuarter;
if W<(JPG.Width/8)*1.25 then
JPG.Scale:=jsEighth;
end;
end;
JPG.Performance:=jpBestSpeed;
Bmp:=TBitmap.Create;
try
Bmp.Assign(JPG);
Stretch(Bmp,Bmp,W,H,Filter);
Dest.Canvas.Draw((Dest.Width-W)div 2,(Dest.Height-H)div 2,Bmp);
finally
Bmp.Free;
end;
finally
JPG.Free;
end;
end;
///////////////////////////////////Stretch/////////////////////////////
type
TProgressProc=procedure(Percents:Integer;Param:Integer);
TFilterType=(ftBox,ftTriangle,ftHermite,ftBell,ftSpline,ftLanczos3,ftMitchell);
type
TContributor=packed record
Pixel:Integer;
Weight:Integer;
end;
TContributorList=array[0..0] of TContributor;
PContributorList=^TContributorList;
TCList=packed record
Count:Integer;
Data:PContributorList;
end;
TCListList=array[0..0] of TCList;
PCListList=^TCListList;
TRGBTripleArray=array[0..0] of TRGBTriple;
PRGBTripleArray=^TRGBTripleArray;
TDrawProc=procedure(Count:Integer;Contributes:PCListList;srcLine,dstLine:Pointer;dstDelta,srcDelta:Integer);pascal;
procedure CreateContributors(var Contrib:PCListList;Size:Integer;MaxSize:Integer;Filter:TFilterType;Delta:Integer);
var
A,B,Count:Integer;
Scale2:Single;
AWidth:Single;
Param,W:Single;
Center:Single;
CSize:Integer;
Data:PContributorList;
const
CFilters:array[TFilterType] of Single=(0.51,1,1,1.5,2,3,2);
begin
Contrib:=nil;
if MaxSize>Size then
Scale2:=Size/MaxSize
else
Scale2:=1;
AWidth:=CFilters[Filter]/Scale2;
CSize:=Trunc(AWidth*2+1)*SizeOf(TContributor);
GetMem(Contrib,Size*(SizeOf(TCList)+CSize));
Data:=@PChar(Contrib)[Size*SizeOf(TCList)];
for A:=0 to Size-1 do begin
Count:=0;
Center:=A*MaxSize/Size;
for B:=Floor(Center-AWidth)to Ceil(Center+AWidth) do begin
Param:=Abs(Center-B)*Scale2;
if Param>=CFilters[Filter] then Continue;
case Filter of
ftBox:
if (Param<=0.5)and((Center-B)*Scale2<>-0.5) then
W:=1.0
else
W:=0.0;
ftTriangle:W:=1.0-Param;
ftHermite:W:=(2.0*Param-3.0)*Sqr(Param)+1.0;
ftBell:
if Param<0.5 then
W:=0.75-Sqr(Param)
else
W:=Sqr(Param-1.5)*0.5;
ftSpline:
if Param<1.0 then
W:=2/3+Sqr(Param)*(Param*0.5-1.0)
else
W:=Sqr(2-Param)*(2-Param)*(1/6);
ftLanczos3:
if Param<>0.0 then
W:=Sin(Param*Pi)*Sin(Param)/(Sqr(Param)*Pi)
else
W:=1.0;
ftMitchell:
if Param<1.0 then
W:=Sqr(Param)*(7/6*Param-2)+8/9
else
W:=Sqr(Param)*((-7/18)*Param+2.0)-10/3*Param+16/9;
else
W:=0.0;
end;
if W=0.0 then Continue;
with Data[Count] do begin
if B<0 then
Pixel:=-B
else
if B>=MaxSize then
Pixel:=2*MaxSize-B-1
else
Pixel:=B;
Pixel:=Pixel*Delta;
Weight:=Round(W*Scale2*65536);
end;
Inc(Count);
end;
Contrib[A].Count:=Count;
Contrib[A].Data:=Data;
Inc(DWORD(Data),CSize);
end;
end;
procedure FreeContributors(var Contrib:PCListList);
begin
if Assigned(Contrib) then begin
FreeMem(Contrib);
Contrib:=nil;
end;
end;
procedure DrawLine24Pas(Count:Integer;Contributes:PCListList;srcLine,dstLine:Pointer;dstDelta,srcDelta:Integer); pascal;
var
r,g,B:Integer;
A,X:Integer;
Src,Dest:PRGBTriple;
begin
Dest:=dstLine;
for X:=0 to Count-1 do begin
r:=0;
g:=0;
B:=0;
for A:=0 to Contributes[X].Count-1 do
with Contributes[X].Data[A] do begin
Src:=PRGBTriple(Integer(srcLine)+Pixel);
if Weight<>0 then begin
Inc(r,Src.rgbtRed*Weight);
Inc(g,Src.rgbtGreen*Weight);
Inc(B,Src.rgbtBlue*Weight);
end;
end;
if r<0 then
Dest.rgbtRed:=0
else
if r>$FF0000 then
Dest.rgbtRed:=$FF
else
Dest.rgbtRed:=r shr 16;
if g<0 then
Dest.rgbtGreen:=0
else
if g>$FF0000 then
Dest.rgbtGreen:=$FF
else
Dest.rgbtGreen:=g shr 16;
if B<0 then
Dest.rgbtBlue:=0
else
if B>$FF0000 then
Dest.rgbtBlue:=$FF
else
Dest.rgbtBlue:=B shr 16;
Inc(DWORD(Dest),dstDelta);
end;
end;
procedure DrawLine32Pas(Count:Integer;Contributes:PCListList;srcLine,dstLine:Pointer;dstDelta,srcDelta:Integer); pascal;
var
r,g,B,AA:Integer;
A,X:Integer;
Src,Dest:PRGBQUAD;
begin
Dest:=dstLine;
for X:=0 to Count-1 do begin
r:=0;
g:=0;
B:=0;
AA:=0;
for A:=0 to Contributes[X].Count-1 do
with Contributes[X].Data[A] do begin
Src:=PRGBQuad(Integer(srcLine)+Pixel);
if Weight<>0 then begin
Inc(r,Src.rgbRed*Weight);
Inc(g,Src.rgbGreen*Weight);
Inc(B,Src.rgbBlue*Weight);
Inc(AA,Src.rgbReserved*Weight);
end;
end;
if r<0 then
Dest.rgbRed:=0
else
if r>$FF0000 then
Dest.rgbRed:=$FF
else
Dest.rgbRed:=r shr 16;
if g<0 then
Dest.rgbGreen:=0
else
if g>$FF0000 then
Dest.rgbGreen:=$FF
else
Dest.rgbGreen:=g shr 16;
if B<0 then
Dest.rgbBlue:=0
else
if B>$FF0000 then
Dest.rgbBlue:=$FF
else
Dest.rgbBlue:=B shr 16;
if AA<0 then
Dest.rgbReserved:=0
else
if AA>$FF0000 then
Dest.rgbReserved:=$FF
else
Dest.rgbReserved:=AA shr 16;
Inc(DWORD(Dest),dstDelta);
end;
end;
procedure Stretch(const Src,Dst:TBitmap;const Width,Height:Integer;Filter:TFilterType;Progress:TProgressProc=nil;Param:Integer=0); overload;
var
A:Integer;
Contrib:PCListList;
Work:TBitmap;
SourceLine:Pointer;
Delta:Integer;
DestLine:Pointer;
DestDelta:Integer;
SrcWidth:Integer;
SrcHeight:Integer;
SrcPixelFormat:TPixelFormat;
CurProgress:Integer;
OldProgress:Integer;
BytePerPixel:Integer;
DrawLine:TDrawProc;
procedure DoProgress;
var
A:Integer;
begin
if Assigned(Progress) then begin
A:=MulDiv(CurProgress,100,Width+SrcHeight);
if A<>OldProgress then begin
Progress(A,Param);
OldProgress:=A;
end;
Inc(CurProgress);
end;
end;
begin
SrcWidth:=Src.Width;
SrcHeight:=Src.Height;
if Src.PixelFormat=pf32bit then begin
BytePerPixel:=4;
DrawLine:=DrawLine32Pas;
SrcPixelFormat:=pf32bit;
end
else begin
BytePerPixel:=3;
DrawLine:=DrawLine24Pas;
SrcPixelFormat:=pf24bit;
end;
CurProgress:=0;
OldProgress:=-1;
DoProgress;
if (SrcWidth<2)or(SrcHeight<2) then
raise Exception.Create('Source bitmap too small');
if (SrcWidth<>Width)or(SrcHeight<>Height) then begin
Work:=TBitmap.Create;
try
Work.Height:=SrcHeight;
Work.Width:=Width;
Src.PixelFormat:=SrcPixelFormat;
Work.PixelFormat:=SrcPixelFormat;
SourceLine:=Src.ScanLine[0];
Delta:=PChar(Src.ScanLine[1])-PChar(SourceLine);
DestLine:=Work.ScanLine[0];
DestDelta:=PChar(Work.ScanLine[1])-PChar(DestLine);
CreateContributors(Contrib,Width,SrcWidth,Filter,BytePerPixel);
try
for A:=0 to SrcHeight-1 do begin
DrawLine(Width,Contrib,SourceLine,DestLine,BytePerPixel,BytePerPixel);
Inc(PChar(SourceLine),Delta);
Inc(PChar(DestLine),DestDelta);
DoProgress;
end;
finally
FreeContributors(Contrib);
end;
CreateContributors(Contrib,Height,SrcHeight,Filter,Delta);
try
for A:=0 to Width-1 do begin
DrawLine(Height,Contrib,SourceLine,DestLine,DestDelta,Delta);
Inc(DWORD(SourceLine),BytePerPixel);
Inc(DWORD(DestLine),BytePerPixel);
DoProgress;
end;
finally
FreeContributors(Contrib);
end;
finally
Work.Free;
end;
end
else
if Dst<>Src then Dst.Assign(Src);
CurProgress:=Width+SrcHeight;
DoProgress;
end;
Предлагаю следующий вариант:
1. Заводим Bitmap размерами 100х100 и заливаем его белым цветом
2. Получаем коэффициент масштабирования как отношение большего размера изображения к 100
3. Используя данный коэффициент, получаем величину меньшего размера изображения после масштабирования
4. Используя полученные размеры, создаем TRect для вывода изображения на Bitmap (центруем по вертикали или по горизонтали)
5. Используя метод StretchDraw канвы Bitmap, масштабируем изображение в полученный прямоугольник
Прочитайте в справке про TCanvas.StretchDraw, это то, что вас спасет. Сразу скажу, что при масштабировании из большого изображения в маленькое при использовании этой функции может кардинально пострадать качество.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
