Her er en lille unit, som jeg selv bruger, den kan klare næsten alle
formater.
--
Med venlig hilsen
JC
www.carlsensoftware.frac.dk
unit CSGrafx;
interface
uses
Windows, Registry, SysUtils, Classes, Graphics, GIFCtrl, jpeg, Controls,
IniFiles;
function ConvertToTumbnails(FileName: String; Bitmap: TBitmap; ThumbSize:
Integer): BOOL;
implementation
procedure RescaleImage(Source, Target: TBitmap; FThumbSize: Integer);
var
NewWidth,
NewHeight : Integer;
begin
if (Source.Width > FThumbSize) or (Source.Height > FThumbSize) then
begin
if Source.Width > Source.Height then
begin
NewWidth := FThumbSize;
NewHeight := Round(FThumbSize * Source.Height / Source.Width);
end
else
begin
NewHeight := FThumbSize;
NewWidth := Round(FThumbSize * Source.Width / Source.Height);
end;
Target.Width := NewWidth;
Target.Height := NewHeight;
SetStretchBltMode(Target.Canvas.Handle, HALFTONE);
StretchBlt(Target.Canvas.Handle, 0, 0, NewWidth, NewHeight,
Source.Canvas.Handle, 0, 0,
Source.Width, Source.Height, SRCCOPY);
end
else
Target.Assign(Source);
end;
function ConvertToTumbnails(FileName: String; Bitmap: TBitmap; ThumbSize:
Integer): BOOL;
var
Picture : TPicture;
begin
BitMap.FreeImage;
try
Picture := TPicture.Create;
//Bitmap := TBitmap.Create;
try
Picture.LoadFromFile(FileName);
try
if not (Picture.Graphic is TBitmap) then
begin
with Bitmap do
begin
Width := Picture.Width;
Height := Picture.Height;
Canvas.Draw(0, 0, Picture.Graphic);
end;
Picture.Bitmap.Assign(Bitmap);
end;
except
Result := FALSE;
end;
try
RescaleImage(Picture.Bitmap, Bitmap, ThumbSize);
except
Result := FALSE;
end;
except
Result := FALSE;
end;
finally
Picture.Free;
end;
Result := TRUE;
end;
end.
"Uffe Kousgaard" <oh@no.no> skrev i en meddelelse
news:44c9b00a$0$84023$edfadb0f@dtext01.news.tele.dk...
> En søgning på google efter "jpeg delphi resize" gav følgende:
>
> Godt resultat:
>
http://www.swissdelphicenter.ch/torry/showcode.php?id=1896
>
> Nemme:
>
http://www.efg2.com/Lab/Library/UseNet/2000/0803a.txt
>
http://www.efg2.com/Lab/Library/UseNet/2002/0920b.txt
>
> hilsen
> Uffe
>
> "Michael [2800]" <michael@mhcdan.dk> wrote in message
> news:44c9a8a3$0$20303$edfadb0f@dread16.news.tele.dk...
>>
>> Hvordan gør jeg et jpeg billede mindre og gemmer det med den nye
>> størrelse?
>>
>> --
>> /michael
>
>