Thema: Delphi Image resizer

Einzelnen Beitrag anzeigen

Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.542 Beiträge
 
Delphi 11 Alexandria
 

Re: Image resizer

  Alt 21. Dez 2008, 11:11
Here' s a procedure I wrote for a similar task. It converts a TGraphic into a TJPEGImage proportionally. For this you have to add the "jpeg"-unit to your uses-clause.
Delphi-Quellcode:
procedure StretchGraphic(const src: TGraphic; //the TGraphic to convert
                         const dest: TJPEGImage; //the TJPEGImage which receives the converted graphic
                         const DestWidth, DestHeight: integer); //maximum width and height of the destination jpeg
var temp, aCopy: TBitmap;
    faktor: double;
begin
  if src.Width > DestWidth then
    begin
      faktor := DestWidth / src.Width;
      if (src.Height * faktor) > DestHeight then
        faktor := DestHeight / src.Height;
    end
  else
    begin
      faktor := DestHeight / src.Height;
      if (src.Width * faktor) > DestWidth then
        faktor := DestWidth / src.Width;
    end;
  aCopy := TBitmap.Create;
  try
    aCopy.PixelFormat := pf24Bit;
    aCopy.Assign(src);
    temp := TBitmap.Create;
    try
      temp.Width := round(src.Width * faktor);
      temp.Height := round(src.Height * faktor);
      try
        SetStretchBltMode(temp.Canvas.Handle,HALFTONE);
        StretchBlt(temp.Canvas.Handle,
                   0,0,temp.Width,temp.Height,
                   aCopy.Canvas.Handle,
                   0,0,aCopy.Width,aCopy.Height,
                   SRCCOPY);
        dest.Assign(temp);
      except
        on E: Exception do
          MessageBox(0,PAnsiChar(E.Message),nil,MB_OK or MB_ICONERROR);
      end;
    finally
      temp.Free;
    end;
  finally
    aCopy.Free;
  end;
end;
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat