Delphi-Quellcode:
function WriteImage(FileName: string; WriteStream: TStream): Boolean;
var
Factor: Integer;
Pic: TPicture;
Bmp, Tmp: TBitmap;
Gif: TJvGIFImage;
SizeTest: TJclNullStream;
begin
Result := FileExists(FileName);
if Result then
begin
Pic := TPicture.Create;
Bmp := TBitmap.Create;
Tmp := TBitmap.Create;
Gif := TJvGIFImage.Create;
SizeTest := TJclNullStream.Create;
Pic.LoadFromFile(FileName);
Bmp.Width := Pic.Width;
Bmp.Height := Pic.Height;
Bmp.Canvas.Draw(0, 0, Pic.Graphic);
Factor := 1;
repeat
Tmp.Width := Bmp.Width div Factor;
Tmp.Height := Bmp.Height div Factor;
SetStretchBltMode(Bmp.Canvas.Handle, HALFTONE);
SetStretchBltMode(Tmp.Canvas.Handle, HALFTONE);
StretchBlt(Tmp.Canvas.Handle, 0, 0, Tmp.Width, Tmp.Height,
Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, SRCCOPY);
Gif.Assign(Tmp);
SizeTest.Size := 0;
Gif.SaveToStream(SizeTest);
Inc(Factor);
until (SizeTest.Size < 65536) and (Tmp.Height <= 240) and (Tmp.Width < 240);
Gif.SaveToStream(WriteStream);
Pic.Free;
Bmp.Free;
Tmp.Free;
Gif.Free;
SizeTest.Free;
end;
end;
Der obenstehende Code laedt ein Bild in allen von TGraphic unterstuetzten Formaten (das variiert je nach installierten Komponenten).
Das Bild wird in eine Bitmap umgewandelt und dann solange verkleinert bis es kleiner als 240x240 ist und im GIF-Format kleiner als 64K ist.
Das frisch erfundene TJclNullStream speichert keine Daten sondern nur die Stream-Groesse und -Position.
Am ende wird das Bild als GIF gespeichert.
Wichtig ist das fuer das Zielformat auch das Schreiben unterstuetzt wird. Das ist nicht bei allen Implementierungen eines Formates fuer TGraphic der Fall.
Es ist auch wichtig das die Zuweisung einer TBitmap an das Zielformat ("Gif.Assign(Tmp);") unterstuetzt wird.