02-06-2014, 02:24 PM
السلام عليكم
عثرت على هذا الكود الذي يقوم بتصغير حجم الصور لمقاسات معينة. لكن عيبه أنه يعمل على ملف واحد.
أنا لدي مئات الصور التي أرغب في اعطاءها مقاس معين دفعة وحدة . فكيف يمكنني ذلك ؟؟
عثرت على هذا الكود الذي يقوم بتصغير حجم الصور لمقاسات معينة. لكن عيبه أنه يعمل على ملف واحد.
أنا لدي مئات الصور التي أرغب في اعطاءها مقاس معين دفعة وحدة . فكيف يمكنني ذلك ؟؟
كود :
procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TBitmap;
jpg: TJpegImage;
scale: Double;
begin
if opendialog1.execute then
begin
jpg := TJpegImage.Create;
try
jpg.Loadfromfile(opendialog1.filename);
if jpg.Height > jpg.Width then
scale := 400 / jpg.Height
else
scale := 400 / jpg.Width;
bmp := TBitmap.Create;
try
{Create thumbnail bitmap, keep pictures aspect ratio}
bmp.Width := Round(jpg.Width * scale);
bmp.Height:= Round(jpg.Height * scale);
bmp.Canvas.StretchDraw(bmp.Canvas.Cliprect, jpg);
{Draw thumbnail as control}
Self.Canvas.Draw(100, 10, bmp);
{Convert back to JPEG and save to file}
jpg.Assign(bmp);
jpg.SaveToFile(
ChangeFileext(opendialog1.filename, '_thumb.JPG')
);
finally
bmp.free;
end;
finally
jpg.free;
end;
end;
end;