procedure makethumb(src,dst:TImage; size:integer); var tr:TRect; newwidth,newheight,orgwidth,orgheight:integer; begin orgwidth:=src.width; orgheight:=src.height; if (orgheight/orgwidth > 1) then begin // portrait newheight:=size; newwidth:=round(orgwidth*(newheight/orgheight)); end else begin // landscape newwidth:=size; newheight:=round(orgheight*(newwidth/orgwidth)); end; dst.autosize:=false; dst.stretch:=false; dst.width:=size; dst.height:=size; dst.canvas.pen.color:=clwhite; dst.canvas.brush.color:=clwhite; tr.left:=0; tr.right:=size; tr.top:=0; tr.bottom:=size; if (newwidth < size) then begin // portrait tr.left:=(size-newwidth)div 2; tr.right:=tr.left+newwidth; tr.top:=0;tr.bottom:=size; dst.canvas.rectangle(0,0,tr.left,size); // fill white at left dst.canvas.rectangle(tr.right,0,size,size);// fill white at right end; if (newheight < size) then begin // landscape tr.left:=0;tr.right:=size; tr.top:=(size-newheight)div 2; tr.bottom:=tr.top+newheight; dst.canvas.rectangle(0,0,size,tr.top); // fill white above dst.canvas.rectangle(0,tr.bottom,size,size);// fill white below end; dst.canvas.stretchdraw(tr,src.picture.graphic); end;
For simplicity, the thumb is assumed square.
Thanks to David Wilbourn, who found an error when the image was square. Corrected
now.
Thanks to Bengt Karlström, who found another embarassing error. Also corrected.