AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Image resizer

Offene Frage von "dangerduck"
Ein Thema von dangerduck · begonnen am 20. Dez 2008 · letzter Beitrag vom 21. Dez 2008
 
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.660 Beiträge
 
Delphi 12 Athens
 
#4

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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:57 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz